类似qq登录助手之类的代码－－－vb代码实现

给出模块文件和主文件代码，在窗体上建立 3个文本框和一个命令按钮。2个文本框是输入帐号 和密码的，通过命令行格式在用shell启动qq。qq密码加密代码是网上找的。

OptionExplicit
'GetDriveType
PrivateDeclareFunctionGetDriveType()FunctionGetDriveTypeLib"kernel32.dll"Alias"GetDriveTypeA"(ByValnDriveAsString)AsLong

PrivateDeclareFunctionRegCloseKey()FunctionRegCloseKeyLib"advapi32.dll"(ByValhKeyAsLong)AsLong
PrivateDeclareFunctionRegOpenKeyEx()FunctionRegOpenKeyExLib"advapi32.dll"Alias"RegOpenKeyExA"(ByValhKeyAsLong,ByVallpSubKeyAsString,ByValulOptionsAsLong,ByValsamDesiredAsLong,phkResultAsLong)AsLong
PrivateDeclareFunctionRegQueryValueEx()FunctionRegQueryValueExLib"advapi32.dll"Alias"RegQueryValueExA"(ByValhKeyAsLong,ByVallpValueNameAsString,ByVallpReservedAsLong,lpTypeAsLong,lpDataAsAny,lpcbDataAsLong)AsLong

'-注册表Api常数...
'---------------------------------------------------------------
'注册表创建类型值...
ConstREG_OPTION_NON_VOLATILE=0'当系统重新启动时，关键字被保留

'注册表关键字安全选项...
ConstREAD_CONTROL=&H20000
ConstKEY_QUERY_VALUE=&H1
ConstKEY_SET_VALUE=&H2
ConstKEY_CREATE_SUB_KEY=&H4
ConstKEY_ENUMERATE_SUB_KEYS=&H8
ConstKEY_NOTIFY=&H10
ConstKEY_CREATE_LINK=&H20
ConstKEY_READ=KEY_QUERY_VALUE+KEY_ENUMERATE_SUB_KEYS+KEY_NOTIFY+READ_CONTROL
ConstKEY_WRITE=KEY_SET_VALUE+KEY_CREATE_SUB_KEY+READ_CONTROL
ConstKEY_EXECUTE=KEY_READ
ConstKEY_ALL_ACCESS=KEY_QUERY_VALUE+KEY_SET_VALUE+KEY_CREATE_SUB_KEY+KEY_ENUMERATE_SUB_KEYS+KEY_NOTIFY+KEY_CREATE_LINK+READ_CONTROL

'返回值...
ConstERROR_NONE=0
ConstERROR_BADKEY=2
ConstERROR_ACCESS_DENIED=8
ConstERROR_SUCCESS=0

'有关导入/导出的常量
ConstREG_FORCE_RESTOREAsLong=8&
ConstTOKEN_QUERYAsLong=&H8&
ConstTOKEN_ADJUST_PRIVILEGESAsLong=&H20&
ConstSE_PRIVILEGE_ENABLEDAsLong=&H2
ConstSE_RESTORE_NAME="SeRestorePrivilege"
ConstSE_BACKUP_NAME="SeBackupPrivilege"

'---------------------------------------------------------------
'-注册表类型...
'---------------------------------------------------------------
PrivateTypeSECURITY_ATTRIBUTES
nLengthAsLong
lpSecurityDescriptorAsLong
bInheritHandleAsBoolean
EndType

PrivateTypeFILETIME
dwLowDateTimeAsLong
dwHighDateTimeAsLong
EndType

PrivateTypeLUID
lowpartAsLong
highpartAsLong
EndType

PrivateTypeLUID_AND_ATTRIBUTES
pLuidAsLUID
AttributesAsLong
EndType

PrivateTypeTOKEN_PRIVILEGES
PrivilegeCountAsLong
PrivilegesAsLUID_AND_ATTRIBUTES
EndType

'---------------------------------------------------------------
'-自定义枚举类型...
'---------------------------------------------------------------
'注册表数据类型...
PublicEnumValueTypeEnumValueType
REG_SZ=1'字符串值
REG_EXPAND_SZ=2'可扩充字符串值
REG_BINARY=3'二进制值
REG_DWORD=4'DWORD值
REG_MULTI_SZ=7'多字符串值
EndEnum

