vb加密解密演算法

1. VB高手：設計一個加密解密程序，輸入一串字元，使用加密演算法對其加密，再設計一個解密演算法，對其解密。

這個是最團攜簡單的字元替換法
Public Function Decrypt(ByVal s_text As String)
s_text = Replace(s_text, "1!", "信晌a", , , vbBinaryCompare)
s_text = Replace(s_text, "2@", "b", , , vbBinaryCompare)
s_text = Replace(s_text, "3#", "c", , , vbBinaryCompare)
s_text = Replace(s_text, "4$", "d", , , vbBinaryCompare)
s_text = Replace(s_text, "5$", "e", , , vbBinaryCompare)
s_text = Replace(s_text, "6#", "d", , , vbBinaryCompare)
s_text = Replace(s_text, "7*", "f", , , vbBinaryCompare)
s_text = Replace(s_text, "9#", "g", , , vbBinaryCompare)
s_text = Replace(s_text, "0#", "h", , , vbBinaryCompare)
s_text = Replace(s_text, "4@", "i", , , vbBinaryCompare)
s_text = Replace(s_text, "7#", "j", , , vbBinaryCompare)
s_text = Replace(s_text, "8^", "k", , , vbBinaryCompare)
s_text = Replace(s_text, "0^", "l", , , vbBinaryCompare)
s_text = Replace(s_text, "5%", "m", , , vbBinaryCompare)
s_text = Replace(s_text, "a%", "n", , , vbBinaryCompare)
s_text = Replace(s_text, "e$", "o", , , vbBinaryCompare)
s_text = Replace(s_text, "f5", "塌坦伏p", , , vbBinaryCompare)
s_text = Replace(s_text, "6$", "q", , , vbBinaryCompare)
s_text = Replace(s_text, "h&", "r", , , vbBinaryCompare)
s_text = Replace(s_text, "0.", "s", , , vbBinaryCompare)
s_text = Replace(s_text, "e`", "t", , , vbBinaryCompare)
s_text = Replace(s_text, "4r", "u", , , vbBinaryCompare)
s_text = Replace(s_text, "7@", "v", , , vbBinaryCompare)
s_text = Replace(s_text, "f^", "w", , , vbBinaryCompare)
s_text = Replace(s_text, "t%", "x", , , vbBinaryCompare)
s_text = Replace(s_text, "g@", "y", , , vbBinaryCompare)
s_text = Replace(s_text, "h0", "z", , , vbBinaryCompare)

s_text = Replace(s_text, ".2", "A", , , vbBinaryCompare)
s_text = Replace(s_text, ".3", "B", , , vbBinaryCompare)
s_text = Replace(s_text, ".4", "C", , , vbBinaryCompare)
s_text = Replace(s_text, ".5", "D", , , vbBinaryCompare)
s_text = Replace(s_text, ".6", "E", , , vbBinaryCompare)
s_text = Replace(s_text, ".7", "F", , , vbBinaryCompare)
s_text = Replace(s_text, ".8", "G", , , vbBinaryCompare)
s_text = Replace(s_text, ".9", "H", , , vbBinaryCompare)
s_text = Replace(s_text, ".0", "I", , , vbBinaryCompare)
s_text = Replace(s_text, ".1", "J", , , vbBinaryCompare)
s_text = Replace(s_text, "/3", "K", , , vbBinaryCompare)
s_text = Replace(s_text, "/5", "L", , , vbBinaryCompare)
s_text = Replace(s_text, "/7", "M", , , vbBinaryCompare)
s_text = Replace(s_text, "/9", "N", , , vbBinaryCompare)
s_text = Replace(s_text, "/1", "O", , , vbBinaryCompare)
s_text = Replace(s_text, "/0", "P", , , vbBinaryCompare)
s_text = Replace(s_text, "/8", "Q", , , vbBinaryCompare)
s_text = Replace(s_text, "/6", "R", , , vbBinaryCompare)
s_text = Replace(s_text, "/4", "S", , , vbBinaryCompare)
s_text = Replace(s_text, "/2", "T", , , vbBinaryCompare)
s_text = Replace(s_text, ";0", "U", , , vbBinaryCompare)
s_text = Replace(s_text, ";2", "V", , , vbBinaryCompare)
s_text = Replace(s_text, ";3", "W", , , vbBinaryCompare)
s_text = Replace(s_text, ";4", "X", , , vbBinaryCompare)
s_text = Replace(s_text, ";6", "Y", , , vbBinaryCompare)
s_text = Replace(s_text, ";7", "Z", , , vbBinaryCompare)

