当前位置:首页 » 密码管理 » des加密vb

des加密vb

发布时间: 2024-08-21 06:24:22

① 想要vb实现的des、rsa算法加密的程序 代码 感激万分。。。。。

gram
rem (c) W.Buchanan
rem Jan 2002

Function check_prime(ByVal val As Long) As Boolean
Dim primes
primes = Array(1, 2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97, 101, 103, 107, 109, 113, 127, 131, 137, 139, 149, 151, 157, 163, 167, 173, 179, 181, 191, 193, 197, 199, 211, 223, 227, 229, 233, 239, 241, 251, 257, 263, 269, 271, 277, 281, 283, 293, 307, 311, 313, 317, 331, 337, 347, 349, 353, 359, 367, 373, 379, 383, 389, 397)
check_prime = False

For i = 0 To 78
If (val = primes(i)) Then
prime = True
End If
Next i
check_prime = prime
End Function

Function decrypt(ByVal c, ByVal n, ByVal d As Long)

Dim i, g, f As Long

On Error GoTo errorhandler

If (d Mod 2 = 0) Then
g = 1
Else
g = c
End If

For i = 1 To d / 2

f = c * c Mod n
g = f * g Mod n
Next i
decrypt = g

Exit Function
errorhandler:
Select Case Err.Number ' Evaluate error number.
Case 6
status.Text = "Calculation overflow, please select smaller values"
Case Else
status.Text = "Calculation error"
End Select

End Function

Function getD(ByVal e As Long, ByVal PHI As Long) As Long
Dim u(3) As Long
Dim v(3) As Long
Dim q, temp1, temp2, temp3 As Long

u(0) = 1
u(1) = 0
u(2) = PHI
v(0) = 0
v(1) = 1
v(2) = e

While (v(2) <> 0)
q = Int(u(2) / v(2))
temp1 = u(0) - q * v(0)
temp2 = u(1) - q * v(1)
temp3 = u(2) - q * v(2)
u(0) = v(0)
u(1) = v(1)
u(2) = v(2)
v(0) = temp1
v(1) = temp2
v(2) = temp3
Wend
If (u(1) < 0) Then
getD = (u(1) + PHI)
Else
getD = u(1)
End If
End Function

Function getE(ByVal PHI As Long) As Long
Dim great, e As Long

great = 0
e = 2

While (great <> 1)
e = e + 1
great = get_common_denom(e, PHI)
Wend
getE = e
End Function

Function get_common_denom(ByVal e As Long, ByVal PHI As Long)
Dim great, temp, a As Long

If (e > PHI) Then
While (e Mod PHI <> 0)
temp = e Mod PHI
e = PHI
PHI = temp
Wend
great = PHI
Else
While (PHI Mod e <> 0)
a = PHI Mod e
PHI = e
e = a
Wend
great = e
End If
get_common_denom = great
End Function

Private Sub show_primes()
status.Text = "1"
no_primes = 1
For i = 2 To 400
prime = True
For j = 2 To (i / 2)
If ((i Mod j) = 0) Then
prime = False
End If
Next j

If (prime = True) Then
no_primes = no_primes + 1
status.Text = status.Text + ", " + Str(i)
End If
Next i
status.Text = status.Text + vbCrLf + "Number of primes found:" + Str(no_primes)
End Sub

Private Sub Command1_Click()
Dim p, q, n, e, PHI, d, m, c As Long

p = Text1.Text
q = Text2.Text
If (check_prime(p) = False) Then
status.Text = "p is not a prime or is too large, please re-enter"
ElseIf (check_prime(q) = False) Then
status.Text = "q is not a prime or is too large, please re-enter"
Else
n = p * q
Text3.Text = n

PHI = (p - 1) * (q - 1)
e = getE((PHI))
d = getD((e), (PHI))
Text4.Text = PHI
Text5.Text = d
Text6.Text = e
m = Text7.Text

c = (m ^ e) Mod n
Text8.Text = c
m = decrypt(c, n, d)
Text9.Text = m
Label12.Caption = "Decrypt key =<" + Str(d) + "," + Str(n) + ">"
Label13.Caption = "Encrypt key =<" + Str(e) + "," + Str(n) + ">"
End If
End Sub

Private Sub Command2_Click()
End
End Sub

Private Sub Command3_Click()
frmBrowser.Show
End Sub

Private Sub Command4_Click()
Call show_primes
End Sub

② 求VB.NET的MD5算法调用

下面是完整的类,可以设置任意密码