'注册表关键字根类型...
PublicEnumKeyRootEnumKeyRoot
HKEY_CLASSES_ROOT=&H80000000
HKEY_CURRENT_USER=&H80000001
HKEY_LOCAL_MACHINE=&H80000002
HKEY_USERS=&H80000003
HKEY_PERFORMANCE_DATA=&H80000004
HKEY_CURRENT_CONFIG=&H80000005
HKEY_DYN_DATA=&H80000006
EndEnum

PrivatehKeyAsLong'注册表打开项的句柄
PrivateiAsLong,jAsLong'循环变量
PrivateSuccessAsLong'API函数的返回值,判断函数调用是否成功

PublicFunctionGetKeyValue()FunctionGetKeyValue(KeyRootAsKeyRoot,KeyNameAsString,ValueNameAsString,OptionalValueTypeAsLong)AsString
DimTempValueAsString'注册表关键字的临时值
DimValueAsString'注册表关键字的值
DimValueSizeAsLong'注册表关键字的值的实际长度
TempValue=Space(1024)'存储注册表关键字的临时值的缓冲区
ValueSize=1024'设置注册表关键字的值的默认长度

'打开一个已存在的注册表关键字...
RegOpenKeyExKeyRoot,KeyName,0,KEY_ALL_ACCESS,hKey

'获得已打开的注册表关键字的值...
RegQueryValueExhKey,ValueName,0,ValueType,ByValTempValue,ValueSize

'返回注册表关键字的的值...
SelectCaseValueType'通过判断关键字的类型,进行处理
CaseREG_SZ,REG_MULTI_SZ,REG_EXPAND_SZ
TempValue=Left$(TempValue,ValueSize-1)'去掉TempValue尾部空格
Value=TempValue
EndSelect

'关闭注册表关键字...
RegCloseKeyhKey
GetKeyValue=Trim(Value)'返回函数值
EndFunction

PublicFunctionGetDriverNum()FunctionGetDriverNum()AsInteger
OnErrorResumeNext
DimDriveNumAsInteger
DimTempDriveAsString
DimXAsInteger
DriveNum=0
ForX=97To122Step1'检测从A－Z（盘符）
TempDrive=GetDriveType(Chr(X)&":")
SelectCaseTempDrive'如是3则表示是硬盘，测试你有几个盘5-CD-ROM
Case3,5
DriveNum=DriveNum+1
EndSelect
NextX
GetDriverNum=DriveNum
EndFunction

'OptionExplicit
Privatem_lOnBits(30)
Privatem_l2Power(30)
PrivateConstBITS_TO_A_BYTE=8
PrivateConstBYTES_TO_A_WORD=4
PrivateConstBITS_TO_A_WORD=32

PrivateSubCommand1_Click()SubCommand1_Click()
DimTypePathAsString,bretAsBoolean
TypePath=GetKeyValue(HKEY_LOCAL_MACHINE,"SOFTWARETENCENTQQ","Install")
'TypePath=GetKeyValue(HKEY_LOCAL_MACHINE,"SOFTWARETENCENTTM2008","Install")
IfTypePath=""ThenMsgBox"没有找到QQ！":ExitSub
Text1="QQ.exe/STARTQQUIN:"&Text2&"PWDHASH:"&Str2QQPwdHash(Text3)&"/STAT:40"
bret=Shell(TypePath&Text1,vbNormalNoFocus)
EndSub
PublicFunctionStr2QQPwdHash()FunctionStr2QQPwdHash(Str1AsString)

Str2QQPwdHash=Hex2Base64(MD5(Str1,32))&"=="

EndFunction

'以下模块代码

FunctionHex2Bin()FunctionHex2Bin(HexStr1AsString)