s_text = Replace(s_text, "%r", "0", , , vbBinaryCompare)
s_text = Replace(s_text, "#g", "1", , , vbBinaryCompare)
s_text = Replace(s_text, "1$", "2", , , vbBinaryCompare)
s_text = Replace(s_text, "j~", "3", , , vbBinaryCompare)
s_text = Replace(s_text, "j#", "4", , , vbBinaryCompare)
s_text = Replace(s_text, "3?", "5", , , vbBinaryCompare)
s_text = Replace(s_text, "*t", "6", , , vbBinaryCompare)
s_text = Replace(s_text, "u@", "7", , , vbBinaryCompare)
s_text = Replace(s_text, "n!", "8", , , vbBinaryCompare)
s_text = Replace(s_text, "&x", "9", , , vbBinaryCompare)
Decrypt = s_text
End Function
Public Function Crypt(ByVal s_text As String)
s_text = Replace(s_text, "0", "%r", , , vbBinaryCompare)
s_text = Replace(s_text, "1", "#g", , , vbBinaryCompare)
s_text = Replace(s_text, "2", "1$", , , vbBinaryCompare)
s_text = Replace(s_text, "3", "j~", , , vbBinaryCompare)
s_text = Replace(s_text, "4", "j#", , , vbBinaryCompare)
s_text = Replace(s_text, "5", "3?", , , vbBinaryCompare)
s_text = Replace(s_text, "6", "*t", , , vbBinaryCompare)
s_text = Replace(s_text, "7", "u@", , , vbBinaryCompare)
s_text = Replace(s_text, "8", "n!", , , vbBinaryCompare)
s_text = Replace(s_text, "9", "&x", , , vbBinaryCompare)

s_text = Replace(s_text, "a", "1!", , , vbBinaryCompare)
s_text = Replace(s_text, "b", "2@", , , vbBinaryCompare)
s_text = Replace(s_text, "c", "3#", , , vbBinaryCompare)
s_text = Replace(s_text, "d", "4$", , , vbBinaryCompare)
s_text = Replace(s_text, "e", "5$", , , vbBinaryCompare)
s_text = Replace(s_text, "f", "7*", , , vbBinaryCompare)
s_text = Replace(s_text, "g", "9#", , , vbBinaryCompare)
s_text = Replace(s_text, "h", "0#", , , vbBinaryCompare)
s_text = Replace(s_text, "i", "4@", , , vbBinaryCompare)
s_text = Replace(s_text, "j", "7#", , , vbBinaryCompare)
s_text = Replace(s_text, "k", "8^", , , vbBinaryCompare)
s_text = Replace(s_text, "l", "0^", , , vbBinaryCompare)
s_text = Replace(s_text, "m", "5%", , , vbBinaryCompare)
s_text = Replace(s_text, "n", "a%", , , vbBinaryCompare)
s_text = Replace(s_text, "o", "e$", , , vbBinaryCompare)
s_text = Replace(s_text, "p", "f5", , , vbBinaryCompare)
s_text = Replace(s_text, "q", "6$", , , vbBinaryCompare)
s_text = Replace(s_text, "r", "h&", , , vbBinaryCompare)
s_text = Replace(s_text, "s", "0.", , , vbBinaryCompare)
s_text = Replace(s_text, "t", "e`", , , vbBinaryCompare)
s_text = Replace(s_text, "u", "4r", , , vbBinaryCompare)
s_text = Replace(s_text, "v", "7@", , , vbBinaryCompare)
s_text = Replace(s_text, "w", "f^", , , vbBinaryCompare)
s_text = Replace(s_text, "x", "t%", , , vbBinaryCompare)
s_text = Replace(s_text, "y", "g@", , , vbBinaryCompare)
s_text = Replace(s_text, "z", "h0", , , vbBinaryCompare)

