网上很多都是解密成字符串形式,这个是修改的解密成16进制串形式。弹出对话框中输入待解密内容,确定后解密结果保存在hwid.txt文件中。
比如“1+LKtQAIAgDoBgAAADKvQB0EBgc4mIr0YUO35A==”,解密得到:D7E2CAB500080200E80600000032AF401D04060738988AF46143B7E4
代码如下:
Dim Code,hwid
Code = InputBox("请输入机器码:","提示")
hwid = Base64Decode(Code)
MsgBox hwid, 64, "结果"
Dim fso,f1
Set fso = CreateObject("scripting.FileSystemObject")
Set f1 = fso.CreateTextFile("hwid.txt",True)
f1.Write(hwid)
f1.close
Function Base64Decode(ByVal base64String)
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim dataLength, sOut, groupBegin
base64String = Replace(base64String, vbCrLf, "")
base64String = Replace(base64String, vbTab, "")
base64String = Replace(base64String, " ", "")
dataLength = Len(base64String)
If dataLength Mod 4 <> 0 Then
Err.Raise 1, "Base64Decode", "Bad Base64 string."
Exit Function
End If
For groupBegin = 1 To dataLength Step 4
Dim numDataBytes, CharCounter, thisChar, thisData, nGroup, pOut
numDataBytes = 3
nGroup = 0
For CharCounter = 0 To 3
thisChar = Mid(base64String, groupBegin + CharCounter, 1)
If thisChar = "=" Then
numDataBytes = numDataBytes - 1
thisData = 0
Else
thisData = InStr(1, Base64, thisChar, vbBinaryCompare) - 1
End If
If thisData = -1 Then
Err.Raise 2, "Base64Decode", "Bad character In Base64 string."
Exit Function
End If
nGroup = 64 * nGroup + thisData
Next
nGroup = Hex(nGroup)
nGroup = String(6 - Len(nGroup), "0") & nGroup
pOut = Mid(nGroup, 1, 2) + Mid(nGroup, 3, 2) + Mid(nGroup, 5, 2)
sOut = sOut & Left(pOut, numDataBytes * 2)
Next
Base64Decode = sOut
End Function
已经有(0)位网友发表了评论,你也评一评吧!
原创文章如转载,请注明:转载自Eddy Blog
原文地址:http://www.rrgod.com/program/841.html 欢迎订阅Eddy Blog。