'DES及md5加密解密----添加引用中添加对system.web的引用。
ImportsSystem.Security.Cryptography
ImportsSystem
ImportsSystem.Text
ImportsSystem.Web
'''<summary>
'''DES加密类
'''</summary>
'''<remarks></remarks>
PublicClassDESEncrypt
PublicSubDESEncrypt()
EndSub
PublicSharedFunctionEncrypt(ByValTextAsString)AsString
ReturnEncrypt(Text,"12345678")
EndFunction
PublicSharedFunctionEncrypt(ByValTextAsString,ByValsKeyAsString)AsString
()
DiminputByteArrayAsByte()
inputByteArray=Encoding.Default.GetBytes(Text)
des.Key=ASCIIEncoding.ASCII.GetBytes(System.Web.Security.FormsAuthentication.(sKey,"md5").Substring(0,8))
des.IV=ASCIIEncoding.ASCII.GetBytes(System.Web.Security.FormsAuthentication.(sKey,"md5").Substring(0,8))
DimmsAsNewSystem.IO.MemoryStream()
DimcsAsNewCryptoStream(ms,des.CreateEncryptor(),CryptoStreamMode.Write)
cs.Write(inputByteArray,0,inputByteArray.Length)
cs.FlushFinalBlock()
DimretAsNewStringBuilder()
DimbAsByte
ForEachbInms.ToArray()
ret.AppendFormat("{0:X2}",b)
Next
Returnret.ToString()
EndFunction
PublicSharedFunctionDecrypt(ByValTextAsString)AsString
ReturnDecrypt(Text,"12345678")
EndFunction
PublicSharedFunctionDecrypt(ByValTextAsString,ByValsKeyAsString)AsString
()
DimlenAsInteger
len=Text.Length/2
DiminputByteArray(len-1)AsByte
Dimx,iAsInteger
Forx=0Tolen-1
i=Convert.ToInt32(Text.Substring(x*2,2),16)
inputByteArray(x)=CType(i,Byte)
Next
des.Key=ASCIIEncoding.ASCII.GetBytes(System.Web.Security.FormsAuthentication.(sKey,"md5").Substring(0,8))
des.IV=ASCIIEncoding.ASCII.GetBytes(System.Web.Security.FormsAuthentication.(sKey,"md5").Substring(0,8))
DimmsAsNewSystem.IO.MemoryStream()
DimcsAsNewCryptoStream(ms,des.CreateDecryptor(),CryptoStreamMode.Write)
cs.Write(inputByteArray,0,inputByteArray.Length)
cs.FlushFinalBlock()
ReturnEncoding.Default.GetString(ms.ToArray())
EndFunction
EndClass
'以下是调用方法
PublicClassForm1
PrivateSubButton1_Click(ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs)HandlesButton1.Click'加密
Dimstr_EncryptAsString=DESEncrypt.Encrypt("你要加密的文本,可以是任意长度","密码,可以很长,如果省略这个参数就是默认的12345678")
EndSub
PrivateSubButton2_Click(ByValsenderAsSystem.Object,ByValeAsSystem.EventArgs)HandlesButton2.Click'解密
Dimstr_DecryptAsString=DESEncrypt.Decrypt("你要解密的文本,可以是任意长度","加密时用到的密码,如果省略这个参数就是默认的12345678")
EndSub

③ 我想做一个加密解密文件的VB程序!用des加密解密方法!!! 希望高手解答!

vb.net code注意随机密码按钮在没用,调试时你自己输入密码,一定为8位,我是将文件存在D盘,你自己在修改一下,那个就很简单
Imports System.IO
Imports System.Security.Cryptography
Imports System.Text
Public Class Form1
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim sSecretKey As String = Me.TextBox2.Text
EncryptFile(Me.TextBox1.Text, "D:\JMtest.txt", sSecretKey)
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Dim sSecretKey As String = Me.TextBox2.Text
DecryptFile("D:\JMtest.txt", "D:\Decrypted.txt", sSecretKey)
End Sub
Sub EncryptFile(ByVal sInputFilename As String, ByVal sOutputFilename As String, ByVal sKey As String)
Dim fsInput As New FileStream(sInputFilename, FileMode.Open, FileAccess.Read)
Dim fsEncrypted As New FileStream(sOutputFilename, FileMode.Create, FileAccess.Write)
Dim DES As New DESCryptoServiceProvider
DES.Key = ASCIIEncoding.ASCII.GetBytes(sKey)
DES.IV = ASCIIEncoding.ASCII.GetBytes(sKey)
Dim desencrypt As ICryptoTransform = DES.CreateEncryptor()
Dim cryptostream As New CryptoStream(fsEncrypted, desencrypt, CryptoStreamMode.Write)
Dim byteArrayInput(fsInput.Length - 1) As Byte
fsInput.Read(byteArrayInput, 0, byteArrayInput.Length)
cryptostream.Write(byteArrayInput, 0, byteArrayInput.Length)
cryptostream.Close()
End Sub
Sub DecryptFile(ByVal sInputFilename As String, ByVal sOutputFilename As String, ByVal sKey As String)
Dim DES As New DESCryptoServiceProvider
DES.Key() = ASCIIEncoding.ASCII.GetBytes(sKey)
DES.IV = ASCIIEncoding.ASCII.GetBytes(sKey)
Dim fsread As New FileStream(sInputFilename, FileMode.Open, FileAccess.Read)
Dim desdecrypt As ICryptoTransform = DES.CreateDecryptor
Dim cryptostreamDecr As New CryptoStream(fsread, desdecrypt, CryptoStreamMode.Read)
Dim fsDecrypted As New StreamWriter(sOutputFilename)
fsDecrypted.Write(New StreamReader(cryptostreamDecr, System.Text.ASCIIEncoding.Default).ReadToEnd)
fsDecrypted.Flush()
fsDecrypted.Close()
End Sub
Private Sub BtnChoose_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnChoose.Click
OpenFileDialog1.FileName = ""
OpenFileDialog1.Filter = "txt files (*.txt)|*.txt"
OpenFileDialog1.ShowDialog()
If OpenFileDialog1.FileName <> "" Then
Me.TextBox1.Text = OpenFileDialog1.FileName
End If
End Sub
End Class

热点内容
手柄怎么调节安卓模式 发布:2025-01-11 21:44:36 浏览:947
国产服务器搭建ftp 发布:2025-01-11 21:27:33 浏览:917
电脑系统哪个好用配置 发布:2025-01-11 21:26:04 浏览:139
交换机配置中web配置是什么意思 发布:2025-01-11 21:12:07 浏览:409
物资数据库 发布:2025-01-11 21:00:24 浏览:854
javastop 发布:2025-01-11 21:00:20 浏览:31
机械手臂用什么编程 发布:2025-01-11 20:55:32 浏览:592
买钓箱要哪些配置就够了 发布:2025-01-11 20:24:23 浏览:510
防脚本取色 发布:2025-01-11 20:15:17 浏览:638
为什么庄周活动安卓没开始 发布:2025-01-11 20:14:23 浏览:462