s_text = Replace(s_text, "A", ".2", , , vbBinaryCompare)
s_text = Replace(s_text, "B", ".3", , , vbBinaryCompare)
s_text = Replace(s_text, "C", ".4", , , vbBinaryCompare)
s_text = Replace(s_text, "D", ".5", , , vbBinaryCompare)
s_text = Replace(s_text, "E", ".6", , , vbBinaryCompare)
s_text = Replace(s_text, "F", ".7", , , vbBinaryCompare)
s_text = Replace(s_text, "G", ".8", , , vbBinaryCompare)
s_text = Replace(s_text, "H", ".9", , , vbBinaryCompare)
s_text = Replace(s_text, "I", ".0", , , vbBinaryCompare)
s_text = Replace(s_text, "J", ".1", , , vbBinaryCompare)
s_text = Replace(s_text, "K", "/3", , , vbBinaryCompare)
s_text = Replace(s_text, "L", "/5", , , vbBinaryCompare)
s_text = Replace(s_text, "M", "/7", , , vbBinaryCompare)
s_text = Replace(s_text, "N", "/9", , , vbBinaryCompare)
s_text = Replace(s_text, "O", "/1", , , vbBinaryCompare)
s_text = Replace(s_text, "P", "/0", , , vbBinaryCompare)
s_text = Replace(s_text, "Q", "/8", , , vbBinaryCompare)
s_text = Replace(s_text, "R", "/6", , , vbBinaryCompare)
s_text = Replace(s_text, "S", "/4", , , vbBinaryCompare)
s_text = Replace(s_text, "T", "/2", , , vbBinaryCompare)
s_text = Replace(s_text, "U", ";0", , , vbBinaryCompare)
s_text = Replace(s_text, "V", ";2", , , vbBinaryCompare)
s_text = Replace(s_text, "W", ";3", , , vbBinaryCompare)
s_text = Replace(s_text, "X", ";4", , , vbBinaryCompare)
s_text = Replace(s_text, "Y", ";6", , , vbBinaryCompare)
s_text = Replace(s_text, "Z", ";7", , , vbBinaryCompare)

Crypt = s_text
End Function

2. 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

使用方法：
tmp=stringEnDecn("中華人民共和國",75)
如果要解密的話，只須鍵入以下語句：
tmp1=stringendecn(tmp,75)

3. VB加密解密

obyte(i) = 21 Xor obyte(i) '這里obyte應該是一個數字型的數組，Xor是異或操作，其特點是二進制數字每經過2次異或同一個值，會得到初始值。也就是說，如果你的密文是通過把原文異或21而得到指散巧的掘空，那麼將密文再次與21進行異或，就會得到原文。
temp(i) = Chr(obyte(i)) '這個是將Ascii數字轉換為相應的字元。
假設唯鍵A是一個字元，B是一個數字，那麼：
如果Asc(A)=B，則
Chr(B)=A

4. vb加密演算法

PrivateSubCommand1_Click()
DimtAsString
t=Text1.Text
Text2.Text=Encrypt(t,177,86)
EndSub

PrivateSubCommand2_Click()
DimtAsString
t=Text2.Text
Text4.Text=Encrypt(t,177,86)
End坦蘆滑Sub

親，你這兩個按鈕裡面的代碼都是加密讓臘的啊！
最基本的知識你都沒有理解！哪有加密和解密都用一樣嘩答的代碼！

5. VB 字元串加密解密[高分]

