VB6校验文件防破解

1、开始窗体验证MD5值

1Private Sub Form_Load() 2 Dim str As String 3str = IIf(Len(App.Path) > 3, App.Path &amp; "\" & App.EXEName & ".exe", App.Path & App.EXEName & ".exe") 4Print "MD5:" & HashFile(str) '获取exe文件的MD5校验码 5Print "大小:" & FileLen(str) & " 字节"  '取当前体积大小 6End Sub

2、新建一个MD5.bas模块

  1Option Explicit   2Private Declare Function CryptAcquireContext Lib "advapi32.dll" _   3Alias "CryptAcquireContextA" ( _   4ByRef phProv As Long, _   5ByVal pszContainer As String, _   6ByVal pszProvider As String, _   7ByVal dwProvType As Long, _   8ByVal dwFlags As Long) As Long   9Private Declare Function CryptReleaseContext Lib "advapi32.dll" ( _  10ByVal hProv As Long, _  11ByVal dwFlags As Long) As Long  12Private Declare Function CryptCreateHash Lib "advapi32.dll" ( _  13ByVal hProv As Long, _  14ByVal Algid As Long, _  15ByVal hKey As Long, _  16ByVal dwFlags As Long, _  17ByRef phHash As Long) As Long  18Private Declare Function CryptDestroyHash Lib "advapi32.dll" ( _  19ByVal hHash As Long) As Long  20Private Declare Function CryptHashData Lib "advapi32.dll" ( _  21ByVal hHash As Long, _  22pbData As Any, _  23ByVal dwDataLen As Long, _  24ByVal dwFlags As Long) As Long  25Private Declare Function CryptGetHashParam Lib "advapi32.dll" ( _  26ByVal hHash As Long, _  27ByVal dwParam As Long, _  28pbData As Any, _  29pdwDataLen As Long, _  30ByVal dwFlags As Long) As Long  31Private Const PROV_RSA_FULL = 1  32Private Const CRYPT_NEWKEYSET = &H8  33Private Const ALG_CLASS_HASH = 32768  34Private Const ALG_TYPE_ANY = 0  35Private Const ALG_SID_MD2 = 1  36Private Const ALG_SID_MD4 = 2  37Private Const ALG_SID_MD5 = 3  38Private Const ALG_SID_SHA1 = 4  39Enum HashAlgorithm  40MD2 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2  41MD4 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4  42MD5 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5  43SHA1 = ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA1  44End Enum  45Private Const HP_HASHVAL = 2  46Private Const HP_HASHSIZE = 4  47Function HashFile( _  48ByVal FileName As String, _  49Optional ByVal Algorithm As HashAlgorithm = MD5) As String  50Dim hCtx As Long  51Dim hHash As Long  52Dim lFile As Long  53Dim lRes As Long  54Dim lLen As Long  55Dim lIdx As Long  56Dim abHash() As Byte  57If Len(Dir$(FileName)) = 0 Then Err.Raise 53  58lRes = CryptAcquireContext(hCtx, vbNullString, _  59vbNullString, PROV_RSA_FULL, 0)  60If lRes = 0 And Err.LastDllError = &H80090016 Then  61lRes = CryptAcquireContext(hCtx, vbNullString, _  62vbNullString, PROV_RSA_FULL, CRYPT_NEWKEYSET)  63End If  64If lRes <> 0 Then  65lRes = CryptCreateHash(hCtx, Algorithm, 0, 0, hHash)  66If lRes <> 0 Then  67lFile = FreeFile  68Open FileName For Binary As lFile  69If Err.Number = 0 Then  70Const BLOCK_SIZE As Long = 32 * 1024& ' 32K  71ReDim abBlock(1 To BLOCK_SIZE) As Byte  72Dim lCount As Long  73Dim lBlocks As Long  74Dim lLastBlock As Long  75lBlocks = LOF(lFile) \ BLOCK_SIZE  76lLastBlock = LOF(lFile) - lBlocks * BLOCK_SIZE  77For lCount = 1 To lBlocks  78Get lFile, , abBlock  79lRes = CryptHashData(hHash, abBlock(1), BLOCK_SIZE, 0)  80If lRes = 0 Then Exit For  81Next  82If lLastBlock > 0 And lRes <> 0 Then  83ReDim abBlock(1 To lLastBlock) As Byte  84Get lFile, , abBlock  85lRes = CryptHashData(hHash, abBlock(1), lLastBlock, 0)  86End If  87Close lFile  88End If  89If lRes <> 0 Then  90lRes = CryptGetHashParam(hHash, HP_HASHSIZE, lLen, 4, 0)  91If lRes <> 0 Then  92ReDim abHash(0 To lLen - 1)  93lRes = CryptGetHashParam(hHash, HP_HASHVAL, abHash(0), lLen, 0)  94If lRes <> 0 Then  95For lIdx = 0 To UBound(abHash)  96HashFile = HashFile & _  97Right$("0" & Hex$(abHash(lIdx)), 2)  98Next  99End If 100End If 101End If 102CryptDestroyHash hHash 103End If 104End If 105CryptReleaseContext hCtx, 0 106If lRes = 0 Then Err.Raise Err.LastDllError 107End Function

打赏