SelectCaseUCase(HexStr1)
'16进制转换二进制
Case"0"
q1="0000"
Case"1"
q1="0001"
Case"2"
q1="0010"
Case"3"
q1="0011"
Case"4"
q1="0100"
Case"5"
q1="0101"
Case"6"
q1="0110"
Case"7"
q1="0111"
Case"8"
q1="1000"
Case"9"
q1="1001"
Case"A"
q1="1010"
Case"B"
q1="1011"
Case"C"
q1="1100"
Case"D"
q1="1101"
Case"E"
q1="1110"
Case"F"
q1="1111"
EndSelect
Hex2Bin=q1
EndFunction
FunctionHex2Bin1()FunctionHex2Bin1(HexStr2AsString)
'分断
q1=Hex2Bin(Mid(HexStr2,1,1))
q2=Hex2Bin(Mid(HexStr2,2,1))
q3=Hex2Bin(Mid(HexStr2,3,1))
q4=Hex2Bin(Mid(HexStr2,4,1))
q5=Hex2Bin(Mid(HexStr2,5,1))
q6=Hex2Bin(Mid(HexStr2,6,1))
q7=Hex2Bin(Mid(HexStr2,7,1))
q8=Hex2Bin(Mid(HexStr2,8,1))
q9=Hex2Bin(Mid(HexStr2,9,1))
q10=Hex2Bin(Mid(HexStr2,10,1))
q11=Hex2Bin(Mid(HexStr2,11,1))
q12=Hex2Bin(Mid(HexStr2,12,1))
Hex2Bin1=q1&q2&q3&q4&q5&q6&q7&q8&q9&q10&q11&q12
EndFunction
FunctionBin324()FunctionBin324(BinCode1AsString)
'填充
q1=Mid(BinCode1,1,6)
q2=Mid(BinCode1,7,6)
q3=Mid(BinCode1,13,6)
q4=Mid(BinCode1,19,6)
q5=Mid(BinCode1,25,6)
q6=Mid(BinCode1,31,6)
q7=Mid(BinCode1,37,6)
q8=Mid(BinCode1,43,6)

Bin324="00"&q1&"00"&q2&"00"&q3&"00"&q4&"00"&q5&"00"&q6&"00"&q7&"00"&q8
EndFunction

FunctionBin2Hex()FunctionBin2Hex(BinCode2AsString)

'二进制转换为16进制（BASE64一部分）
SelectCaseUCase(BinCode2)

Case"0000"
q1="0"
Case"0001"
q1="1"
Case"0010"
q1="2"
Case"0011"
q1="3"
Case"0100"
q1="4"
Case"0101"
q1="5"
Case"0110"
q1="6"
Case"0111"
q1="7"
Case"1000"
q1="8"
Case"1001"
q1="9"
Case"1010"
q1="A"
Case"1011"
q1="B"
Case"1100"
q1="C"
Case"1101"
q1="D"
Case"1110"
q1="E"
Case"1111"
q1="F"
EndSelect

Bin2Hex=q1

EndFunction

FunctionBin2Hex2()FunctionBin2Hex2(BinCodeAsString)

q1=Bin2Hex(Mid(BinCode,1,4))
q2=Bin2Hex(Mid(BinCode,5,4))
q3=Bin2Hex(Mid(BinCode,9,4))
q4=Bin2Hex(Mid(BinCode,13,4))

Bin2Hex2=q1&q2&q3&q4
EndFunction

FunctionBin2Hex3()FunctionBin2Hex3(BinCode3AsString)

q1=Bin2Hex2(Mid(BinCode3,1,16))
q2=Bin2Hex2(Mid(BinCode3,17,16))
q3=Bin2Hex2(Mid(BinCode3,33,16))
q4=Bin2Hex2(Mid(BinCode3,49,16))

Bin2Hex3=q1&q2&q3&q4
EndFunction
FunctionHexBase64()FunctionHexBase64(HexStringAsString)

HexBase64=HexBase64_2(Bin2Hex3(Bin324(Hex2Bin1(HexString))))
EndFunction
FunctionHexBase64_1()FunctionHexBase64_1(HexStringAsString)

SelectCaseHexString

Case"00"
q1="A"
Case"01"
q1="B"
Case"02"
q1="C"
Case"03"
q1="D"
Case"04"
q1="E"
Case"05"
q1="F"
Case"06"
q1="G"
Case"07"
q1="H"
Case"08"
q1="I"
Case"09"
q1="J"
Case"0A"
q1="K"
Case"0B"
q1="L"
Case"0C"
q1="M"
Case"0D"
q1="N"
Case"0E"
q1="O"
Case"0F"
q1="P"
Case"10"
q1="Q"
Case"11"
q1="R"
Case"12"
q1="S"
Case"13"
q1="T"
Case"14"
q1="U"
Case"15"
q1="V"
Case"16"
q1="W"
Case"17"
q1="X"
Case"18"
q1="Y"
Case"19"
q1="Z"
Case"1A"
q1="a"
Case"1B"
q1="b"
Case"1C"
q1="c"
Case"1D"
q1="d"
Case"1E"
q1="e"
Case"1F"
q1="f"
Case"20"
q1="g"
Case"21"
q1="h"
Case"22"
q1="i"
Case"23"
q1="j"
Case"24"
q1="k"
Case"25"
q1="l"
Case"26"
q1="m"
Case"27"
q1="n"
Case"28"
q1="o"
Case"29"
q1="p"
Case"2A"
q1="q"
Case"2B"
q1="r"
Case"2C"
q1="s"
Case"2D"
q1="t"
Case"2E"
q1="u"
Case"2F"
q1="v"