就這樣了，大概還行
Private Function Encrypt(ByVal StrSource As String) As String '加密
Dim BLowData As Byte
Dim BHigData As Byte
Dim i As Long
Dim k As Integer
Dim StrEncrypt As String
Dim StrChar As String
Dim KeyTemp As String
Dim Key1 As Byte
For k = 1 To 30
KeyTemp = KeyTemp & CStr(Int(Rnd * (9) + 1))
Next
Key1 = CByte(Mid(KeyTemp, 11, 1) & Mid(KeyTemp, 27, 1))
For i = 1 To Len(StrSource)
StrChar = Mid(StrSource, i, 1) '從待加密字元串中取出一個字元
BLowData = AscB(MidB(StrChar, 1, 1)) Xor Key1 '取字元的低位元組和Key1進行異或運算
SHigData = AscB(MidB(StrChar, 2, 1)) '取字元的高位元組
StrEncrypt = StrEncrypt & ChrB(BLowData) & ChrB(BHigData) '將運算後的數據合成新的字元
Next i
Encrypt = KeyTemp & StrEncrypt
End FunctionPrivate Function Decrypt(ByVal StrSource As String) As String '解密
Dim BLowData As Byte
Dim BHigData As Byte
Dim i As Long
Dim k As Integer
Dim StrDecrypt As String
Dim StrChar As String
Dim KeyTemp As String
Dim Key1 As Byte
KeyTemp = Mid(StrSource, 1, 30)
Key1 = CByte(Mid(KeyTemp, 11, 1) & Mid(KeyTemp, 27, 1))
For i = 31 To Len(StrSource)
StrChar = Mid(StrSource, i, 1) '從待解密字元串中取出一個字元
BLowData = AscB(MidB(StrChar, 1, 1)) Xor Key1 '取字元的低位元組和Key1進行異或運算
BHigData = AscB(MidB(StrChar, 2, 1)) '取字元的高位元組
StrDecrypt = StrDecrypt & ChrB(BLowData) & ChrB(BHigData) '將運算後的數據合成新的字元
Next i
Decrypt = StrDecryptEnd Function
Private Sub Command2_Click()
MsgBox Decrypt(InputBox(""))
End SubPrivate Sub Command1_Click()
Text1.Text = Encrypt(InputBox(""))
End Sub

6. vb加解密

最簡單的設置一個公共變數Code和Key，前者用於存原密碼，後者用於存密鑰，自定義一個加密函數trans，用於轉換Code和Key並顯示在text2當中，解密時判定輸入的密鑰與Key是否符合，如果符合就把Code顯示出來。也就是說，這個加密函數只是用於加密轉換時，在解密的時候，可以不用它而直接讀取Code變數。代碼如下：
Dim Code As String, Key As String
Private Sub Command1_Click() '這是加密過程，加密的同時把密碼與密鑰存入變數Code和Key中
Label2.Caption = "加密後的密碼"
Code = Text1.Text
Key = Text3.Text
Text2.Text = trans(Key) & trans(Code)
End Sub
Private Sub Command2_Click() '這是解密過程
If Text3.Text <> Key Then
MsgBox "密鑰錯誤，請重新輸入"
Else
MsgBox "原密碼是：" & Code
End If
End Sub

Private Function trans(s As String) As String '這是加密函數
Dim ch As String
For i = 1 To Len(s)
If Mid(s, i, 1) Like "[A-Z]" Then
ch = ch & Chr(155 - Asc(Mid(s, i, 1)))
ElseIf Mid(s, i, 1) Like "[a-z]" Then
ch = ch & Chr(219 - Asc(Mid(s, i, 1)))
Else
ch = ch & Mid(s, i, 1)
End If
Next
trans = ch
End Function

Private Sub Form_Load() '這是所有用到的控制項
Label1.Caption = "密碼"
Label2.Caption = "加密後的密碼"
Label3.Caption = "密鑰"
Command1.Caption = "加密"
Command2.Caption = "解密"
End Sub

補充：我測試沒問題。Text2中是加密後的密文，解密時會先判定用戶在Text3中所輸入的密鑰是否與Key變數中保存的密鑰相同，如果相同的話才會顯示原來的密碼。如果出錯的話，請檢查一下這8個控制項，3個Text，3個Label，2個Command，你可以新建一個程序，然後在窗體上放上這8個控制項，都用默認屬性，然後把代碼復制過去，再運行一下試試。

