SHA1加密算法40位支持中文VB60实例.docx

SHA1加密算法40位支持中文VB60实例.docx

《SHA1加密算法40位支持中文VB60实例.docx》由会员分享，可在线阅读，更多相关《SHA1加密算法40位支持中文VB60实例.docx（13页珍藏版）》请在冰豆网上搜索。

SHA1加密算法40位支持中文VB60实例

SHA1加密算法（40位支持中文）VB6.0实例：

Ｆorm1窗体及代码如下：

OptionExplicit

PrivateSubCommand1_Click（）

Text2.Text=StringSHA1（Text1.Text）

EndSub

通用模块代码如下：

'--------------------------------------------------------------------------------------------------------------------------

'AttributeVB_Name="SHA1"

OptionExplicit

'TITLE:

'SecureHashAlgorithm,SHA-1

'AUTHORS:

'AdaptedbyIainBuchanfromVisualBasiccodepostedatPlanet-Source-CodebyPeterGirard

'

'PURPOSE:

'Creatingasecureidentifierfromperson-identifiabledata

'ThefunctionSecureHashgeneratesa160-bit（20-hex-digit）messagedigestforagivenmessage（String）.

'Itiscomputationallyinfeasabletorecoverthemessagefromthedigest.

'Thedigestisuniquetothemessagewithintherealmsofpracticalprobability.

'Theonlywaytofindthesourcemessageforadigestisbyhashingallpossiblemessagesandcomparisonoftheirdigests.

'REFERENCES:

'ForafullerdescriptionseeFIPSPublication180-1:

'http:

//www.itl.nist.gov/fipspubs/fip180-1.htm

'SAMPLE:

'Message:

"abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"

'ReturnsDigest:

"84983E441C3BD26EBAAE4AA1F95129E5E54670F1"

'Message:

"abc"

'ReturnsDigest:

"A9993E364706816ABA3E25717850C26C9CD0D89D"

PrivateTypeWord

B0AsByte

B1AsByte

B2AsByte

B3AsByte

EndType

'PublicFunctionidcode（crAsRange）AsString

'DimtxAsString

'DimobAsObject

'ForEachobIncr

'tx=tx&LCase（CStr（ob.Value2））

'Next

'idcode=sha1（tx）

'EndFunction

PrivateFunctionAndW（w1AsWord,w2AsWord）AsWord

AndW.B0=w1.B0Andw2.B0

AndW.B1=w1.B1Andw2.B1

AndW.B2=w1.B2Andw2.B2

AndW.B3=w1.B3Andw2.B3

EndFunction

PrivateFunctionOrW（w1AsWord,w2AsWord）AsWord

OrW.B0=w1.B0Orw2.B0

OrW.B1=w1.B1Orw2.B1

OrW.B2=w1.B2Orw2.B2

OrW.B3=w1.B3Orw2.B3

EndFunction

PrivateFunctionXorW（w1AsWord,w2AsWord）AsWord

XorW.B0=w1.B0Xorw2.B0

XorW.B1=w1.B1Xorw2.B1

XorW.B2=w1.B2Xorw2.B2

XorW.B3=w1.B3Xorw2.B3

EndFunction

PrivateFunctionNotW（wAsWord）AsWord

NotW.B0=Notw.B0

NotW.B1=Notw.B1

NotW.B2=Notw.B2

NotW.B3=Notw.B3

EndFunction

PrivateFunctionAddW（w1AsWord,w2AsWord）AsWord

DimiAsLong,wAsWord

i=CLng（w1.B3）+w2.B3

w.B3=iMod256

i=CLng（w1.B2）+w2.B2+（i\256）

w.B2=iMod256

i=CLng（w1.B1）+w2.B1+（i\256）

w.B1=iMod256

i=CLng（w1.B0）+w2.B0+（i\256）

w.B0=iMod256

AddW=w

EndFunction

PrivateFunctionCircShiftLeftW（wAsWord,nAsLong）AsWord

Dimd1AsDouble,d2AsDouble

d1=WordToDouble（w）

d2=d1

d1=d1*（2^n）

d2=d2/（2^（32-n））

CircShiftLeftW=OrW（DoubleToWord（d1）,DoubleToWord（d2））

EndFunction

PrivateFunctionWordToHex（wAsWord）AsString

WordToHex=Right$（"0"&Hex$（w.B0）,2）&Right$（"0"&Hex$（w.B1）,2）_