Case"30"
q1="w"
Case"31"
q1="x"
Case"32"
q1="y"
Case"33"
q1="z"
Case"34"
q1="0"
Case"35"
q1="1"
Case"36"
q1="2"
Case"37"
q1="3"
Case"38"
q1="4"
Case"39"
q1="5"
Case"3A"
q1="6"
Case"3B"
q1="7"
Case"3C"
q1="8"
Case"3D"
q1="9"
Case"3E"
q1="+"
Case"3F"
q1="/"

EndSelect
HexBase64_1=q1
EndFunction
FunctionHexBase64_2()FunctionHexBase64_2(HexStringAsString)
q1=HexBase64_1(Mid(HexString,1,2))
q2=HexBase64_1(Mid(HexString,3,2))
q3=HexBase64_1(Mid(HexString,5,2))
q4=HexBase64_1(Mid(HexString,7,2))
q5=HexBase64_1(Mid(HexString,9,2))
q6=HexBase64_1(Mid(HexString,11,2))
q7=HexBase64_1(Mid(HexString,13,2))
q8=HexBase64_1(Mid(HexString,15,2))
HexBase64_2=q1&q2&q3&q4&q5&q6&q7&q8
EndFunction

FunctionHex2Base64()FunctionHex2Base64(HexCodeAsString)
DimiAsInteger
Fori=0ToLen(HexCode)Step12
q1=q1&HexBase64(Mid(HexCode,i+1,12))

Next
Hex2Base64=q1
EndFunction

PrivateFunctionmd5_F()Functionmd5_F(X,Y,z)
md5_F=(XAndY)Or((NotX)Andz)
EndFunction

PrivateFunctionmd5_G()Functionmd5_G(X,Y,z)
md5_G=(XAndz)Or(YAnd(Notz))
EndFunction

PrivateFunctionmd5_H()Functionmd5_H(X,Y,z)
md5_H=(XXorYXorz)
EndFunction

PrivateFunctionmd5_I()Functionmd5_I(X,Y,z)
md5_I=(YXor(XOr(Notz)))
EndFunction

PrivateSubmd5_FF()Submd5_FF(a,b,c,d,X,s,ac)
a=AddUnsigned(a,AddUnsigned(AddUnsigned(md5_F(b,c,d),X),ac))
a=RotateLeft(a,s)
a=AddUnsigned(a,b)
EndSub

PrivateSubmd5_GG()Submd5_GG(a,b,c,d,X,s,ac)
a=AddUnsigned(a,AddUnsigned(AddUnsigned(md5_G(b,c,d),X),ac))
a=RotateLeft(a,s)
a=AddUnsigned(a,b)
EndSub

PrivateSubmd5_HH()Submd5_HH(a,b,c,d,X,s,ac)
a=AddUnsigned(a,AddUnsigned(AddUnsigned(md5_H(b,c,d),X),ac))
a=RotateLeft(a,s)
a=AddUnsigned(a,b)
EndSub

PrivateSubmd5_II()Submd5_II(a,b,c,d,X,s,ac)
a=AddUnsigned(a,AddUnsigned(AddUnsigned(md5_I(b,c,d),X),ac))
a=RotateLeft(a,s)
a=AddUnsigned(a,b)
EndSub

PrivateFunctionConvertToWordArray()FunctionConvertToWordArray(sMessage)
DimlMessageLength
DimlNumberOfWords
DimlWordArray()
DimlBytePosition
DimlByteCount
DimlWordCount

ConstMODULUS_BITS=512
ConstCONGRUENT_BITS=448

lMessageLength=Len(sMessage)

