Isto é o que reescrevi depois de ler várias funções de codificação e decodificação base64.
Como o VBscript do sistema operacional chinês usa o conjunto de caracteres Unicode, muitas funções de codificação e decodificação base64 estão corretas em teoria, mas não podem ser executadas na prática!
Nome do arquivo base64test.asp
<%
sBASE_64_CHARACTERS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
sBASE_64_CHARACTERS = strUnicode2Ansi(sBASE_64_CHARACTERS)
Função strUnicodeLen(asContents)
'Calcula o comprimento da codificação Ansi da string unicode
asContents1="a"&asContents
len1=len(asConteúdo1)
k=0
para i=1 para len1
asc1=asc(meio(asConteúdo1,i,1))
se asc1<0 então asc1=65536+asc1
se asc1>255 então
k=k+2
outro
k=k+1
terminar se
próximo
strUnicodeLen=k-1
Função Final
Função strUnicode2Ansi(asContents)
'Converter string codificada em Unicode em string codificada em Ansi
strUnicode2Ansi=""
len1=len(asConteúdo)
para i=1 para len1
varchar=mid(asContents,i,1)
varasc=asc(varchar)
se varasc<0 então varasc=varasc+65536
se varasc>255 então
varHex=Hex(varasc)
varlow=esquerda(varHex,2)
varhigh=direita(varHex,2)
strUnicode2Ansi=strUnicode2Ansi & chrb("&H" & varlow ) & chrb("&H" & varhigh )
outro
strUnicode2Ansi=strUnicode2Ansi & chrb(varasc)
terminar se
próximo
Função final
Função strAnsi2Unicode(asContents)
'Converter string codificada em Ansi em string codificada em Unicode
strAnsi2Unicode = ""
len1=lenb(asConteúdo)
se len1 = 0 então saia da função
para i=1 para len1
varchar=midb(asContents,i,1)
varasc=ascb(varchar)
se varasc > 127 então
strAnsi2Unicode = strAnsi2Unicode & chr(ascw(midb(asContents,i+1,1) & varchar))
eu=eu+1
outro
strAnsi2Unicode = strAnsi2Unicode & chr(varasc)
terminar se
próximo
Função final
Função Base64encode(asContents)
'Base64 codifica a string codificada em Ansi
'asContents deve ser uma string codificada em ANSI (strings binárias também são aceitáveis)
Escurecer na posição
Dim lsResult
Escurecer Car1
Dim Char2
Dim Char3
Dim Char4
Diminuir Byte1
Diminuir Byte2
Diminuir Byte3
Dim SaveBits1
Dim SaveBits2
Dim lsGroupBinary
Dim lsGroup64
Dim m4,len1,len2
len1=Lenb(asContents)
se len1<1 então
Código Base64=""
função de saída
fim se
m3=Len1 Mod 3
Se M3 > 0 Então asContents = asContents & String(3-M3, chrb(0))
'O número de dígitos suplementares é para facilitar o cálculo
SE m3 > 0 ENTÃO
len1=len1+(3-m3)
len2=len1-3
outro
len2=len1
end if
lsResult = ""
For lnPosition = 1 To len2 Etapa 3
lsGroup64 = ""
lsGroupBinary = Midb(asContents, lnPosition, 3)
Byte1 = Ascb(Midb(lsGroupBinary, 1, 1)): SaveBits1 = Byte1 e 3
Byte2 = Ascb(Midb(lsGroupBinary, 2, 1)): SaveBits2 = Byte2 e 15
Byte3 = Ascb(Midb(lsGroupBinary, 3, 1))
Char1 = Midb(sBASE_64_CHARACTERS, ((Byte1 e 252) 4) + 1, 1)
Char2 = Midb(sBASE_64_CHARACTERS, (((Byte2 e 240) 16) Ou (SaveBits1 * 16) E &HFF) + 1, 1)
Char3 = Midb(sBASE_64_CHARACTERS, (((Byte3 e 192) 64) Ou (SaveBits2 * 4) E &HFF) + 1, 1)
Char4 = Midb(sBASE_64_CHARACTERS, (Byte3 e 63) + 1, 1)
lsGroup64 = Char1 & Char2 & Char3 & Char4
lsResult = lsResult & lsGroup64
Próximo
'Processar os últimos caracteres restantes
se M3 > 0 então
lsGroup64 = ""
lsGroupBinary = Midb(asContents, len2+1, 3)
Byte1 = Ascb(Midb(lsGroupBinary, 1, 1)): SaveBits1 = Byte1 And 3
Byte2 = Ascb(Midb(lsGroupBinary, 2, 1)): SaveBits2 = Byte2 e 15
Byte3 = Ascb(Midb(lsGroupBinary, 3, 1))
Char1 = Midb(sBASE_64_CHARACTERS, ((Byte1 e 252) 4) + 1, 1)
Char2 = Midb(sBASE_64_CHARACTERS, (((Byte2 e 240) 16) Ou (SaveBits1 * 16) E &HFF) + 1, 1)
Char3 = Midb(sBASE_64_CHARACTERS, (((Byte3 E 192) 64) Ou (SaveBits2 * 4) E &HFF) + 1, 1)
se M3=1 então
lsGroup64 = Char1 & Char2 & ChrB(61) & ChrB(61) 'Use o sinal = para preencher os dígitos
outro
lsGroup64 = Char1 & Char2 & Char3 & ChrB(61) 'Use o sinal = para formar os dígitos
fim se
lsResult = lsResult & lsGroup64
fim se
Base64encode = lsResult
Função final
Função Base64decode(asContents)
'Converter string codificada em Base64 em string codificada em Ansi
'asContents também deve ser uma string codificada em ANSI (strings binárias também são aceitáveis)
Dim lsResult
Escurecer na posição
Dim lsGroup64, lsGroupBinary
Dim Char1, Char2, Char3, Char4
Diminuir Byte1, Byte2, Byte3
Dim M4,len1,len2
len1= Lenb(asContents)
M4 = len1 Mod 4
se len1 < 1 ou M4 > 0 então
'O comprimento da string deve ser um múltiplo de 4
Base64decode = ""
função de saída
end if
'Julgue se o último dígito é o sinal =
'Determina se o penúltimo dígito é o sinal =
'Aqui m4 representa o último número restante de caracteres que precisam ser processados separadamente
se midb(asContents, len1, 1) = chrb(61) então m4=3
se midb(asContents, len1-1, 1) = chrb(61) então m4=2
se m4 = 0 então
len2 = len1
outro
len2=len1-4
end if
For lnPosition = 1 To Len2 Etapa 4
lsGroupBinary = ""
lsGroup64 = Midb(asContents, lnPosition, 4)
Char1 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 1, 1)) - 1
Char2 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 2, 1)) - 1
Char3 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 3, 1)) - 1
Char4 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 4, 1)) - 1
Byte1 = Chrb(((Char2 E 48) 16) Ou (Char1 * 4) E &HFF)
Byte2 = lsGroupBinary & Chrb(((Char3 E 60) 4) Ou (Char2 * 16) E &HFF)
Byte3 = Chrb((((Char3 e 3) * 64) E &HFF) Ou (Char4 e 63))
lsGroupBinary = Byte1 e Byte2 e Byte3
lsResult = lsResult e lsGroupBinary
Próximo
'Processar os últimos caracteres restantes
se M4 > 0 então
lsGroupBinary = ""
lsGroup64 = Midb(asContents, len2+1, m4) & chrB(65) 'chr(65)=A, convertido para o valor 0
se M4=2 então 'Adicione 4 dígitos para facilitar o cálculo
lsGrupo64 = lsGrupo64 & chrB(65)
terminar se
Char1 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 1, 1)) - 1
Char2 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 2, 1)) - 1
Char3 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 3, 1)) - 1
Char4 = InStrb(sBASE_64_CHARACTERS, Midb(lsGroup64, 4, 1)) - 1
Byte1 = Chrb(((Char2 E 48) 16) Ou (Char1 * 4) E &HFF)
Byte2 = lsGroupBinary & Chrb(((Char3 E 60) 4) Ou (Char2 * 16) E &HFF)
Byte3 = Chrb((((Char3 E 3) * 64) E &HFF) Ou (Char4 E 63))
se M4=2 então
lsGrupoBinário = Byte1
senão se M4=3 então
lsGroupBinary = Byte1 e Byte2
fim se
lsResult = lsResult & lsGroupBinary
fim se
Base64decode = lsResult
Função final