专用链接加解密

【关键编码如下所示】

'(注:自己用的并不是这个方式,我讨厌For循环系统.)

OptionExplicit

PrivateConstcstBase64="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789 /"

PrivatearrBase64()AsString

'作者:同济黄正

'001000010010000100100001--源代码

'00001000000100100000010000100001--Base64码

PublicFunctionBase64Encode(strSourceAsString)AsString

OnErrorResumeNext

'适用于中、英语的Base64编号/编解码VB6超精简版作者:同济黄正

IfUBound(arrBase64)=-1Then

arrBase64=Split(StrConv(cstBase64,vbUnicode),vbNullChar)

EndIf

DimarrB()AsByte,bTmp(2)AsByte,bTAsByte

DimIAsLong,JAsLong

arrB=StrConv(strSource,vbFromUnicode)

J=UBound(arrB)

ForI=0ToJStep3

ErasebTmp

bTmp(0)=arrB(I 0)

bTmp(1)=arrB(I 1)

bTmp(2)=arrB(I 2)

bT=(bTmp(0)And252)/4

Base64Encode=Base64EncodearrBase64(bT)

bT=(bTmp(0)And3)*16

bT=bT bTmp(1)\16

Base64Encode=Base64EncodearrBase64(bT)

bT=(bTmp(1)And15)*4

bT=bT bTmp(2)\64

IfI 1=JThen

Base64Encode=Base64EncodearrBase64(bT)

Else

Base64Encode=Base64Encode"="

EndIf

bT=bTmp(2)And63

IfI 2=JThen

Base64Encode=Base64EncodearrBase64(bT)

Else

Base64Encode=Base64Encode"="

EndIf

Next

EndFunction

PublicFunctionBase64Decode(strEncodedAsString)AsString

'适用于中、英语的Base64编号/编解码VB6超精简版作者:同济黄正

OnErrorResumeNext

DimarrB()AsByte,bTmp(3)AsByte,bT,bRet()AsByte

DimIAsLong,JAsLong

arrB=StrConv(strEncoded,vbFromUnicode)

J=InStr(strEncoded"=","=")-2

ReDimbRet(J-J\4-1)

ForI=0ToJStep4

ErasebTmp

bTmp(0)=(InStr(cstBase64,Chr(arrB(I)))-1)And63

bTmp(1)=(InStr(cstBase64,Chr(arrB(I 1)))-1)And63

bTmp(2)=(InStr(cstBase64,Chr(arrB(I 2)))-1)And63

bTmp(3)=(InStr(cstBase64,Chr(arrB(I 3)))-1)And63

bT=bTmp(0)*2^18 bTmp(1)*2^12 bTmp(2)*2^6 bTmp(3)

bRet((I\4)*3)=bT\65536

bRet((I\4)*3 1)=(bTAnd65280)\256

bRet((I\4)*3 2)=bTAnd255

Next

Base64Decode=StrConv(bRet,vbUnicode)

EndFunction