lNumberOfWords=(((lMessageLength+((MODULUS_BITS-CONGRUENT_BITS)BITS_TO_A_BYTE))(MODULUS_BITSBITS_TO_A_BYTE))+1)*(MODULUS_BITSBITS_TO_A_WORD)
ReDimlWordArray(lNumberOfWords-1)

lBytePosition=0
lByteCount=0
DoUntillByteCount>=lMessageLength
lWordCount=lByteCountBYTES_TO_A_WORD
lBytePosition=(lByteCountModBYTES_TO_A_WORD)*BITS_TO_A_BYTE
lWordArray(lWordCount)=lWordArray(lWordCount)OrLShift(Asc(Mid(sMessage,lByteCount+1,1)),lBytePosition)
lByteCount=lByteCount+1
Loop

lWordCount=lByteCountBYTES_TO_A_WORD
lBytePosition=(lByteCountModBYTES_TO_A_WORD)*BITS_TO_A_BYTE

lWordArray(lWordCount)=lWordArray(lWordCount)OrLShift(&H80,lBytePosition)

lWordArray(lNumberOfWords-2)=LShift(lMessageLength,3)
lWordArray(lNumberOfWords-1)=RShift(lMessageLength,29)

ConvertToWordArray=lWordArray
EndFunction

PrivateFunctionWordToHex()FunctionWordToHex(lValue)
DimlByte
DimlCount

ForlCount=0To3
lByte=RShift(lValue,lCount*BITS_TO_A_BYTE)Andm_lOnBits(BITS_TO_A_BYTE-1)
WordToHex=WordToHex&Right("0"&Hex(lByte),2)
Next
EndFunction

PublicFunctionMD5()FunctionMD5(sMessage,stype)
m_lOnBits(0)=CLng(1)
m_lOnBits(1)=CLng(3)
m_lOnBits(2)=CLng(7)
m_lOnBits(3)=CLng(15)
m_lOnBits(4)=CLng(31)
m_lOnBits(5)=CLng(63)
m_lOnBits(6)=CLng(127)
m_lOnBits(7)=CLng(255)
m_lOnBits(8)=CLng(511)
m_lOnBits(9)=CLng(1023)
m_lOnBits(10)=CLng(2047)
m_lOnBits(11)=CLng(4095)
m_lOnBits(12)=CLng(8191)
m_lOnBits(13)=CLng(16383)
m_lOnBits(14)=CLng(32767)
m_lOnBits(15)=CLng(65535)
m_lOnBits(16)=CLng(131071)
m_lOnBits(17)=CLng(262143)
m_lOnBits(18)=CLng(524287)
m_lOnBits(19)=CLng(1048575)
m_lOnBits(20)=CLng(2097151)
m_lOnBits(21)=CLng(4194303)
m_lOnBits(22)=CLng(8388607)
m_lOnBits(23)=CLng(16777215)
m_lOnBits(24)=CLng(33554431)
m_lOnBits(25)=CLng(67108863)
m_lOnBits(26)=CLng(134217727)
m_lOnBits(27)=CLng(268435455)
m_lOnBits(28)=CLng(536870911)
m_lOnBits(29)=CLng(1073741823)
m_lOnBits(30)=CLng(2147483647)

m_l2Power(0)=CLng(1)
m_l2Power(1)=CLng(2)
m_l2Power(2)=CLng(4)
m_l2Power(3)=CLng(8)
m_l2Power(4)=CLng(16)
m_l2Power(5)=CLng(32)
m_l2Power(6)=CLng(64)
m_l2Power(7)=CLng(128)
m_l2Power(8)=CLng(256)
m_l2Power(9)=CLng(512)
m_l2Power(10)=CLng(1024)
m_l2Power(11)=CLng(2048)
m_l2Power(12)=CLng(4096)
m_l2Power(13)=CLng(8192)
m_l2Power(14)=CLng(16384)
m_l2Power(15)=CLng(32768)
m_l2Power(16)=CLng(65536)
m_l2Power(17)=CLng(131072)
m_l2Power(18)=CLng(262144)
m_l2Power(19)=CLng(524288)
m_l2Power(20)=CLng(1048576)
m_l2Power(21)=CLng(2097152)
m_l2Power(22)=CLng(4194304)
m_l2Power(23)=CLng(8388608)
m_l2Power(24)=CLng(16777216)
m_l2Power(25)=CLng(33554432)
m_l2Power(26)=CLng(67108864)
m_l2Power(27)=CLng(134217728)
m_l2Power(28)=CLng(268435456)
m_l2Power(29)=CLng(536870912)
m_l2Power(30)=CLng(1073741824)

