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給文件夾加密
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 字母 加密字元串
PrivateSubCommand1_Click()'加密
DimpAsString,sAsString,tAsString
DimiAsInteger,kAsInteger
p=""
s=Text1.Text
Fori=1ToLen(s)
k=InStr(p,Mid(s,i,1))
Ifk=0Then
MsgBox"數據有誤"
ExitSub
Else
t=t&Mid(p,((k+4)Mod52)+1,1)
EndIf
Next
Text2.Text=t
Text1.Text=""
EndSub
PrivateSubCommand2_Click()'解密
DimpAsString,sAsString,tAsString
DimiAsInteger,kAsInteger
p=""
s=Text2.Text
Fori=1ToLen(s)
k=InStr(p,Mid(s,i,1))
Ifk=0Then
MsgBox"數據有誤"
ExitSub
Else
t=t&Mid(p,((k+46)Mod52)+1,1)
EndIf
Next
Text1.Text=t
Text2.Text=""
EndSub
以上代碼用到四個控制項：Text1放加密前的數據，Text2放加密後的數據，Command1點擊加密，Command2點擊解密
④ vb對字元串加密（偏移3位）
Private Sub Command1_Click()
Dim a() As String, b() As Integer, n As Integer
n = Len(txtinputbox)
Print n
ReDim a(n)
ReDim b(n + 3)
For i = 1 To n
a(i) = Mid(txtinputbox, i, 1)
b(i) = Asc(a(i)) + 3
If b(i) > Asc("Z") And b(i) < Asc("a") Then b(i) = Asc("A") + b(i) - Asc("Z") - 1
If b(i) > Asc("z") Then b(i) = Asc("a") + b(i) - Asc("z") - 1
a(i) = Chr(b(i))
codelabel.Caption = codelabel.Caption & a(i)
Next
End Sub
⑤ 用VB寫個簡單加密/解密程序
'圖上的控制項,你就照著擺上去,然後再把以下代碼拷進去,就OK了
Dim lg As Integer
'加密
Private Sub Command1_Click()
Text2 = ""
Dim a(), b() As String
lg = Len(Text1)
ReDim a(lg), b(lg)
For i = 1 To lg
a(i) = Mid(Text1, i, 1)
b(i) = AscW(a(i)) Xor 4
Text2 = Text2 & ChrW(b(i))
Next
End Sub
'解密
Private Sub Command2_Click()
Text3 = ""
Dim a(), b() As String
lg = Len(Text2)
ReDim a(lg), b(lg)
For i = 1 To lg
a(i) = Mid(Text2, i, 1)
b(i) = AscW(a(i)) Xor 4
Text3 = Text3 & ChrW(b(i))
Next
End Sub
⑥ 用VB編寫程序怎樣給文件夾加密碼
加密原理：循環使用密碼中每個字元的ASCII碼值與文件的每個位元組進行異或運算，然後寫入文件即可。這種加密方法是可逆的，即對明文進行加密得到密文，用相同的密碼對密文進行加密就得到明文。
界面設計：在窗體From1上放置驅動器列表框（Driver1）、目錄列表框（Dir1）、文件列表框（File1）各一個，這三個控制項相互配合，用來確定要加密文件的位置。其中File1的Pattern屬性設為「*.TXT」，即僅顯示文本文件；再放置一個Check控制項，用來控制顯示文件的類型，其Caption屬性設為「顯示全部文件」；接著放置兩個文本框，Text1顯示文件內容，Text2用來輸入密碼，其Passchar屬性設為「*」，一個Label控制項，其Caption屬性設為「密碼」；最後，放置兩個命令按鈕，其Caption屬性分別設為「加密/解密」和「退出」。
程序代碼：
Option Explicit
Dim i As Long
Dim databuff（） As Byte 』定義數組用於存放文件內容
Dim addbuff（） As Byte 』定義數組用於存放加密後的文件內容
Dim password（） As Byte 』定義數組用於存放密碼的ASCII值
Dim filename As String
Private Sub Check1_Click（）�
If Check1.Value Then 』控制是否顯示全部文件
File1.Pattern = "*.*"
Else
File1.Pattern = ".txt"
End If
End Sub
Private Sub Command1_Click（）�
Dim j As Integer
Dim password_len As Integer
password_len = Len（Text2.Text）
ReDim password（password_len） As Byte
For i = 0 To password_len - 1 』把密碼轉化為ASCII碼
password（i）= Asc（Mid（Text2.Text，i + 1，1））
Next
If filename = "" Then Exit Sub
Open filename For Binary As #1 』讀取要加密的文件內容
ReDim databuff（LOF（1））
Get #1，， databuff
Close #1
ReDim addbuff（UBound（databuff））As Byte
For i = 0 To UBound（databuff）
If j >= password_len Then 』循環使用密碼
j = 0
Else
j = j + 1
End If
addbuff（i）= databuff（i）Xor password（j）』進行異或運算
Next
Open filename For Binary As #1 』把加密後的內容寫入文件
Put #1，，addbuff
Close #1
Text1 = StrConv（addbuff vbUnicode）』顯示加密後的文件內容
Text2.Text = ""
End Sub
Private Sub Command2_Click（）�
.End
End Sub
Private Sub Dir1_Change（）�
File1.Path = Dir1.Path 』與文件列表框相關聯
End Sub
Private Sub Drive1_Change（）�
On Error GoTo a0
Dir1.Path = Drive1.Drive 』與目錄列表框相關聯
a0：If Err Then MsgBox（Error（Err））』發生錯誤，提示錯誤內容
End Sub
Private Sub File1_Click（）』單擊文件時，顯示文件內容
filename = Dir1.Path + File1.filename
If filename = "" Then Exit Sub
Open filename For Binary As #1
ReDim databuff（LOF（1））
Get #1，，databuff
Close #1
Text1 = StrConv（databuff，vbUnicode）
End Sub
⑦ 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
(7)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 指向加密字元串的字元串指針；
字元加密宏殲好函數代碼。
⑧ VB 保存文件並加密!
簡單說就是做個加密『解密的兩個函數，
在保存之前把要保存的記錄先通過加密函數加密一下，再存到ini文件里，在讀取的時候先讀取ini里的信息再通過解密函數把他解密，然後在顯示在文本框上，
加密的方式有很多，異或加密法是比較快的一種