7. 使用VB做出加密，密鑰和解密

下面代碼稍加修改就成。
Private Sub Command1_Click()
Dim a As String
Dim b As String
a = Text3
For i = 1 To Len(a)
b = b & JiaMi(Mid(a, i, 1))
Next i
Text2 = b
a = Text2
b = ""
For i = 1 To Len(a)
b = b & JiaMi(Mid(a, i, 1))
Next i
Text1 = b
End Sub
Private Function JiaMi(a As String) As String
Dim IntAsc As Integer
IntAsc = Asc(a)
If IntAsc Mod 2 Then
IntAsc = IntAsc + 47
If IntAsc > 126 Then IntAsc = IntAsc - 47
Else
IntAsc = IntAsc - 47
If IntAsc < 33 Then IntAsc = IntAsc + 47
End If
JiaMi = Chr(IntAsc)
End Function

8. VB 加密與解密的程序代碼

加密：

PrivateFunction JiaMi(ByVal varPass As String) As String '參數varPass是需要加密的文本內容

Dim varJiaMi As String * 20

Dim varTmp As Double

Dim strJiaMi As String

Dim I

For I = 1 To Len(varPass)

varTmp = AscW(Mid$(varPass, I, 1))

varJiaMi = Str$(((((varTmp * 1.5) / 5.6) * 2.7) * I))

strJiaMi = strJiaMi & varJiaMi

NextI

JiaMi = strJiaMi

EndFunction

解密函數：

PrivateFunction JieMi(ByVal varPass As String) As String '參數varPass是需要解密的密文內容

Dim varReturn As String * 20

Dim varConvert As Double

Dim varFinalPass As String

Dim varKey As Integer

Dim varPasslenth As Long

varPasslenth = Len(varPass)

For I = 1 To varPasslenth / 20

varReturn = Mid(varPass, (I - 1) * 20 + 1, 20)

varConvert = Val(Trim(varReturn))

varConvert = ((((varConvert / 1.5) * 5.6) / 2.7) / I)

varFinalPass = varFinalPass & ChrW(Val(varConvert))

NextI

JieMi = varFinalPass

EndFunction

(8)vb加密解密演算法擴展閱讀：

注意事項

編寫加密程序，將用戶輸入的一個英文句子加密為加密字元串，然後輸出加密字元串。假設句子長度不超過100個字元。

根據給定的句子加密函數原型SentenceEncoding，編寫函數SentenceEncoding調用給定的字元加密函數CharEncoding完成句子加密。

然後，編寫主程序提示用戶輸入英文句子，然後調用函數SentenceEncoding對句子加密，最後輸出加密後的蔽鉛句子。

字元加密規則為大寫字母和小寫字母均加密為其補碼, 我們定義ASCII碼值相加為』A』+』Z』即155的兩個大寫字母互為補碼，ASCII碼值相加改禪為』a』+』z』即219的兩個小寫字母互為補碼。

空格用@代替,句號以#代替,其它字元用句點代替。

函數原型：

void SentenceEncoding(char *soure,char *code);

功能：對待加密字元串source加密後保存加密字元串到code.

參數：char *soure，指向待加密句子的字元串指針；

char *code 指向加密字元串的字元串指針；

字元加密宏殲好函數代碼。

9. 怎樣用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」）後回車，即可完成對文件的加密。文件加密後，可以在記事本中打開該文件查看加密效果。如果想解密，可再次運行該程序並輸入相同文件名。

10. 簡單VB.NET加密與解密

Private Function myEncrypt(ByVal Code As String) As String
Dim Result As String = ""

Dim CurrentChar As Char

For i As Integer = 0 To Code.Length - 1

CurrentChar = Code.Substring(i, 1)

Select Case Code.Substring(i, 1)
Case "Z"
Result &= "a"
Case "z"
Result &= "A"
Case Else
Result &= Chr(Asc(CurrentChar) + 1)
End Select
Next
Return Result
End Function

'vb.net 2005 調試通過