DimX
Dimk
DimAA
DimBB
DimCC
DimDD
Dima
Dimb
Dimc
Dimd

ConstS11=7
ConstS12=12
ConstS13=17
ConstS14=22
ConstS21=5
ConstS22=9
ConstS23=14
ConstS24=20
ConstS31=4
ConstS32=11
ConstS33=16
ConstS34=23
ConstS41=6
ConstS42=10
ConstS43=15
ConstS44=21

X=ConvertToWordArray(sMessage)

a=&H67452301
b=&HEFCDAB89
c=&H98BADCFE
d=&H10325476

Fork=0ToUBound(X)Step16
AA=a
BB=b
CC=c
DD=d

md5_FFa,b,c,d,X(k+0),S11,&HD76AA478
md5_FFd,a,b,c,X(k+1),S12,&HE8C7B756
md5_FFc,d,a,b,X(k+2),S13,&H242070DB
md5_FFb,c,d,a,X(k+3),S14,&HC1BDCEEE
md5_FFa,b,c,d,X(k+4),S11,&HF57C0FAF
md5_FFd,a,b,c,X(k+5),S12,&H4787C62A
md5_FFc,d,a,b,X(k+6),S13,&HA8304613
md5_FFb,c,d,a,X(k+7),S14,&HFD469501
md5_FFa,b,c,d,X(k+8),S11,&H698098D8
md5_FFd,a,b,c,X(k+9),S12,&H8B44F7AF
md5_FFc,d,a,b,X(k+10),S13,&HFFFF5BB1
md5_FFb,c,d,a,X(k+11),S14,&H895CD7BE
md5_FFa,b,c,d,X(k+12),S11,&H6B901122
md5_FFd,a,b,c,X(k+13),S12,&HFD987193
md5_FFc,d,a,b,X(k+14),S13,&HA679438E
md5_FFb,c,d,a,X(k+15),S14,&H49B40821

md5_GGa,b,c,d,X(k+1),S21,&HF61E2562
md5_GGd,a,b,c,X(k+6),S22,&HC040B340
md5_GGc,d,a,b,X(k+11),S23,&H265E5A51
md5_GGb,c,d,a,X(k+0),S24,&HE9B6C7AA
md5_GGa,b,c,d,X(k+5),S21,&HD62F105D
md5_GGd,a,b,c,X(k+10),S22,&H2441453
md5_GGc,d,a,b,X(k+15),S23,&HD8A1E681
md5_GGb,c,d,a,X(k+4),S24,&HE7D3FBC8
md5_GGa,b,c,d,X(k+9),S21,&H21E1CDE6
md5_GGd,a,b,c,X(k+14),S22,&HC33707D6
md5_GGc,d,a,b,X(k+3),S23,&HF4D50D87
md5_GGb,c,d,a,X(k+8),S24,&H455A14ED
md5_GGa,b,c,d,X(k+13),S21,&HA9E3E905
md5_GGd,a,b,c,X(k+2),S22,&HFCEFA3F8
md5_GGc,d,a,b,X(k+7),S23,&H676F02D9
md5_GGb,c,d,a,X(k+12),S24,&H8D2A4C8A

md5_HHa,b,c,d,X(k+5),S31,&HFFFA3942
md5_HHd,a,b,c,X(k+8),S32,&H8771F681
md5_HHc,d,a,b,X(k+11),S33,&H6D9D6122
md5_HHb,c,d,a,X(k+14),S34,&HFDE5380C
md5_HHa,b,c,d,X(k+1),S31,&HA4BEEA44
md5_HHd,a,b,c,X(k+4),S32,&H4BDECFA9
md5_HHc,d,a,b,X(k+7),S33,&HF6BB4B60
md5_HHb,c,d,a,X(k+10),S34,&HBEBFBC70
md5_HHa,b,c,d,X(k+13),S31,&H289B7EC6
md5_HHd,a,b,c,X(k+0),S32,&HEAA127FA
md5_HHc,d,a,b,X(k+3),S33,&HD4EF3085
md5_HHb,c,d,a,X(k+6),S34,&H4881D05
md5_HHa,b,c,d,X(k+9),S31,&HD9D4D039
md5_HHd,a,b,c,X(k+12),S32,&HE6DB99E5
md5_HHc,d,a,b,X(k+15),S33,&H1FA27CF8
md5_HHb,c,d,a,X(k+2),S34,&HC4AC5665

