vb密碼加密演算法
Private Sub Command1_Click()
Dim i&, AddCode&, Ans$
'將text3中的字元逐個取,並把們們的unicode碼加和,用於加密
For i = 1 To Len(Text3.Text)
AddCode = AddCode + AscW(Mid(Text3.Text, i, 1))
Next
'將需要加密的text1中每文字的unicode碼加上addcode,並用"%",
For i = 1 To Len(Text1.Text)
Ans = Ans & "%" & CStr(AddCode + AscW(Mid(Text1.Text, i, 1)))
Next
'將加密後的內容顯示在text2中
Text2.Text = Ans
End Sub
Private Sub Command2_Click()
Dim temp$(), i&, AddCode&
If Text1.Text = "" Then Exit Sub
'獲得解密的AddCode
For i = 1 To Len(Text3.Text)
AddCode = AddCode + AscW(Mid(Text3.Text, i, 1))
Next
'將加密的內容以%為分隔符,取出單個字元加密的編碼,放於temp數組中
temp = Split(Text1.Text, "%")
'將每個加密的編碼減去addcode後做為unicode碼返加字元,存放於temp數組中.
For i = 0 To UBound(temp)
If temp(i) <> "" Then temp(i) = ChrW(CLng(temp(i)) - AddCode)
Next
'輸出解密的內容
Text2.Text = Join(temp, "")
End Sub
② 怎樣用VB編寫一個文件加密程序
位元組逐位倒排序加密法是以比特為單位的換位加密方法，用VB實現的具體演算法是：
(1) 以二進制模式打開源文件；
(2) 從源文件第I位讀取一個位元組，假設為字母「A」，得到「A」的ASCII值為65；
(3) 將65轉換成八位二進制串為「01000001」；
(4) 將「01000001」按位元組逐位倒排序得另一個八位二進制串「10000010」；
(5) 將「10000010」轉換成十進制再寫回源文件第I位置，完成一個位元組的加密；
(6) 重復(2)、(3)、(4)和(5)，直到所有位元組加密結束。
為了使程序模塊化，我們用函數過程ByteToBin完成將位元組型數據轉換成二進制串（其實質就是將十進制數轉換成八位二進制串）；用函數過程BinToByte將二進制串轉換成位元組型數據（實質是將八位二進制串轉換成十進制數）：用函數過程Reverse將八位二進制串逐位倒排序。具體程序如下：
Function ByteToBin(m As Byte) As String ' 將位元組型數據轉換成八位二進制字元串
Dim c$
c$ = ""
Do While m <> 0
r = m Mod 2
m = m \ 2
c$ = r & c$
Loop
c$ = Right("00000000" & c$, 8)
ByteToBin = c$
End Function
Function Reverse(m As String) As String ' 將八位二進制字元串顛倒順序
Dim i%, x$
x = ""
For i = 1 To 8
x = Mid(m, i, 1) & x
Next i
Reverse = x
End Function
Function BinToByte(m As String) As Byte ' 將八位二進制串轉換成十進制
Dim x As String * 1, y%, z%
z = 0
For i = 1 To 8
x = Mid(m, i, 1)
y = x * 2 ^ (8 - i)
z = z + y
Next i
BinToByte = z
End Function
Private Sub Command1_Click()
Dim x As Byte, i%, fname$
fname = InputBox("請輸入要加密的文件名！注意加上路徑名：")
If Dir(fname) = "" Then
MsgBox "文件不存在！"
Exit Sub
End If
Open fname For Binary As #1 ' 以二進制訪問模式打開待加密文件
For i = 1 To LOF(1) ' LOF函數是求文件長度的內部函數
Get #1, i, x ' 取出第i個位元組
x = BinToByte(Reverse(ByteToBin(x))) ' 這里調用了三個自定義函數
Put #1, i, x ' 將加密後的這個位元組寫回到文件原位置
Next i
Close
MsgBox "任務完成！"
End Sub
本例可以完成對任意文件的加密與解密，對同一文件作第一次處理為加密，第二次處理為解密。要調試本程序，可用記事本在C盤根目錄下任意建立一個文本文件（假設為文件名為aaa.txt），其中的內容任意（可以包括字母、漢字、數字、回車符、換行符等）。運行本程序後，在輸入文件名的對話框中輸入文件名（如：「C:\aaa.txt」）後回車，即可完成對文件的加密。文件加密後，可以在記事本中打開該文件查看加密效果。如果想解密，可再次運行該程序並輸入相同文件名。
③ VB 加密演算法
Private Declare Function icePub_machineGetInfo Lib "icePubDll.dll" (ByVal typeFlag As Integer, ByVal strInfo As String) As Integer
Dim a2 As Integer
Dim str1 As String
str1 = Space(1024 * 10)
a2 = icePub_machineGetInfo(1, str1)
MsgBox "mac:" + str1
a2 = icePub_machineGetInfo(2, str1)
MsgBox "cpu:" + str1
a2 = icePub_machineGetInfo(3, str1)
MsgBox "hard:" + str1
a2 = icePub_machineGetInfo(4, str1)
MsgBox "memery:" + str1
a2 = icePub_machineGetInfo(5, str1)
MsgBox "boarddate:" + str1
Private Declare Function icePub_machineCode Lib "icePubDll.dll" (ByVal flag As Integer, ByVal strMachineCode As String) As Integer
Dim a2 As Integer
Dim str1 As String
str1 = Space(1024 * 10)
a2 = icePub_machineCode(0,str1)
MsgBox str1
a2 = icePub_machineCode(1,str1)
MsgBox str1
Private Declare Function icePub_encryptText2 Lib "icePubDll.dll" (ByVal strInput As String,ByVal strOutputHexstring As String, ByVal strKey As String) As Integer
Dim len2 As Integer
Dim buff As String
Dim buff2 As String
Dim key As String
buff="Recall Dream Miss, Keep Silk-silk accept as a souvenir, Between You And Me, Stringed music touching."
key="11223344"
buff2=Space(1024)
len2=icePub_encryptionText2(buff,buff2,key)
MsgBox buff2
Private Declare Function icePub_decryptText2 Lib "icePubDll.dll" (ByVal strInputHexstring As String, ByVal strOutput As String, ByVal strKey As String) As Integer
Dim len2 As Integer
Dim buff As String
Dim buff2 As String
Dim key As String
buff="479871017620FE"
key="11223344"
buff2=Space(1024)
len2= icePub_decryptText2(buff,buff2,key)
MsgBox buff2
④ 求vb文本文件加解密演算法，可設定密鑰
這個簡單，比如字母a加密:
y=a的asc值
xor
i
解密：
a的asc值=y
xor
i
i是種子自己知道就行了
xor是異或運算，先用異或運算得到加密後的數據，要是把加密後的數據在異或同一個數就會還原成原來得數據這就是解密。怎麼樣神奇把，還有數據在寫入文件時最好把y轉換成字元串一行一行的寫入，因為中文是兩個位元組英文是一個位元組asc值有很大的不同加密後數據會亂的所以y要用str（）函數轉換成由數字組成的字元串。
⑤ VB文本加密解密
剛好以前寫過一篇文章，提取了一部分
對敏感的數據進行加密是必要的，如用戶的密碼的加密。在要對數據進行加密前得確定要用何種加密方式，加密分類有很多種，從可逆角度可分為可逆和不可逆，從加密演算法可分為秘密密鑰演算法、公開密鑰演算法（用於加密、數據簽名和密鑰管理）以及單向散列函數等。md5加密是不可逆的，md5加密的具體實現又分為許多種。
加密為什麼要採用不可逆？舉個例子，當你輸入的密碼進行加密的密文被截取，那他也要把密文解密成原文，這時由於不可逆，那他要破解密碼的難度就提高，除非他可以越過加密那一步直接提供密文，這樣就達到安全的目的。每當我們忘記密碼進行找回密碼，大多數網站要求我們輸入新的密碼而不是直接告訴我們原來的密碼，這是由於不可逆造成的，但這又不是壞處，為什麼這么說？如果在找回密碼時能夠知道原來的密碼，那麼卧底就不用修改密碼來監控所有人，而所有人又不知情。但並不是所有網站都採用不可逆的演算法，筆者在某網站注冊過用戶，有一段沒登錄過，那網站就會給筆者一份提醒郵件，而這提醒郵件又顯示著筆者的密碼，這很可能是這個網站採用的不是不可逆的演算法。
今天為一個網友實現了一個簡易的自定義加密方式，使用的是Visual Basic 6.0。關鍵代碼如下：
Dim decode As String, encode As String, oldString As String, newString As String
Dim i As Integer
decode = "1234567890" '加密原文對照字元，不應該出錯相同的字元
encode = "eoSDriKjsd" '加密成密文的對照字元，字元個數不能少於decode，否則極易造成出錯
oldString = "87232" '待加密的字元串，所有字元都必需能夠在decode里找到對應位置
newString = "" '存放加密後的字元串
For i = 1 To Len(oldString)
newString = newString + Mid$(encode, Instr(decode, Mid$(oldString, i, 1)), 1)
Next i
Print "原文："; oldString
Print "密文："; newString
decode和encode的值可以根據需要設置，oldString可以由文框輸入，如果encode里的字元倆倆不相同，那麼只需調換decode和encode的值，就可以實現解密，否則加密後的密文為不可逆。
當然，在實際的應用種應增加加密的演算法復雜度，讓密文不至於被人輕而易舉破解。更多的加密知識請參考相關文檔。
希望回答對你有幫助
⑥ 怎樣用VB給文件夾進行密碼加密
文件或文件夾的加密、解密
'此方法對 WinXP 系統有效，Win98 沒試驗過。小心：不能用於系統文件或文件夾，否則會使系統癱瘓。
'加密：利用 API 函數在文件或文件夾名稱末尾添上字元「..\」。比如，將文件夾「MyPath」更名為「MyPath..\」，在我的電腦中顯示的名稱就是「MyPath.」。系統會無法識別，此文件或文件夾就無法打開和修改，也無法刪除。著名的病毒 Autorun 就是玩的這個小把戲。
'解密：去掉文件或文件夾名稱末尾的字元「..\」
'將以下代碼復制到 VB 的窗體代碼窗口即可
'例子需控制項：Command1、Command2、Text1，均採用默認屬性設置
Private Const MAX_PATH = 260
Private Type FileTime ' 8 Bytes
LTime As Long
HTime As Long
End Type
Private Type Win32_Find_Data
dwFileAttributes As Long
ftCreationTime As FileTime
ftLastAccessTime As FileTime
ftLastWriteTime As FileTime
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cNameFile As String * MAX_PATH
cAlternate As String * 14
End Type
Private Declare Function MoveFileEx Lib "kernel32" Alias "MoveFileExA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal dwFlags As Long) As Long
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpNameFile As String, lpFindFileData As Win32_Find_Data) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As Win32_Find_Data) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Sub Form_Load()
Text1.Text = "C:\MyPath"
Command1.Caption = "解密": Command2.Caption = "加密"
Me.Caption = "目錄或文件的加解密"
End Sub
Private Sub Command1_Click()
Call SetPathName(False) '解密
End Sub
Private Sub Command2_Click()
Call SetPathName(True) '加密
End Sub
Private Sub SetPathName(SetMi As Boolean)
Dim nName As String, NewName As String, nSort As String, nCap As String, dl As Long
nName = Trim(Text1.Text)
If Right(nName, 3) = "..\" Then nName = Left(nName, Len(nName) - 3)
If Right(nName, 1) = "\" Then nName = Left(nName, Len(nName) - 1)
If SetMi Then
NewName = nName & "..\"
Else
NewName = nName
nName = nName & "..\"
End If
If SetMi Then nCap = "加密" Else nCap = "解密"
nSort = GetShortName(nName) '轉變其中的 ..\
If nSort = "" Then
MsgBox "文件沒有找到：" & vbCrLf & nName, vbCritical, nCap
Exit Sub
End If
If MoveFileEx(nSort, NewName, 0) = 0 Then Exit Sub '文件更名：非零表示成功，支持只讀文件
MsgBox nCap & "成功：" & vbCrLf & nName, vbInformation, nCap
End Sub
Public Function GetShortName(F As String, Optional ShortAll As Boolean) As String
'轉變為短文件名，如果目錄或文件不存在就返回空。可用於判斷某目錄或文件是否存在
'不能直接用 API 函數 GetShortPathName， 因它不支持 ..\
'ShortAll=T 表示全部轉變為短名稱，否則只轉變其中的點點杠「..\」
Dim FondID As Long, ID1 As Long, S As Long, nPath As String
Dim nF As String, InfoF As Win32_Find_Data, qF As String, hF As String
Dim nName As String, nName1 As String
nF = F
Do
S = InStr(nF, "..\")
If S = 0 Then Exit Do
qF = Left(nF, S + 2): hF = Mid(nF, S + 3) '分為前後兩部分
CutPathName qF, nPath, nName
nName = LCase(nName)
qF = nPath & "\" & "*."
FondID = FindFirstFile(qF, InfoF) '-1表示失敗。查找所有文件（夾）
ID1 = FondID
Do
If FondID = Find_Err Or ID1 = 0 Then GoTo Exit1 '沒有找到符合條件的條目
nName1 = LCase(CutChr0(InfoF.cNameFile)) '文件（夾）名稱
If nName1 & ".\" = nName Then
nName1 = CutChr0(InfoF.cAlternate) '用短文件名代替
If hF = "" Then nF = nPath & "\" & nName1 Else nF = nPath & "\" & nName1 & "\" & hF
Exit Do
End If
ID1 = FindNextFile(FondID, InfoF) '查找下一個，0表示失敗
Loop
FindClose FondID
Loop
Exit1:
FindClose FondID
S = MAX_PATH: nName = String(S, vbNullChar)
ID1 = GetShortPathName(nF, nName, S) '返回實際位元組數，0表示失敗
If ID1 = 0 Then Exit Function
If ShortAll Then
If ID1 > S Then
S = ID1: nName = String(S, vbNullChar)
ID1 = GetShortPathName(nF, nName, S) '返回實際位元組數
End If
GetShortName = CutChr0(nName)
Else
GetShortName = nF
End If
End Function
Public Sub CutPathName(ByVal F As String, nPath As String, nName As String)
Dim I As Long, LenS As Long
LenS = Len(F)
For I = LenS - 1 To 2 Step -1
If Mid(F, I, 1) = "\" Then
nPath = Left(F, I - 1): nName = Mid(F, I + 1)
GoTo Exit1
End If
Next
nPath = F: nName = ""
Exit1:
If Right(nPath, 2) = ".." Then
nPath = nPath & "\"
Else
If Right(nPath, 1) = "\" Then nPath = Left(nPath, Len(nPath) - 1)
End If
If Right(nName, 1) = "\" And Right(nName, 3) <> "..\" Then nName = Left(nName, Len(nName) - 1)
End Sub
Private Function CutChr0(xx As String) As String
Dim S As Long
S = InStr(xx, vbNullChar)
If S > 0 Then CutChr0 = Left(xx, S - 1) Else CutChr0 = xx
End Function
'參考資料見下
⑦ 求一個簡單短小的VB加密演算法,每段要有解釋
Public Function StringEnDeCodecn(strSource As String, MA) As String '該函數只對中西文起到加密作用 '參數為：源文件，密碼 On Error GoTo ErrEnDeCode Dim X As Single Dim CHARNUM As Long, RANDOMINTEGER As Integer Dim SINGLECHAR As String * 1 Dim strTmp As String If MA < 0 Then MA = MA * (-1) End If X = Rnd(-MA) For i = 1 To Len(strSource) Step 1 '取單位元組內容 SINGLECHAR = Mid(strSource, i, 1) CHARNUM = Asc(SINGLECHAR) g: RANDOMINTEGER = Int(127 * Rnd) If RANDOMINTEGER < 30 Or RANDOMINTEGER > 100 Then GoTo g CHARNUM = CHARNUM Xor RANDOMINTEGER strTmp = strTmp & Chr(CHARNUM) Next i StringEnDeCodecn = strTmp Exit Function ErrEnDeCode: StringEnDeCodecn = "" MsgBox Err.Number & "\" & Err.Description End Function Private Sub Command1_Click() tmp1 = StringEnDeCodecn(Text1.Text, 75) Text2.Text = tmp1 End Sub 窗體放兩個文本框Text1,Text2和一個按鈕Command1。 使用上面代碼可以把Text1中的內容加密，顯示在Text2中。 要解密直接把Text2的內容復制到Text1中，再次點擊按鈕Command1，解密後的內容會顯示在Text2中。
⑧ 用VB寫一個數據加密程序 隨便用什麼加密演算法
全部代碼入下:
Function UserCode(password As String) As String
'用戶口令加密
Dim il_bit, il_x, il_y, il_z, il_len, i As Long
Dim is_out As String
il_len = LenB(password)
il_x = 0
il_y = 0
is_out = ""
For i = 1 To il_len
il_bit = AscB(MidB(password, i, 1)) 'b系列支持中文
il_y = (il_bit * 13 Mod 256) + il_x
is_out = is_out & ChrB(Fix(il_y)) '取整 int和fix區別: fix修正負數
il_x = il_bit * 13 / 256
Next
is_out = is_out & ChrB(Fix(il_x))
password = is_out
il_len = LenB(password)
il_x = 0
il_y = 0
is_out = ""
For i = 1 To il_len
il_bit = AscB(MidB(password, i, 1))
'取前4位值
il_y = il_bit / 16 + 64
is_out = is_out & ChrB(Fix(il_y))
'取後4位值
il_y = (il_bit Mod 16) + 64
is_out = is_out & ChrB(Fix(il_y))
Next
UserCode = is_out
End Function
Function UserDeCode(password As String) As String
'口令解密
Dim is_out As String
Dim il_x, il_y, il_len, i, il_bit As Long
il_len = LenB(password)
il_x = 0
il_y = 0
is_out = ""
For i = 1 To il_len Step 2
il_bit = AscB(MidB(password, i, 1))
'取前4位值
il_y = (il_bit - 64) * 16
'取後4位值
'dd = AscW(Mid(password, i + 1, 1)) - 64
il_y = il_y + AscB(MidB(password, i + 1, 1)) - 64
is_out = is_out & ChrB(il_y)
Next
il_x = 0
il_y = 0
password = is_out
is_out = ""
il_len = LenB(password)
il_x = AscB(MidB(password, il_len, 1))
For i = (il_len - 1) To 1 Step -1
il_y = il_x * 256 + AscB(MidB(password, i, 1))
il_x = il_y Mod 13
is_out = ChrB(Fix(il_y / 13)) & is_out
Next
UserDeCode = is_out
End Function
有時間建議可以研究下MD5加密，因為MD5加密是不可逆的；
⑨ VB加密演算法
首先程序定義兩個字元串k1和k2；
這里他給出了一個Text1變數，應該是一個全局變數，在程序之前已經定義了。
首先定義code為一個字元串，將Text1裡面的文字用LCase()函數將大寫字母轉換成小寫字母。
加密的過程開始，為那一個循環過程。
在這個循環里 設定i的區間是1到code的長度
每個循環開始時候，將code中每一個字母取出來，賦值到s變數裡面。
然後判斷如果s不是空字元時候，將n賦值為s中的字母與字母a的一個"距離"(這里說不知道你明白不，你好好理解一下吧)。
假如i，即s裡面的那個字母在code中是第幾位的位數，不是2的倍數，那麼就將在decode裡面加入k1字元串中的第n個字母。假如i是2的倍數的話，就在decode加入k2字元串裡面的第n個字母。
在剛才判斷s是否為空字元時候，假如得到的s是為空字元，即跳入以下過程、。
假如i不是2的倍數，空格那個字母變為k1的第27個字母即p，就加入k2的第27個字母即z。
最後將decode賦值給text2。
其實這個程序很簡單，定義兩個字元串，分別是27個字母，等於是26個字母加空格，再把順序掉亂。然後根據需要加密的字元串來分別去每一個字母，根據字母的位置來確定取k1或者k2對應的那個掩碼字母。