&Right$（"0"&Hex$（w.B2）,2）&Right$（"0"&Hex$（w.B3）,2）

EndFunction

PrivateFunctionHexToWord（HAsString）AsWord

HexToWord=DoubleToWord（Val（"&H"&H&"#"））

EndFunction

PrivateFunctionDoubleToWord（nAsDouble）AsWord

DoubleToWord.B0=Int（DMod（n,2^32）/（2^24））

DoubleToWord.B1=Int（DMod（n,2^24）/（2^16））

DoubleToWord.B2=Int（DMod（n,2^16）/（2^8））

DoubleToWord.B3=Int（DMod（n,2^8））

EndFunction

PrivateFunctionWordToDouble（wAsWord）AsDouble

WordToDouble=（w.B0*（2^24））+（w.B1*（2^16））+（w.B2*（2^8））_

+w.B3

EndFunction

PrivateFunctionDMod（valueAsDouble,divisorAsDouble）AsDouble

DMod=value-（Int（value/divisor）*divisor）

IfDMod<0ThenDMod=DMod+divisor

EndFunction

PrivateFunctionF（tAsLong,BAsWord,CAsWord,DAsWord）AsWord

SelectCaset

CaseIs<=19

F=OrW（AndW（B,C）,AndW（NotW（B）,D））

CaseIs<=39

F=XorW（XorW（B,C）,D）

CaseIs<=59

F=OrW（OrW（AndW（B,C）,AndW（B,D））,AndW（C,D））

CaseElse

F=XorW（XorW（B,C）,D）

EndSelect

EndFunction

PublicFunctionStringSHA1（inMessageAsString）AsString

'计算字符串的SHA1摘要

DiminLenAsLong

DiminLenWAsWord

DimpadMessageAsString

DimnumBlocksAsLong

Dimw（0To79）AsWord

DimblockTextAsString

DimwordTextAsString

DimiAsLong,tAsLong

DimtempAsWord

DimK（0To3）AsWord

DimH0AsWord

DimH1AsWord

DimH2AsWord

DimH3AsWord

DimH4AsWord

DimAAsWord

DimBAsWord

DimCAsWord

DimDAsWord

DimEAsWord

inMessage=StrConv（inMessage,vbFromUnicode）

inLen=LenB（inMessage）

inLenW=DoubleToWord（CDbl（inLen）*8）

padMessage=inMessage&ChrB（128）_

&StrConv（String（（128-（inLenMod64）-9）Mod64+4,Chr（0））,128）_

&ChrB（inLenW.B0）&ChrB（inLenW.B1）&ChrB（inLenW.B2）&ChrB（inLenW.B3）

numBlocks=LenB（padMessage）/64

'initializeconstants

K（0）=HexToWord（"5A827999"）

K

（1）=HexToWord（"6ED9EBA1"）

K

（2）=HexToWord（"8F1BBCDC"）

K（3）=HexToWord（"CA62C1D6"）

'initialize160-bit（5words）buffer

H0=HexToWord（"67452301"）

H1=HexToWord（"EFCDAB89"）

H2=HexToWord（"98BADCFE"）

H3=HexToWord（"10325476"）

H4=HexToWord（"C3D2E1F0"）

'each512bytemessageblockconsistsof16words（W）butWisexpanded

Fori=0TonumBlocks-1

blockText=MidB$（padMessage,（i*64）+1,64）

'initializeamessageblock

Fort=0To15

wordText=MidB$（blockText,（t*4）+1,4）

w（t）.B0=AscB（MidB$（wordText,1,1））

w（t）.B1=AscB（MidB$（wordText,2,1））

w（t）.B2=AscB（MidB$（wordText,3,1））

w（t）.B3=AscB（MidB$（wordText,4,1））

Next

'createextrawordsfromthemessageblock

Fort=16To79

'W（t）=S^1（W（t-3）XORW（t-8）XORW（t-14）XORW（t-16））

w（t）=CircShiftLeftW（XorW（XorW（XorW（w（t-3）,w（t-8））,_

w（t-14））,w（t-16））,1）

Next

'makeinitialassignmentstothebuffer

A=H0

B=H1

C=H2

D=H3

E=H4

'processtheblock

Fort=0To79

temp=AddW（AddW（AddW（AddW（CircShiftLeftW（A,5）,_

F（t,B,C,D））,E）,w（t））,K（t\20））

E=D

D=C

C=CircShiftLeftW（B,30）

B=A

A=temp

Next

H0=AddW（H0,A）

