vb中文加密
㈠ vb編程，設計一個文本加密程序。輸入一個字元串，按照以下規律加密「
'運行效果如上圖，代碼如下所示：
'判斷中我將大小寫字母均按規則進行了轉換。
'原創，親測可用，轉發請說明出處。
PrivateSubCommand1_Click()
Dima,bAsString
a=Text1.Text
DimiAsInteger
i=Len(a)
Dimarr()AsString
ReDimarr(1Toi)
DimjAsInteger
Forj=1Toi
b=Mid(a,j,1)
IfAsc(b)>=97AndAsc(b)<=118Then
arr(j)=Chr(Asc(b)+4)
EndIf
IfAsc(b)=119Then
arr(j)="a"
EndIf
IfAsc(b)=120Then
arr(j)="b"
EndIf
IfAsc(b)=121Then
arr(j)="c"
EndIf
IfAsc(b)=122Then
arr(j)="d"
EndIf
IfAsc(b)>=65AndAsc(b)<=86Then
arr(j)=Chr(Asc(b)+4)
EndIf
IfAsc(b)=87Then
arr(j)="A"
EndIf
IfAsc(b)=88Then
arr(j)="B"
EndIf
IfAsc(b)=89Then
arr(j)="C"
EndIf
IfAsc(b)=90Then
arr(j)="D"
EndIf
IfAsc(b)<65OrAsc(b)>122Or(Asc(b)>90AndAsc(b)<97)Then
arr(j)=b
EndIf
Nextj
Text2.Text=Join(arr,"")
EndSub
㈡ 怎麼用VB給文件夾加密
1、由於採用二進制讀取文件的方式，因此加密時一般可以不考慮文件類型。
2、這里只進行一次異或運算，如有需要可以進行多次異或運算。
3、此加密演算法速度快，當然加密強度也低 ；
參考代碼如下：
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
'-----------------------------------------------------------------------
'函數說明： 使用異或運算加密文件（可加密大部分文件）
'參數說明： key - 密鑰
' fileName - 普通文件名，
' encryptFileName - 加密後的文件名
'返回值： true - 成功，false - 失敗
'-----------------------------------------------------------------------
Private Function XOR_Encrypt(key As Integer, fileName As String, encryptFileName As String) As Boolean
On Error GoTo errHandler
Dim inputFileNo As Integer
Dim fileBytes() As Byte
Dim length As Long
XOR_Encrypt = False
'打開文件並保存在二進制數組中
inputFileNo = FreeFile
Open fileName For Binary As #inputFileNo
length = LOF(inputFileNo)
If length = 0 Then
MsgBox "退出加密：文件內容為空！", vbInformation, "提示"
Exit Function
End If
ReDim fileBytes(length - 1) As Byte
Get inputFileNo, , fileBytes()
Close #inputFileNo
'將該二進制數組進行異或加密
Dim i As Long
For i = LBound(fileBytes) To UBound(fileBytes)
fileBytes(i) = fileBytes(i) Xor key
Next
'將異或加密後的二進制數組保存在新的文件中
Dim outputFileNo As Integer
outputFileNo = FreeFile
Open encryptFileName For Binary As #outputFileNo
Put outputFileNo, , fileBytes
Close #outputFileNo
XOR_Encrypt = True
errHandler:
If Err.Number Then
MsgBox "加密過程中出錯：" & Err.Description, vbCritical, "錯誤"
XOR_Encrypt = False
Resume Next
End If
End Function
㈢ 運用VB對文字進行加密解密
'這是我從網上找到的一段加密解密的代碼，很不錯，應該符合要求。
'文本框的multiline屬性是用來設置是否可以接受多行文本，只能在窗體上手工設置。
'文本框的scrollbars屬性是用來設置是否有垂直和水平滾動條的，也只能在窗體上手工設置。
'keyAscii不清楚是作什麼用的。
'兩個StrConv函數用的太好了，我沒想到能處理的這么簡單。
Option Explicit
Dim key() As Byte
Sub initkey() '這里為密匙，建議定義的復雜些，我這里僅僅是個示例
ReDim key(9)
key(0) = 12
key(1) = 43
key(2) = 53
key(3) = 67
key(4) = 78
key(5) = 82
key(6) = 91
key(7) = 245
key(8) = 218
key(9) = 190
End Sub
Function Pass_Encode(ByVal s As String) As String '加密
On Error GoTo myerr
initkey
Dim buff() As Byte
buff = StrConv(s, vbFromUnicode)
Dim i As Long, j As Long
Dim k As Long
k = UBound(key) + 1
For i = 0 To UBound(buff)
j = i Mod k
buff(i) = buff(i) Xor key(j)
Next
Dim mstr As String
mstr = ""
Dim outstr As String
Dim temps As String
For i = 0 To UBound(buff)
k = buff(i) \ Len(mstr)
j = buff(i) Mod Len(mstr)
temps = Mid(mstr, j + 1, 1) + Mid(mstr, k + 1, 1)
outstr = outstr + temps
Next
Pass_Encode = outstr
Exit Function
myerr:
Pass_Encode = ""
End Function
Function Pass_Decode(ByVal s As String) As String '解密
On Error GoTo myerr
initkey
Dim i As Long, j As Long
Dim k As Long, n As Long
Dim mstr As String
mstr = ""
Dim outstr As String
Dim temps As String
If Len(s) Mod 2 = 1 Then
Pass_Decode = ""
Exit Function
End If
Dim t1 As String
Dim t2 As String
Dim buff() As Byte
Dim m As Long
m = 0
For i = 1 To Len(s) Step 2
t1 = Mid(s, i, 1)
t2 = Mid(s, i + 1, 1)
j = InStr(1, mstr, t1)
k = InStr(1, mstr, t2)
n = j - 1 + (k - 1) * Len(mstr)
ReDim Preserve buff(m)
buff(m) = n
m = m + 1
Next
k = UBound(key) + 1
For i = 0 To UBound(buff)
j = i Mod k
buff(i) = buff(i) Xor key(j)
Next
Pass_Decode = StrConv(buff, vbUnicode)
Exit Function
myerr:
Pass_Decode = ""
End Function
Private Sub Command1_Click()
Text2.Text = Pass_Encode(Text1.Text)
Text3.Text = Pass_Decode(Text2.Text)
End Sub
㈣ 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中如何對字元串進行加密和解密（有漢字的）
源程序如下：
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)
㈥ 怎樣用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編寫一個文件加密程序
位元組逐位倒排序加密法是以比特為單位的換位加密方法，用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作出加密，解密並顯示密鑰
'這是我以前回答別人提問時寫的，添加三個文本框，一個按鈕。text3文本框中輸入要加密的
'文本，在text2中是加密的文本，在text1中是對加密的文本解密。加密和解密用同一個
'過程'Private Function JiaMi(a As String) As String
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