‘壹’ 用VB实现加密解密程序。
这里只给出按钮事件的过程，加密算法（函数）你自己想办法：
设加密算法函数名为encryptxt，解密算法函数名为unencryptxt，不带参数。
加密窗口“生成密文”按钮事件：
Private sub 生成密文_Click()
Frame1.Caption = encryptxt (Text1.text)
End Sub
解密窗口“解密”按钮事件：
Private Sub 解密_Click()
Frame2.Caption = unencryptxt(Rrame1.Caption)
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
‘叁’ 如何用VB实现RSA加密算法，网上找到了一份代码，没有注释看不懂，请大神解释!!!
RSA算法非常简单，概述如下：
找两素数p和q
取n=p*q
取t=(p-1)*(q-1)
取任何一个数e,要求满足e<t并且e与t互素（就是最大公因数为1）
取d*e%t==1
这样最终得到三个数： n d e
设消息为数M (M <n)
设c=(M**d)%n就得到了加密后的消息c
设m=(c**e)%n则 m == M，从而完成对c的解密。
注：**表示次方,上面两式中的d和e可以互换。
在对称加密中：
n d两个数构成公钥，可以告诉别人；
n e两个数构成私钥，e自己保留，不让任何人知道。
给别人发送的信息使用e加密，只要别人能用d解开就证明信息是由你发送的，构成了签名机制。
别人给你发送信息时使用d加密，这样只有拥有e的你能够对其解密。
rsa的安全性在于对于一个大数n，没有有效的方法能够将其分解
从而在已知n d的情况下无法获得e；同样在已知n e的情况下无法
求得d。
<二>实践
接下来我们来一个实践，看看实际的操作：
找两个素数：
p=47
q=59
这样
n=p*q=2773
t=(p-1)*(q-1)=2668
取e=63，满足e<t并且e和t互素
用perl简单穷举可以获得满主 e*d%t ==1的数d：
C:\Temp>perl -e "foreach $i (1..9999){ print($i),last if $i*63%2668==1 }"
847
即d＝847
最终我们获得关键的
n=2773
d=847
e=63
取消息M=244我们看看
加密：
c=M**d%n = 244**847%2773
用perl的大数计算来算一下：
C:\Temp>perl -Mbigint -e "print 244**847%2773"
465
即用d对M加密后获得加密信息c＝465
解密：
我们可以用e来对加密后的c进行解密，还原M：
m=c**e%n=465**63%2773 ：
C:\Temp>perl -Mbigint -e "print 465**63%2773"
244
即用e对c解密后获得m=244 , 该值和原始信息M相等。
<三>字符串加密
把上面的过程集成一下我们就能实现一个对字符串加密解密的示例了。
每次取字符串中的一个字符的ascii值作为M进行计算，其输出为加密后16进制
的数的字符串形式，按3字节表示，如01F
代码如下：
#!/usr/bin/perl -w
#RSA 计算过程学习程序编写的测试程序
#watercloud 2003-8-12
#
use strict;
use Math::BigInt;
my %RSA_CORE = (n=>2773,e=>63,d=>847); #p=47,q=59
my $N=new Math::BigInt($RSA_CORE{n});
my $E=new Math::BigInt($RSA_CORE{e});
my $D=new Math::BigInt($RSA_CORE{d});
print "N=$N D=$D E=$E\n";
sub RSA_ENCRYPT
{
my $r_mess = shift @_;
my ($c,$i,$M,$C,$cmess);
for($i=0;$i < length($$r_mess);$i++)
{
$c=ord(substr($$r_mess,$i,1));
$M=Math::BigInt->new($c);
$C=$M->(); $C->bmodpow($D,$N);
$c=sprintf "%03X",$C;
$cmess.=$c;
}
return \$cmess;
}
sub RSA_DECRYPT
{
my $r_mess = shift @_;
my ($c,$i,$M,$C,$dmess);
for($i=0;$i < length($$r_mess);$i+=3)
{
$c=substr($$r_mess,$i,3);
$c=hex($c);
$M=Math::BigInt->new($c);
$C=$M->(); $C->bmodpow($E,$N);
$c=chr($C);
$dmess.=$c;
}
return \$dmess;
}
my $mess="RSA 娃哈哈哈～～～";
$mess=$ARGV[0] if @ARGV >= 1;
print "原始串：",$mess,"\n";
my $r_cmess = RSA_ENCRYPT(\$mess);
print "加密串：",$$r_cmess,"\n";
my $r_dmess = RSA_DECRYPT($r_cmess);
print "解密串：",$$r_dmess,"\n";
#EOF
测试一下：
C:\Temp>perl rsa-test.pl
N=2773 D=847 E=63
原始串：RSA 娃哈哈哈～～～
加密串：
解密串：RSA 娃哈哈哈～～～
C:\Temp>perl rsa-test.pl 安全焦点（xfocus）
N=2773 D=847 E=63
原始串：安全焦点（xfocus）
加密串：
解密串：安全焦点（xfocus）
‘肆’ 我有简单的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加密算法,每段要有解释
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加密算法
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)
EndSub
亲，你这两个按钮里面的代码都是加密的啊！
最基本的知识你都没有理解！哪有加密和解密都用一样的代码！
‘柒’ 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对应的那个掩码字母。
‘捌’ 怎样用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代码哈希加密算法
PrivateSubInitialize(ByValvKeyStringAsString)
DimintIAsInteger,intJAsInteger
Randomize(Rnd(-1))'得到初始值（种子值）
'每次调用初始值均相同
'根据初始值（种子值）得到随机数序列，每次调用Initialize时，初始值均相同。只要vKeyString相同，所产生的随机数序列一定相同
ForintI=1ToLen(vKeyString)
intJ=Rnd(-Rnd*AscW(Mid(vKeyString,intI,1)))
Randomize(intJ)
NextintI
EndSub
PublicSubDoXor(ByRefmsFileTextAsString)
DimintCAsInteger
DimintBAsInteger
DimlngIAsLong
ForlngI=1ToLen(msFileText)
intC=AscW(Mid(msFileText,lngI,1))
intB=Int(Rnd()*2^7)
'选用<=127可正确处理汉字，ChrW(n):n有一个范围
Mid(msFileText,lngI,1)=ChrW(intCXorintB)
NextlngI
EndSub
PublicFunctionHash(ByValETAsString)AsString
DimBitLenStringAsString,KeyStringAsString,
FileTextAsString
BitLenString="12345678"
KeyString=ET&BitLenString
CallInitialize(KeyString)
'根据KeyString产生随机数序列
FileText=ET&BitLenString
CallDoXor(FileText)
'根据上述随机数序列对FileText加密
KeyString=FileText
CallInitialize(KeyString)
'根据上述的加密结果产生新的随机数序列
FileText=BitLenString
CallDoXor(FileText)
'根据上述随机数序列对FileText加密，8位字符
Hash=FileText
'8位字符送作HASH值
EndFunction
PrivateSubButton8_Click(ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs)HandlesButton8.Click
DimstrAsString="abcd"&vbCrLf
TextBox6.Text=str&Hash(str)
EndSub