VB源代码字符串有关.docx
《VB源代码字符串有关.docx》由会员分享，可在线阅读，更多相关《VB源代码字符串有关.docx（30页珍藏版）》请在冰点文库上搜索。
VB源代码字符串有关
判断文本框中的汉字
DimSum&
Sum=0
Forc=1ToLen（Text1.Text）
Char=Mid（Text1.Text,c,1）
If（AscW（Char）>-40870AndAscW（Char）<-19967）Or（AscW（Char）<40870AndAscW（Char）>19967）Then
Sum=Sum+1
EndIf
Nextc
MsgBox"汉字总数为"&Sum,vbOKOnly,"提示"
================================================================================
将字符转化为ASCII码
16进制：
Hex（Asc（"字符串"））
10进制：
Asc（"字符串"）
====================================================================================
判断某个字符是否存在
InStr（Text1.Text,"字符串"）
=====================================================================================
Base模板
'加密，用法Base64Encode（‘加密字符'）
OptionExplicit
PublicFunctionBase64Encode（InStr1AsString）AsString
DimmInByte（3）AsByte,mOutByte（4）AsByte
DimmyByteAsByte
DimIAsInteger,LenArrayAsInteger,jAsInteger
DimmyBArray（）AsByte
DimOutStr1AsString
myBArray（）=StrConv（InStr1,vbFromUnicode）
LenArray=UBound（myBArray）+1
ForI=0ToLenArrayStep3
IfLenArray-I=0Then
ExitFor
EndIf
IfLenArray-I=2Then
mInByte（0）=myBArray（I）
mInByte
（1）=myBArray（I+1）
Base64EncodeBytemInByte,mOutByte,2
ElseIfLenArray-I=1Then
mInByte（0）=myBArray（I）
Base64EncodeBytemInByte,mOutByte,1
Else
mInByte（0）=myBArray（I）
mInByte
（1）=myBArray（I+1）
mInByte
（2）=myBArray（I+2）
Base64EncodeBytemInByte,mOutByte,3
EndIf
Forj=0To3
OutStr1=OutStr1&Chr（mOutByte（j））
Nextj
NextI
Base64Encode=OutStr1
EndFunction
PrivateSubBase64EncodeByte（mInByte（）AsByte,mOutByte（）AsByte,NumAsInteger）
DimtByteAsByte
DimIAsInteger
IfNum=1Then
mInByte
（1）=0
mInByte
（2）=0
ElseIfNum=2Then
mInByte
（2）=0
EndIf
tByte=mInByte（0）And&HFC
mOutByte（0）=tByte/4
tByte=（（mInByte（0）And&H3）*16）+（mInByte
（1）And&HF0）/16
mOutByte
（1）=tByte
tByte=（（mInByte
（1）And&HF）*4）+（（mInByte
（2）And&HC0）/64）
mOutByte
（2）=tByte
tByte=（mInByte
（2）And&H3F）
mOutByte（3）=tByte
ForI=0To3
IfmOutByte（I）>=0AndmOutByte（I）<=25Then
mOutByte（I）=mOutByte（I）+Asc（"A"）
ElseIfmOutByte（I）>=26AndmOutByte（I）<=51Then
mOutByte（I）=mOutByte（I）-26+Asc（"a"）
ElseIfmOutByte（I）>=52AndmOutByte（I）<=61Then
mOutByte（I）=mOutByte（I）-52+Asc（"0"）
ElseIfmOutByte（I）=62Then
mOutByte（I）=Asc（"+"）
Else
mOutByte（I）=Asc（"/"）
EndIf
NextI
IfNum=1Then
mOutByte
（2）=Asc（"="）
mOutByte（3）=Asc（"="）
ElseIfNum=2Then
mOutByte（3）=Asc（"="）
EndIf
EndSub
PublicFunctionBase64Decode（InStr1AsString）AsString
DimmInByte（4）AsByte,mOutByte（3）AsByte
DimIAsInteger,LenArrayAsInteger,jAsInteger
DimmyBArray（）AsByte
DimOutStr1AsString
DimtmpArray（）AsByte
myBArray（）=StrConv（InStr1,vbFromUnicode）
LenArray=UBound（myBArray）
ReDimtmpArray（（（LenArray+1）/4）*3）
j=0
ForI=0ToLenArrayStep4
IfLenArray-I=0Then
ExitFor
Else
mInByte（0）=myBArray（I）
mInByte
（1）=myBArray（I+1）
mInByte
（2）=myBArray（I+2）
mInByte（3）=myBArray（I+3）
Base64DecodeBytemInByte,mOutByte,4
EndIf
tmpArray（j*3）=mOutByte（0）
tmpArray（j*3+1）=mOutByte
（1）
tmpArray（j*3+2）=mOutByte
（2）
j=j+1
NextI
Base64Decode=BinaryToString（tmpArray）
EndFunction
PrivateSubBase64DecodeByte（mInByte（）AsByte,mOutByte（）AsByte,ByteNumAsInteger）
DimtByteAsByte
DimIAsInteger
ByteNum=0
ForI=0To3
IfmInByte（I）>=Asc（"A"）AndmInByte（I）<=Asc（"Z"）Then
mInByte（I）=mInByte（I）-Asc（"A"）
ElseIfmInByte（I）>=Asc（"a"）AndmInByte（I）<=Asc（"z"）Then
mInByte（I）=mInByte（I）-Asc（"a"）+26
ElseIfmInByte（I）>=Asc（"0"）AndmInByte（I）<=Asc（"9"）Then
mInByte（I）=mInByte（I）-Asc（"0"）+52
ElseIfmInByte（I）=Asc（"+"）Then
mInByte（I）=62
ElseIfmInByte（I）=Asc（"/"）Then
mInByte（I）=63
Else'"="
ByteNum=ByteNum+1
mInByte（I）=0
EndIf
NextI
tByte=（mInByte（0）And&H3F）*4+（mInByte
（1）And&H30）/16
mOutByte（0）=tByte
tByte=（mInByte
（1）And&HF）*16+（mInByte
（2）And&H3C）/4
mOutByte
（1）=tByte
tByte=（mInByte
（2）And&H3）*64+（mInByte（3）And&H3F）
mOutByte
（2）=tByte
EndSub
PrivateFunctionBinaryToString（ByValBinaryStrAsVariant）AsString
DimlnglenAsLong
DimtmpBinAsVariant
DimstrCAsString
DimskipflagAsLong
DimIAsLong
skipflag=0
strC=""
IfNotIsNull（BinaryStr）Then
lnglen=LenB（BinaryStr）
ForI=1Tolnglen
Ifskipflag=0Then
tmpBin=MidB（BinaryStr,I,1）
IfAscB（tmpBin）>127Then
strC=strC&Chr（AscW（MidB（BinaryStr,I+1,1）&tmpBin））
skipflag=1
Else
strC=strC&Chr（AscB（tmpBin））
EndIf
Else
skipflag=0
EndIf
Next
EndIf
BinaryToString=strC
EndFunction
PrivateFunctionStringToBinary（ByValVarStringAsString）AsVariant
DimstrBinAsVariant
DimvarcharAsVariant
DimvarascAsLong
Dimvarlow,varhigh
DimIAsLong
strBin=""
ForI=1ToLen（VarString）
varchar=Mid（VarString,I,1）
varasc=Asc（varchar）
Ifvarasc<0Then
varasc=varasc+65535
EndIf
Ifvarasc>255Then
varlow=Left（Hex（Asc（varchar））,2）
varhigh=Right（Hex（Asc（varchar））,2）
strBin=strBin&ChrB（"&H"&varlow）&ChrB（"&H"&varhigh）
Else
strBin=strBin&ChrB（AscB（varchar））
EndIf
Next
StringToBinary=strBin
EndFunction
'解密，用法：
DecodeBase64String（"解密字符"）
OptionExplicit
PrivateConstBASE64CHRAsString="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="
PrivatepsBase64Chr（0To63）AsString
PublicFunctionDecodeBase64String（str2DecodeAsString）AsString
DecodeBase64String=StrConv（DecodeBase64Byte（str2Decode）,vbUnicode）
EndFunction
PublicFunctionDecodeBase64Byte（str2DecodeAsString）AsByte（）
DimlPtrAsLong
DimiValueAsInteger
DimiLenAsInteger
DimiCtrAsInteger
DimBits（1To4）AsByte
DimstrDecodeAsString
DimstrAsString
DimOutput（）AsByte
DimiIndexAsLong
DimlFromAsLong
DimlToAsLong
InitBase
str=Replace（str2Decode,vbCrLf,""）
ForlPtr=1ToLen（str）Step4
iLen=4
ForiCtr=0To3
iValue=InStr（1,BASE64CHR,Mid$（str,lPtr+iCtr,1）,vbBinaryCompare）
SelectCaseiValue
Case1To64:
Bits（iCtr+1）=iValue-1
Case65'=
iLen=iCtr
ExitFor
Case0:
ExitFunction
EndSelect
Next
Bits
（1）=Bits
（1）*&H4+（Bits
（2）And&H30）\&H10
Bits
（2）=（Bits
（2）And&HF）*&H10+（Bits（3）And&H3C）\&H4
Bits（3）=（Bits（3）And&H3）*&H40+Bits（4）
lFrom=lTo
lTo=lTo+（iLen-1）-1
ReDimPreserveOutput（0TolTo）
ForiIndex=lFromTolTo
Output（iIndex）=Bits（iIndex-lFrom+1）
Next
lTo=lTo+1
Next
DecodeBase64Byte=Output
EndFunction
'将一个字节数组进行Base64编码，并返回字符串
PublicFunctionEncodeBase64Byte（sValue（）AsByte）AsString
DimlCtrAsLong
DimlPtrAsLong
DimlLenAsLong
DimsEncodedAsString
DimBits8（1To3）AsByte
DimBits6（1To4）AsByte
DimIAsInteger
InitBase
ForlCtr=1ToUBound（sValue）+1Step3
ForI=1To3
IflCtr+I-2<=UBound（sValue）Then
Bits8（I）=sValue（lCtr+I-2）
lLen=3
Else
Bits8（I）=0
lLen=lLen-1
EndIf
Next
Bits6
（1）=（Bits8
（1）And&HFC）\4
Bits6
（2）=（Bits8
（1）And&H3）*&H10+（Bits8
（2）And&HF0）\&H10
Bits6（3）=（Bits8
（2）And&HF）*4+（Bits8（3）And&HC0）\&H40
Bits6（4）=Bits8（3）And&H3F
ForlPtr=1TolLen+1
sEncoded=sEncoded&psBase64Chr（Bits6（lPtr））
Next
Next
SelectCaselLen+1
Case2:
sEncoded=sEncoded&"=="
Case3:
sEncoded=sEncoded&"="
Case4:
EndSelect
EncodeBase64Byte=sEncoded
EndFunction
PublicFunctionEncodeBase64String（str2EncodeAsString）AsString
DimsValue（）AsByte
sValue=StrConv（str2Encode,vbFromUnicode）
EncodeBase64String=EncodeBase64Byte（sValue）
EndFunction
PrivateSubInitBase（）
DimiPtrAsInteger
ForiPtr=0To63
psBase64Chr（iPtr）=Mid$（BASE64CHR,iPtr+1,1）
Next
EndSub
================================================================================
MD5加密模板
'用法：
MD5（"加密字符"）
PrivateConstBITS_TO_A_BYTE=8
PrivateConstBYTES_TO_A_WORD=4
PrivateConstBITS_TO_A_WORD=32
Privatem_lOnBits（30）
Privatem_l2Power（30）
PrivateFunctionLShift（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（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（&H40000000\m_l2Power（iShiftBits-1）））
EndIf
EndFunction
PrivateFunctionRotateLeft（lValue,iShiftBits）
RotateLeft=LShift（lValue,iShiftBits）OrRShift（lValue,（32-iShiftBits））
EndFunction
PrivateFunctionAddUnsigned（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
PrivateFunctionmd5_F（x,y,z）
md5_F=（xAndy）Or（（Notx）Andz）
EndFunction
PrivateFunctionmd5_G（x,y,z）
md5_G=（xAndz）Or（yAnd（Notz））
EndFunction
Private
升级会员 