『壹』 用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