H1=AddW（H1,B）

H2=AddW（H2,C）

H3=AddW（H3,D）

H4=AddW（H4,E）

Next

StringSHA1=WordToHex（H0）&WordToHex（H1）&WordToHex（H2）_

&WordToHex（H3）&WordToHex（H4）

EndFunction

PublicFunctionSha1（inMessage（）AsByte）AsString

'计算字节数组的SHA1摘要

DiminLenAsLong

DiminLenWAsWord

DimnumBlocksAsLong

Dimw（0To79）AsWord

DimblockTextAsString

DimwordTextAsString

DimtAsLong

DimtempAsWord

DimK（0To3）AsWord

DimH0AsWord

DimH1AsWord

DimH2AsWord

DimH3AsWord

DimH4AsWord

DimAAsWord

DimBAsWord

DimCAsWord

DimDAsWord

DimEAsWord

DimiAsLong

DimlngPosAsLong

DimlngPadMessageLenAsLong

DimpadMessage（）AsByte

inLen=UBound（inMessage）+1

inLenW=DoubleToWord（CDbl（inLen）*8）

lngPadMessageLen=inLen+1+（128-（inLenMod64）-9）Mod64+8

ReDimpadMessage（lngPadMessageLen-1）AsByte

Fori=0ToinLen-1

padMessage（i）=inMessage（i）

Nexti

padMessage（inLen）=128

padMessage（lngPadMessageLen-4）=inLenW.B0

padMessage（lngPadMessageLen-3）=inLenW.B1

padMessage（lngPadMessageLen-2）=inLenW.B2

padMessage（lngPadMessageLen-1）=inLenW.B3

numBlocks=lngPadMessageLen/64

'initializeconstants

K（0）=HexToWord（"5A827999"）

K

（1）=HexToWord（"6ED9EBA1"）

K

（2）=HexToWord（"8F1BBCDC"）

K（3）=HexToWord（"CA62C1D6"）

'initialize160-bit（5words）buffer

H0=HexToWord（"67452301"）

H1=HexToWord（"EFCDAB89"）

H2=HexToWord（"98BADCFE"）

H3=HexToWord（"10325476"）

H4=HexToWord（"C3D2E1F0"）

'each512bytemessageblockconsistsof16words（W）butWisexpanded

'to80words

Fori=0TonumBlocks-1

'initializeamessageblock

Fort=0To15

w（t）.B0=padMessage（lngPos）

w（t）.B1=padMessage（lngPos+1）

w（t）.B2=padMessage（lngPos+2）

w（t）.B3=padMessage（lngPos+3）

lngPos=lngPos+4

Next

'createextrawordsfromthemessageblock

Fort=16To79

'W（t）=S^1（W（t-3）XORW（t-8）XORW（t-14）XORW（t-16））

w（t）=CircShiftLeftW（XorW（XorW（XorW（w（t-3）,w（t-8））,_

w（t-14））,w（t-16））,1）

Next

'makeinitialassignmentstothebuffer

A=H0

B=H1

C=H2

D=H3

E=H4

'processtheblock

Fort=0To79

temp=AddW（AddW（AddW（AddW（CircShiftLeftW（A,5）,_

F（t,B,C,D））,E）,w（t））,K（t\20））

E=D

D=C

C=CircShiftLeftW（B,30）

B=A

A=temp

Next

H0=AddW（H0,A）

H1=AddW（H1,B）

H2=AddW（H2,C）

H3=AddW（H3,D）

H4=AddW（H4,E）

Next

Sha1=WordToHex（H0）&WordToHex（H1）&WordToHex（H2）_

&WordToHex（H3）&WordToHex（H4）

EndFunction

PublicFunctionFileSHA1（strFilenameAsString）AsString

'计算文件的SHA1摘要

DimlngFileNoAsLong

DimbytData（）AsByte

IfDir（strFilename）=""Then

GoToPROC_EXIT

EndIf

lngFileNo=FreeFile

OnErrorGoToPROC_ERR

'打开文件

OpenstrFilenameForBinaryAslngFileNo

'读取文件内容

ReDimbytData（LOF（lngFileNo）-1）AsByte

Get#lngFileNo,1,bytData

'关闭文件

CloselngFileNo

'计算文件的SHA1摘要

FileSHA1=Sha1（bytData）

PROC_EXIT:

ErasebytData

ExitFunction

PROC_ERR:

Close

GoToPROC_EXIT

EndFunction