<%
|
CONST BASE_64_MAP="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
|
Dim MapEnc(63)
|
Dim MapDec(127)
|
Dim i
|
For i=0 To 63
|
MapEnc(i)=Mid(BASE_64_MAP,i+1,1)
|
Next
|
For i=0 To 63
|
MapDec(Asc(MapEnc(i)))=i
|
Next
|
Set i=Nothing
|
Private Function DecToBin(intDecimal)
|
Dim strBinary,blnFlag
|
strBinary=""
|
blnFlag=True
|
Do While blnFlag
|
strBinary=Cstr(intDecimal AND &H01)&strBinary
|
intDecimal=intDecimal\2
|
If intDecimal=0 Then blnFlag=False
|
Loop
|
Set blnFlag=Nothing
|
strBinary=Right("00000000"&strBinary,8)
|
DecToBin=strBinary
|
Set strBinary=Nothing
|
End Function
|
Private Function BinToDec(strBin)
|
Dim intDec,i,j
|
intDec=0
|
j=Len(strBin)
|
For i=1 To j
|
intDec=intDec+2^(j-i)*CInt(Mid(strBin,i,1))
|
Next
|
Set i=Nothing
|
Set j=Nothing
|
BinToDec=intDec
|
Set intDec=Nothing
|
End Function
|
Private Function Bin24Encode(strBin24)
|
Dim strEncoder,strBin6
|
strEncoder=""
|
If (Len(strBin24)<=8) Then
|
strBin24=Left(strBin24&"00000000",8)
|
strBin6="00"&Mid(strBin24,1,6)
|
strEncoder=MapEnc(BinToDec(strBin6))
|
strBin6="00"&Mid(strBin24,7,2)&"0000"
|
strEncoder=strEncoder&MapEnc(BinToDec(strBin6))
|
strEncoder=strEncoder&"=="
|
Else If (Len(strBin24)<=16) Then
|
strBin24=Left(strBin24&"00000000",16)
|
strBin6="00"&Mid(strBin24,1,6)
|
strEncoder=MapEnc(BinToDec(strBin6))
|
strBin6="00"&Mid(strBin24,7,6)
|
strEncoder=strEncoder&MapEnc(BinToDec(strBin6))
|
strBin6="00"&Mid(strBin24,13,4)&"00"
|
strEncoder=strEncoder&MapEnc(BinToDec(strBin6))
|
strEncoder=strEncoder&"="
|
Else
|
strBin24=Left(strBin24&"00000000",24)
|
strBin6="00"&Mid(strBin24,1,6)
|
strEncoder=MapEnc(BinToDec(strBin6))
|
strBin6="00"&Mid(strBin24,7,6)
|
strEncoder=strEncoder&MapEnc(BinToDec(strBin6))
|
strBin6="00"&Mid(strBin24,13,6)
|
strEncoder=strEncoder&MapEnc(BinToDec(strBin6))
|
strBin6="00"&Mid(strBin24,19,6)
|
strEncoder=strEncoder&MapEnc(BinToDec(strBin6))
|
End If
|
End If
|
Set strBin6=Nothing
|
Bin24Encode=strEncoder
|
Set strEncoder=Nothing
|
End Function
|
Private Function HexToDec(strHex)
|
Dim intDec,i,j
|
j=Len(strHex)
|
intDec=0
|
For i=1 To j
|
Select Case Mid(strHex,i,1)
|
Case "0" intDec=intDex+16^(j-i)*0
|
Case "1" intDec=intDex+16^(j-i)*1
|
Case "2" intDec=intDex+16^(j-i)*2
|
Case "3" intDec=intDex+16^(j-i)*3
|
Case "4" intDec=intDex+16^(j-i)*4
|
Case "5" intDec=intDex+16^(j-i)*5
|
Case "6" intDec=intDex+16^(j-i)*6
|
Case "7" intDec=intDex+16^(j-i)*7
|
Case "8" intDec=intDex+16^(j-i)*8
|
Case "9" intDec=intDex+16^(j-i)*9
|
Case "A" intDec=intDex+16^(j-i)*10
|
Case "B" intDec=intDex+16^(j-i)*11
|
Case "C" intDec=intDex+16^(j-i)*12
|
Case "D" intDec=intDex+16^(j-i)*13
|
Case "E" intDec=intDex+16^(j-i)*14
|
Case "F" intDec=intDex+16^(j-i)*15
|
End Select
|
Next
|
Set i=Nothing
|
HexToDec=intDec
|
Set intDec=Nothing
|
End Function
|
Private Function HexToBin(strHex)
|
Dim strBin,i,j
|
j=Len(strHex)
|
strBin=""
|
For i=1 To j
|
Select Case Mid(strHex,i,1)
|
Case "0" strBin=strBin&"0000"
|
Case "1" strBin=strBin&"0001"
|
Case "2" strBin=strBin&"0010"
|
Case "3" strBin=strBin&"0011"
|
Case "4" strBin=strBin&"0100"
|
Case "5" strBin=strBin&"0101"
|
Case "6" strBin=strBin&"0110"
|
Case "7" strBin=strBin&"0111"
|
Case "8" strBin=strBin&"1000"
|
Case "9" strBin=strBin&"1001"
|
Case "A" strBin=strBin&"1010"
|
Case "B" strBin=strBin&"1011"
|
Case "C" strBin=strBin&"1100"
|
Case "D" strBin=strBin&"1101"
|
Case "E" strBin=strBin&"1110"
|
Case "F" strBin=strBin&"1111"
|
End Select
|
Next
|
Set i=Nothing
|
Set j=Nothing
|
HexToBin=strBin
|
Set strBin=Nothing
|
End Function
|
Private Function BinToHex(strBin)
|
Dim strHex,strBin4
|
strHex=""
|
Do While strBin<>""
|
strBin4=Mid(strBin,1,4)
|
If Len(strBin)>4 Then
|
strBin=Mid(strBin,5,Len(strBin)-4)
|
Else
|
strBin=""
|
End If
|
Select Case strBin4
|
Case "0000" strHex=strHex&"0"
|
Case "0001" strHex=strHex&"1"
|
Case "0010" strHex=strHex&"2"
|
Case "0011" strHex=strHex&"3"
|
Case "0100" strHex=strHex&"4"
|
Case "0101" strHex=strHex&"5"
|
Case "0110" strHex=strHex&"6"
|
Case "0111" strHex=strHex&"7"
|
Case "1000" strHex=strHex&"8"
|
Case "1001" strHex=strHex&"9"
|
Case "1010" strHex=strHex&"A"
|
Case "1011" strHex=strHex&"B"
|
Case "1100" strHex=strHex&"C"
|
Case "1101" strHex=strHex&"D"
|
Case "1110" strHex=strHex&"E"
|
Case "1111" strHex=strHex&"F"
|
End Select
|
Loop
|
Set strBin4=Nothing
|
BinToHex=strHex
|
Set strHex=Nothing
|
End Function
|
PUBLIC Function Encode(strText)
|
Dim strTemp24,strBinarySource,strCode,intAsc,strHex,i,j
|
strTemp24=""
|
strBinarySource=""
|
strCode=""
|
j=Clng(Len(strText))
|
For i=1 To j
|
intAsc=Asc(Mid(strText,i,1))
|
If intAsc>=0 AND intAsc<128 Then
|
strBinarySource=strBinarySource&DecToBin(intAsc)
|
Else
|
strHex=CStr(Hex(intAsc))
|
strHex=Right("0000"&strHex,4)
|
strBinarySource=strBinarySource & HexToBin(strHex)
|
End If
|
Next
|
Do While (strBinarySource<>"")
|
If Clng(Len(strBinarySource))>=24 Then
|
strTemp24=Mid(strBinarySource,1,24)
|
strBinarySource=Mid(strBinarySource,25,Len(strBinarySource)-24)
|
Else
|
strTemp24=Mid(strBinarySource,1,Len(strBinarySource))
|
strBinarySource=""
|
End If
|
strCode=strCode&Bin24Encode(strTemp24)
|
Loop
|
Set i=Nothing
|
Set j=Nothing
|
Set intAsc=Nothing
|
Set strTemp24=Nothing
|
Set strBinarySource=Nothing
|
Set i=Nothing
|
Encode=strCode
|
Set strCode=Nothing
|
End Function
|
PUBLIC Function Decode(strCode)
|
Dim i,j,strText,strBinarySource,strTemp8,intIndex
|
j=Clng(Len(strCode))
|
strText=""
|
strBinarySource=""
|
For i=1 To j
|
intIndex=MapDec(Asc(Mid(strCode,i,1)))
|
If Mid(strCode,i,1)<>"=" Then strBinarySource=strBinarySource&Right(DecToBin(intIndex),6)
|
Next
|
Do While (strBinarySource<>"")
|
If Len(strBinarySource)>8 Then
|
strTemp8=Mid(strBinarySource,1,8)
|
strBinarySource=Mid(strBinarySource,9,Len(strBinarySource)-8)
|
Else
|
If Len(strBinarySource)=8 Then strTemp8=Mid(strBinarySource,1,8)
|
strBinarySource=""
|
End If
|
If Mid(strTemp8,1,1)="0" Then
|
strText=strText&Chr(BinToDec(strTemp8))
|
Else
|
If Len(strBinarySource)>8 Then
|
strTemp8=strTemp8&Mid(strBinarySource,1,8)
|
strBinarySource=Mid(strBinarySource,9,Len(strBinarySource)-8)
|
strText=strText& Chr("&H"& BinToHex(strTemp8))
|
Else
|
If Len(strBinarySource)=8 Then
|
strTemp8=strTemp8&Mid(strBinarySource,1,8)
|
'response.write BinToHex(strTemp8)&"<br>"
|
strText=strText& Chr("&H" & BinToHex(strTemp8))
|
End If
|
strBinarySource=""
|
End If
|
End If
|
Loop
|
Set strBinarySource=Nothing
|
Set intIndex=Nothing
|
Set i=Nothing
|
Set j=Nothing
|
Decode=strText
|
Set strText=Nothing
|
End Function
|
%>
|
