C'est ce que j'ai réécrit après avoir lu plusieurs fonctions d'encodage et de décodage base64.
Parce que dans VBscript du système d'exploitation chinois, le jeu de caractères Unicode est utilisé, donc de nombreuses fonctions d'encodage et de décodage base64 sont correctes en théorie, mais elles ne peuvent pas fonctionner en pratique !
Nom du fichier base64test.asp
<%
sBASE_64_CHARACTERS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
sBASE_64_CHARACTERS = strUnicode2Ansi(sBASE_64_CHARACTERS)
Fonction strUnicodeLen(asContents)
'Calculer la longueur du codage Ansi de la chaîne Unicode
asContents1="a"&asContents
len1=len(asContents1)
k=0
pour i=1 à len1
asc1=asc(milieu(asContents1,i,1))
si asc1<0 alors asc1=65536+asc1
si asc1>255 alors
k=k+2
autre
k=k+1
finir si
suivant
strUnicodeLen=k-1
Fin de la fonction
Fonction strUnicode2Ansi(asContents)
'Convertir une chaîne codée Unicode en chaîne codée Ansi
strUnicode2Ansi=""
len1=len(asContents)
pour i=1 à len1
varchar=milieu(asContents,i,1)
varasc=asc(varchar)
si varasc<0 alors varasc=varasc+65536
si varasc>255 alors
varHex=Hex(varasc)
varlow=gauche(varHex,2)
varhaut=droite(varHex,2)
strUnicode2Ansi=strUnicode2Ansi & chrb("&H" & varlow ) & chrb("&H" & varhigh )
autre
strUnicode2Ansi=strUnicode2Ansi & chrb(varasc)
finir si
suivant
Fonction de fin
Fonction strAnsi2Unicode(asContents)
'Convertir une chaîne codée Ansi en chaîne codée Unicode
strAnsi2Unicode = ""
len1=lenb(asContents)
si len1 = 0 alors quittez la fonction
pour i=1 à len1
varchar=midb(asContents,i,1)
varasc=ascb(varchar)
si varasc > 127 alors
strAnsi2Unicode = strAnsi2Unicode & chr(ascw(midb(asContents,i+1,1) & varchar))
je=je+1
autre
strAnsi2Unicode = strAnsi2Unicode & chr(varasc)
finir si
suivant
Fonction de fin
Fonction Base64encode(asContents)
'Base64 encode la chaîne codée en Ansi
'asContents doit être une chaîne codée ANSI (les chaînes binaires sont également acceptables)
Faible lnPosition
Dim lsRésultat
Faible Char1
Faible Char2
Faible Char3
Faible Char4
Dim Octet1
Dim Octet2
Faible Octet3
Dim EnregistrerBits1
Faible SaveBits2
Dim lsGroupBinaire
Faible lsGroup64
Dim m4,len1,len2
len1=Lenb(asContents)
si len1<1 alors
Code Base64=""
Fonction de sortie
terminer si
m3=Len1 Mod 3
Si M3 > 0 Alors asContents = asContents & String(3-M3, chrb(0))
'Le nombre de chiffres supplémentaires est destiné à faciliter le calcul
SI m3 > 0 ALORS
len1=len1+(3-m3)
len2=len1-3
autre
len2=len1
end if
lsResult = ""
Pour lnPosition = 1 Pour len2 Étape 3
lsGroup64 = ""
lsGroupBinary = Midb(asContents, lnPosition, 3)
Byte1 = Ascb(Midb(lsGroupBinary, 1, 1)) : SaveBits1 = Byte1 et 3
Octet2 = Ascb (Midb (lsGroupBinary, 2, 1)) : SaveBits2 = Octet2 et 15
Octet3 = Ascb(Midb(lsGroupBinary, 3, 1))
Char1 = Midb(sBASE_64_CHARACTERS, ((Byte1 et 252) 4) + 1, 1)
Char2 = Midb(sBASE_64_CHARACTERS, (((Byte2 et 240) 16) ou (SaveBits1 * 16) et &HFF) + 1, 1)
Char3 = Midb(sBASE_64_CHARACTERS, (((Byte3 et 192) 64) ou (SaveBits2 * 4) et &HFF) + 1, 1)
Char4 = Midb(sBASE_64_CHARACTERS, (Byte3 et 63) + 1, 1)
lsGroup64 = Char1 & Char2 & Char3 & Char4
lsResult = lsResult & lsGroup64
Suivant
'Traitement des derniers caractères restants
si M3 > 0 alors
lsGroup64 = ""
lsGroupBinary = Midb(asContents, len2+1, 3)
Octet1 = Ascb(Midb(lsGroupBinary, 1, 1)) : SaveBits1 = Octet1 et 3
Octet2 = Ascb (Midb (lsGroupBinary, 2, 1)) : SaveBits2 = Octet2 et 15
Octet3 = Ascb(Midb(lsGroupBinary, 3, 1))
Char1 = Midb(sBASE_64_CHARACTERS, ((Byte1 et 252) 4) + 1, 1)
Char2 = Midb(sBASE_64_CHARACTERS, (((Byte2 et 240) 16) ou (SaveBits1 * 16) et &HFF) + 1, 1)
Char3 = Midb(sBASE_64_CHARACTERS, (((Byte3 et 192) 64) Ou (SaveBits2 * 4) Et &HFF) + 1, 1)
si M3=1 alors
lsGroup64 = Char1 & Char2 & ChrB(61) & ChrB(61) 'Utilisez le signe = pour remplir les chiffres
autre
lsGroup64 = Char1 & Char2 & Char3 & ChrB(61) 'Utilisez le signe = pour composer les chiffres
terminer si
lsResult = lsResult & lsGroup64
terminer si
Base64encode = lsResult
End Function
Fonction Base64decode (asContents)
'Convertir la chaîne codée en Base64 en chaîne codée Ansi
'asContents doit également être une chaîne codée ANSI (les chaînes binaires sont également acceptables)
Dim lsRésultat
Faible lnPosition
Dim lsGroup64, lsGroupBinary
Faible Char1, Char2, Char3, Char4
Dim Octet1, Octet2, Octet3
Dim M4,len1,len2
len1= Lenb(asContents)
M4 = len1 Mod 4
si len1 < 1 ou M4 > 0 alors
'La longueur de la chaîne doit être un multiple de 4
Décode Base64 = ""
Fonction de sortie
end if
'Jugez si le dernier chiffre est = signe
'Déterminez si l'avant-dernier chiffre est le signe =
'Ici, m4 représente le dernier nombre restant de caractères qui doivent être traités séparément
si midb(asContents, len1, 1) = chrb(61) alors m4=3
si midb(asContents, len1-1, 1) = chrb(61) alors m4=2
si m4 = 0 alors
len2=len1
autre
len2=len1-4
terminer si
For lnPosition = 1 To Len2 Étape 4
lsGroupBinaire = ""
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
Octet1 = Chrb(((Char2 et 48) 16) Ou (Char1 * 4) et &HFF)
Octet2 = lsGroupBinary & Chrb(((Char3 et 60) 4) Ou (Char2 * 16) et &HFF)
Octet3 = Chrb((((Char3 et 3) * 64) et &HFF) ou (Char4 et 63))
lsGroupBinary = Octet1 & Octet2 & Octet3
lsResult = lsResult & lsGroupBinary
Suivant
'Traitement des derniers caractères restants
si M4 > 0 alors
lsGroupBinaire = ""
lsGroup64 = Midb(asContents, len2+1, m4) & chrB(65) 'chr(65)=A, converti en valeur 0
si M4=2 alors 'Ajoutez 4 chiffres pour faciliter le calcul
lsGroup64 = lsGroup64 & chrB(65)
finir si
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
Octet1 = Chrb(((Char2 et 48) 16) Ou (Char1 * 4) et &HFF)
Octet2 = lsGroupBinary & Chrb(((Char3 et 60) 4) Ou (Char2 * 16) et &HFF)
Octet3 = Chrb((((Char3 et 3) * 64) Et &HFF) Ou (Char4 et 63))
si M4=2 alors
lsGroupBinary = Octet1
sinon si M4=3 alors
lsGroupBinary = Octet1 et Octet2
terminer si
lsResult = lsResult & lsGroupBinary
terminer si
Base64decode = lsResult
End Function