求vb md5加解密
If password.Text = "haha" Then
Shell ("cmd.exe"), vbNormalFocus
Else
msgbox "密码不对!"
本来是想设置密码，不输密码就不能运行指定程序。但是这样太简单了，别人直接用记事本打开这个exe就可以看到密码了。所以希望大家帮我写个md5解密的过程，完善这个小程序。
假如 密码haha MD5加密后为 dadsasdads ，加密后的结果大家可以到 www.cmd5.com 查看
那么原程序就变为 dim md5mima
md5mima = md5("dadsasdads")
If password.Text = md5mima Then
只要源代码中不出现 haha 这个原密码就可以。
要写的就是 md5() 这个 function 过程
就这样简单。。。 我不知道上面的语法有没有写对，不会vb，但我相信大家明白意思。会的帮我写个程序，不要编译好的exe ，要全部的源代码 。
追问：不懂啊。。。。。。 类已经建好了 是改成这样么 ：
Private Sub cmd_Click()
Dim mymd5 As New ClsAPIMD5
Dim md5str As String
md5str = mymd5.HashString("2b6fe62a63afe561", md5)
Set mymd5 = Nothing
If password.Text = md5str Then
Shell ("cmd.exe"), vbNormalFocus
Else
MsgBox "抱歉,非请莫入!"
End
End If
End Sub
2b6fe62a63afe561
是 haha md5加密后的 字符
答案：代码很多。仔细看先建一个类Class Module 取名为ClsAPIMD5
复制下面的代码到类里：
'API 做的MD5类
Option Explicit
Private Declare Function CryptAcquireContext Lib "advapi32.dll" _
Alias "CryptAcquireContextA" ( _
ByRef phProv As Long, _
ByVal pszContainer As String, _
ByVal pszProvider As String, _
ByVal dwProvType As Long, _
ByVal dwFlags As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32.dll" ( _
ByVal hProv As Long, _
ByVal dwFlags As Long) As Long
Private Declare Function CryptCreateHash Lib "advapi32.dll" ( _
ByVal hProv As Long, _
ByVal Algid As Long, _
ByVal hKey As Long, _
ByVal dwFlags As Long, _
ByRef phHash As Long) As Long
Private Declare Function CryptDestroyHash Lib "advapi32.dll" ( _
ByVal hHash As Long) As Long
Private Declare Function CryptHashData Lib "advapi32.dll" ( _
ByVal hHash As Long, _
pbData As Any, _
ByVal dwDataLen As Long, _
ByVal dwFlags As Long) As Long
Private Declare Function CryptGetHashParam Lib "advapi32.dll" ( _
ByVal hHash As Long, _
ByVal dwParam As Long, _
pbData As Any, _
pdwDataLen As Long, _
ByVal dwFlags As Long) As Long
Private Const PROV_RSA_FULL = 1
Private Const ALG_CLASS_HASH = 32768
Private Const ALG_TYPE_ANY = 0
Private Const ALG_SID_MD2 = 1
Private Const ALG_SID_MD4 = 2
Private Const ALG_SID_MD5 = 3
Private Const ALG_SID_SHA1 = 4
Enum HashAlgorithm
md2 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2
MD4 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4
md5 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5
SHA1 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA1
End Enum
Private Const HP_HASHVAL = 2
Private Const HP_HASHSIZE = 4
Function HashString( _
ByVal Str As String, _
Optional ByVal Algorithm As HashAlgorithm = md5) As String
Dim hCtx As Long
Dim hHash As Long
Dim lRes As Long
Dim lLen As Long
Dim lIdx As Long
Dim abData() As Byte
' Get default provider context handle
lRes = CryptAcquireContext(hCtx, vbNullString, _
vbNullString, PROV_RSA_FULL, 0)
If lRes <> 0 Then
' Create the hash
lRes = CryptCreateHash(hCtx, Algorithm, 0, 0, hHash)
If lRes <> 0 Then
' Hash the string
lRes = CryptHashData(hHash, ByVal Str, Len(Str), 0)
If lRes <> 0 Then
' Get the hash lenght
lRes = CryptGetHashParam(hHash, HP_HASHSIZE, lLen, 4, 0)
If lRes <> 0 Then
' Initialize the buffer
ReDim abData(0 To lLen - 1)
' Get the hash value
lRes = CryptGetHashParam(hHash, HP_HASHVAL, abData(0), lLen, 0)
If lRes <> 0 Then
' Convert value to hex string
For lIdx = 0 To UBound(abData)
HashString = HashString & _
Right$("0" & Hex$(abData(lIdx)), 2)
Next
End If
End If
End If
' Release the hash handle
CryptDestroyHash hHash
End If
End If
' Release the provider context
CryptReleaseContext hCtx, 0
' Raise an error if lRes = 0
If lRes = 0 Then Err.Raise Err.LastDllError
End Function
Function HashFile( _
ByVal Filename As String, _
Optional ByVal Algorithm As HashAlgorithm = md5) As String
Dim hCtx As Long
Dim hHash As Long
Dim lFile As Long
Dim lRes As Long
Dim lLen As Long
Dim lIdx As Long
Dim abHash() As Byte
' Check if the file exists (not the best method BTW!)
If Len(Dir$(Filename)) = 0 Then Err.Raise 53
' Get default provider context handle
lRes = CryptAcquireContext(hCtx, vbNullString, _
vbNullString, PROV_RSA_FULL, 0)
If lRes = 0 And Err.LastDllError = &H80090016 Then
' There's no default keyset container!!!
' Get the provider context and create
' a default keyset container
lRes = CryptAcquireContext(hCtx, vbNullString, _
vbNullString, PROV_RSA_FULL, CRYPT_NEWKEYSET)
End If
If lRes <> 0 Then
' Create the hash
lRes = CryptCreateHash(hCtx, Algorithm, 0, 0, hHash)
If lRes <> 0 Then
' Get a file handle
lFile = FreeFile
' Open the file
Open Filename For Binary As lFile
If Err.Number = 0 Then
Const BLOCK_SIZE As Long = 32 * 1024& ' 32K
ReDim abBlock(1 To BLOCK_SIZE) As Byte
&nb
上一个：用socket协议登录网站 VB
下一个：vb的for代码怎么写？
