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对应的那个掩码字母。