md5_IIa,b,c,d,X(k+0),S41,&HF4292244
md5_IId,a,b,c,X(k+7),S42,&H432AFF97
md5_IIc,d,a,b,X(k+14),S43,&HAB9423A7
md5_IIb,c,d,a,X(k+5),S44,&HFC93A039
md5_IIa,b,c,d,X(k+12),S41,&H655B59C3
md5_IId,a,b,c,X(k+3),S42,&H8F0CCC92
md5_IIc,d,a,b,X(k+10),S43,&HFFEFF47D
md5_IIb,c,d,a,X(k+1),S44,&H85845DD1
md5_IIa,b,c,d,X(k+8),S41,&H6FA87E4F
md5_IId,a,b,c,X(k+15),S42,&HFE2CE6E0
md5_IIc,d,a,b,X(k+6),S43,&HA3014314
md5_IIb,c,d,a,X(k+13),S44,&H4E0811A1
md5_IIa,b,c,d,X(k+4),S41,&HF7537E82
md5_IId,a,b,c,X(k+11),S42,&HBD3AF235
md5_IIc,d,a,b,X(k+2),S43,&H2AD7D2BB
md5_IIb,c,d,a,X(k+9),S44,&HEB86D391

a=AddUnsigned(a,AA)
b=AddUnsigned(b,BB)
c=AddUnsigned(c,CC)
d=AddUnsigned(d,DD)
Next

Ifstype=32Then
MD5=LCase(WordToHex(a)&WordToHex(b)&WordToHex(c)&WordToHex(d))
Else
MD5=LCase(WordToHex(b)&WordToHex(c))
EndIf

EndFunction

PrivateFunctionAddUnsigned()FunctionAddUnsigned(lX,lY)
DimlX4
DimlY4
DimlX8
DimlY8
DimlResult

lX8=lXAnd&H80000000
lY8=lYAnd&H80000000
lX4=lXAnd&H40000000
lY4=lYAnd&H40000000

lResult=(lXAnd&H3FFFFFFF)+(lYAnd&H3FFFFFFF)

IflX4AndlY4Then
lResult=lResultXor&H80000000XorlX8XorlY8
ElseIflX4OrlY4Then
IflResultAnd&H40000000Then
lResult=lResultXor&HC0000000XorlX8XorlY8
Else
lResult=lResultXor&H40000000XorlX8XorlY8
EndIf
Else
lResult=lResultXorlX8XorlY8
EndIf

AddUnsigned=lResult
EndFunction

PrivateFunctionLShift()FunctionLShift(lValue,iShiftBits)
IfiShiftBits=0Then
LShift=lValue
ExitFunction
ElseIfiShiftBits=31Then
IflValueAnd1Then
LShift=&H80000000
Else
LShift=0
EndIf
ExitFunction
ElseIfiShiftBits<0OriShiftBits>31Then
Err.Raise6
EndIf

If(lValueAndm_l2Power(31-iShiftBits))Then
LShift=((lValueAndm_lOnBits(31-(iShiftBits+1)))*m_l2Power(iShiftBits))Or&H80000000
Else
LShift=((lValueAndm_lOnBits(31-iShiftBits))*m_l2Power(iShiftBits))
EndIf
EndFunction

PrivateFunctionRShift()FunctionRShift(lValue,iShiftBits)
IfiShiftBits=0Then
RShift=lValue
ExitFunction
ElseIfiShiftBits=31Then
IflValueAnd&H80000000Then
RShift=1
Else
RShift=0
EndIf
ExitFunction
ElseIfiShiftBits<0OriShiftBits>31Then
Err.Raise6
EndIf

RShift=(lValueAnd&H7FFFFFFE)m_l2Power(iShiftBits)

If(lValueAnd&H80000000)Then
RShift=(RShiftOr(&H40000000m_l2Power(iShiftBits-1)))
EndIf
EndFunction

PrivateFunctionRotateLeft()FunctionRotateLeft(lValue,iShiftBits)
RotateLeft=LShift(lValue,iShiftBits)OrRShift(lValue,(32-iShiftBits))
EndFunction

版权声明：本文为博主原创文章，未经博主允许不得转载。