Bonjour tout le monde,
Dans mes titres de mails, je trouve des choses du style
Forum sur le site Internet =?iso-8859-1?Q?à?= propos de
A la place de =?iso-8859-1?Q?à?= je verrais bien plutôt un a accent
grave.
Est-ce qu'il faut que je m'amuse à une recherche de =?iso-8859-1?Q? et
remplacer par le caractère dont le code ASCII suit en hexadécimal, ou
bien la fonction utilisée par pratiquement tous les clients de mail
pour
ce faire est disponible quelque part, par exemple dans les API ?
Bonjour tout le monde,
Dans mes titres de mails, je trouve des choses du style
Forum sur le site Internet =?iso-8859-1?Q?à?= propos de
A la place de =?iso-8859-1?Q?à?= je verrais bien plutôt un a accent
grave.
Est-ce qu'il faut que je m'amuse à une recherche de =?iso-8859-1?Q? et
remplacer par le caractère dont le code ASCII suit en hexadécimal, ou
bien la fonction utilisée par pratiquement tous les clients de mail
pour
ce faire est disponible quelque part, par exemple dans les API ?
Bonjour tout le monde,
Dans mes titres de mails, je trouve des choses du style
Forum sur le site Internet =?iso-8859-1?Q?à?= propos de
A la place de =?iso-8859-1?Q?à?= je verrais bien plutôt un a accent
grave.
Est-ce qu'il faut que je m'amuse à une recherche de =?iso-8859-1?Q? et
remplacer par le caractère dont le code ASCII suit en hexadécimal, ou
bien la fonction utilisée par pratiquement tous les clients de mail
pour
ce faire est disponible quelque part, par exemple dans les API ?
Salut,
J'avais fait ca il y a longtemps pour un client mail, tu peux essayer :
Public Function ConvISO8859(sText As String) As String
If Right$(sText, 1) = "=" Then sText = Left$(sText, Len(sText) - 1)
If Right$(sText, 1) = "?" Then sText = Left$(sText, Len(sText) - 1)
If LCase$(sText) Like "*?q?*" Then
Dim strTemp As String
Dim i As Integer
strTemp = sText
strTemp = Right$(strTemp, Len(strTemp) - InStr(1, strTemp, "?Q?",
vbTextCompare) - 2)
For i = 255 To 32 Step -1
If InStr(1, strTemp, "=" & Hex(i)) <> 0 Then
strTemp = Replace(strTemp, "=" & Hex(i), Chr(i))
End If
Next
strTemp = Replace(strTemp, "_", " ")
strTemp = Replace(strTemp, "=", "")
strTemp = Replace(strTemp, Chr$(255) & Chr$(254), "=")
ConvISO8859 = strTemp
ElseIf LCase(sText) Like "*?b?*" Then
sText = Right$(sText, Len(sText) - InStr(1, sText, "?B?",
vbTextCompare) - 2)
ConvISO8859 = Base64Decode$(sText)
End If
End Function
Public Function Base64Encode$(S$)
Dim B() As Byte, Out() As Byte, i&, j&, L&, Enc() As Byte
If Len(S) = 0 Then Exit Function
Enc > StrConv("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/",
vbFromUnicode)
L = Len(S): B = StrConv(S, vbFromUnicode)
ReDim Preserve B(0 To (UBound(B) 3) * 3 + 2)
ReDim Preserve Out(0 To (UBound(B) 3) * 4 + 3)
For i = 0 To UBound(B) - 1 Step 3
Out(j) = Enc(B(i) 4): j = j + 1
Out(j) = Enc((B(i + 1) 16) Or (B(i) And 3) * 16): j = j + 1
Out(j) = Enc((B(i + 2) 64) Or (B(i + 1) And 15) * 4): j = j + 1
Out(j) = Enc(B(i + 2) And 63): j = j + 1
Next i
For i = 1 To i - L: Out(UBound(Out) - i + 1) = 61: Next i
Base64Encode = StrConv(Out, vbUnicode)
End Function
Public Function Base64Decode$(S$)
Dim B() As Byte, Out() As Byte, i&, j&, L&, Enc() As Byte, Dec(0 To 255)
As Byte
If Len(S) = 0 Then Exit Function
Enc > StrConv("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/",
vbFromUnicode)
For i = 0 To 255: Dec(i) = 64: Next
For i = 0 To 63: Dec(Enc(i)) = i: Next
L = Len(S): B = StrConv(S, vbFromUnicode)
ReDim Preserve Out(0 To (L 4) * 3 - 1)
For i = 0 To UBound(B) Step 4
Out(j) = (Dec(B(i)) * 4) Or (Dec(B(i + 1)) 16): j = j + 1
Out(j) = (Dec(B(i + 1)) And 15) * 16 Or (Dec(B(i + 2)) 4): j = j + 1
Out(j) = (Dec(B(i + 2)) And 3) * 64 Or Dec(B(i + 3)): j = j + 1
Next i
If B(L - 2) = 61 Then j = 2 Else If B(L - 1) = 61 Then j = 1 Else j = 0
ReDim Preserve Out(0 To UBound(Out) - j)
Base64Decode = StrConv(Out, vbUnicode)
End Function
Exemple :
Debug.Print ConvISO8859("=?iso-8859-1?Q?à?=") '//Renvoie à
--
Nicolas G.
FAQ VB : http://faq.vb.free.fr
API Guide : http://www.allapi.net
Google Groups : http://groups.google.fr/
MZ-Tools : http://www.mztools.com/
Gloops wrote:Bonjour tout le monde,
Dans mes titres de mails, je trouve des choses du style
Forum sur le site Internet =?iso-8859-1?Q?à?= propos de
A la place de =?iso-8859-1?Q?à?= je verrais bien plutôt un a accent
grave.
Est-ce qu'il faut que je m'amuse à une recherche de =?iso-8859-1?Q? et
remplacer par le caractère dont le code ASCII suit en hexadécimal, ou
bien la fonction utilisée par pratiquement tous les clients de mail
pour
ce faire est disponible quelque part, par exemple dans les API ?
Salut,
J'avais fait ca il y a longtemps pour un client mail, tu peux essayer :
Public Function ConvISO8859(sText As String) As String
If Right$(sText, 1) = "=" Then sText = Left$(sText, Len(sText) - 1)
If Right$(sText, 1) = "?" Then sText = Left$(sText, Len(sText) - 1)
If LCase$(sText) Like "*?q?*" Then
Dim strTemp As String
Dim i As Integer
strTemp = sText
strTemp = Right$(strTemp, Len(strTemp) - InStr(1, strTemp, "?Q?",
vbTextCompare) - 2)
For i = 255 To 32 Step -1
If InStr(1, strTemp, "=" & Hex(i)) <> 0 Then
strTemp = Replace(strTemp, "=" & Hex(i), Chr(i))
End If
Next
strTemp = Replace(strTemp, "_", " ")
strTemp = Replace(strTemp, "=", "")
strTemp = Replace(strTemp, Chr$(255) & Chr$(254), "=")
ConvISO8859 = strTemp
ElseIf LCase(sText) Like "*?b?*" Then
sText = Right$(sText, Len(sText) - InStr(1, sText, "?B?",
vbTextCompare) - 2)
ConvISO8859 = Base64Decode$(sText)
End If
End Function
Public Function Base64Encode$(S$)
Dim B() As Byte, Out() As Byte, i&, j&, L&, Enc() As Byte
If Len(S) = 0 Then Exit Function
Enc > StrConv("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/",
vbFromUnicode)
L = Len(S): B = StrConv(S, vbFromUnicode)
ReDim Preserve B(0 To (UBound(B) 3) * 3 + 2)
ReDim Preserve Out(0 To (UBound(B) 3) * 4 + 3)
For i = 0 To UBound(B) - 1 Step 3
Out(j) = Enc(B(i) 4): j = j + 1
Out(j) = Enc((B(i + 1) 16) Or (B(i) And 3) * 16): j = j + 1
Out(j) = Enc((B(i + 2) 64) Or (B(i + 1) And 15) * 4): j = j + 1
Out(j) = Enc(B(i + 2) And 63): j = j + 1
Next i
For i = 1 To i - L: Out(UBound(Out) - i + 1) = 61: Next i
Base64Encode = StrConv(Out, vbUnicode)
End Function
Public Function Base64Decode$(S$)
Dim B() As Byte, Out() As Byte, i&, j&, L&, Enc() As Byte, Dec(0 To 255)
As Byte
If Len(S) = 0 Then Exit Function
Enc > StrConv("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/",
vbFromUnicode)
For i = 0 To 255: Dec(i) = 64: Next
For i = 0 To 63: Dec(Enc(i)) = i: Next
L = Len(S): B = StrConv(S, vbFromUnicode)
ReDim Preserve Out(0 To (L 4) * 3 - 1)
For i = 0 To UBound(B) Step 4
Out(j) = (Dec(B(i)) * 4) Or (Dec(B(i + 1)) 16): j = j + 1
Out(j) = (Dec(B(i + 1)) And 15) * 16 Or (Dec(B(i + 2)) 4): j = j + 1
Out(j) = (Dec(B(i + 2)) And 3) * 64 Or Dec(B(i + 3)): j = j + 1
Next i
If B(L - 2) = 61 Then j = 2 Else If B(L - 1) = 61 Then j = 1 Else j = 0
ReDim Preserve Out(0 To UBound(Out) - j)
Base64Decode = StrConv(Out, vbUnicode)
End Function
Exemple :
Debug.Print ConvISO8859("=?iso-8859-1?Q?à?=") '//Renvoie à
--
Nicolas G.
FAQ VB : http://faq.vb.free.fr
API Guide : http://www.allapi.net
Google Groups : http://groups.google.fr/
MZ-Tools : http://www.mztools.com/
Gloops wrote:
Bonjour tout le monde,
Dans mes titres de mails, je trouve des choses du style
Forum sur le site Internet =?iso-8859-1?Q?à?= propos de
A la place de =?iso-8859-1?Q?à?= je verrais bien plutôt un a accent
grave.
Est-ce qu'il faut que je m'amuse à une recherche de =?iso-8859-1?Q? et
remplacer par le caractère dont le code ASCII suit en hexadécimal, ou
bien la fonction utilisée par pratiquement tous les clients de mail
pour
ce faire est disponible quelque part, par exemple dans les API ?
Salut,
J'avais fait ca il y a longtemps pour un client mail, tu peux essayer :
Public Function ConvISO8859(sText As String) As String
If Right$(sText, 1) = "=" Then sText = Left$(sText, Len(sText) - 1)
If Right$(sText, 1) = "?" Then sText = Left$(sText, Len(sText) - 1)
If LCase$(sText) Like "*?q?*" Then
Dim strTemp As String
Dim i As Integer
strTemp = sText
strTemp = Right$(strTemp, Len(strTemp) - InStr(1, strTemp, "?Q?",
vbTextCompare) - 2)
For i = 255 To 32 Step -1
If InStr(1, strTemp, "=" & Hex(i)) <> 0 Then
strTemp = Replace(strTemp, "=" & Hex(i), Chr(i))
End If
Next
strTemp = Replace(strTemp, "_", " ")
strTemp = Replace(strTemp, "=", "")
strTemp = Replace(strTemp, Chr$(255) & Chr$(254), "=")
ConvISO8859 = strTemp
ElseIf LCase(sText) Like "*?b?*" Then
sText = Right$(sText, Len(sText) - InStr(1, sText, "?B?",
vbTextCompare) - 2)
ConvISO8859 = Base64Decode$(sText)
End If
End Function
Public Function Base64Encode$(S$)
Dim B() As Byte, Out() As Byte, i&, j&, L&, Enc() As Byte
If Len(S) = 0 Then Exit Function
Enc > StrConv("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/",
vbFromUnicode)
L = Len(S): B = StrConv(S, vbFromUnicode)
ReDim Preserve B(0 To (UBound(B) 3) * 3 + 2)
ReDim Preserve Out(0 To (UBound(B) 3) * 4 + 3)
For i = 0 To UBound(B) - 1 Step 3
Out(j) = Enc(B(i) 4): j = j + 1
Out(j) = Enc((B(i + 1) 16) Or (B(i) And 3) * 16): j = j + 1
Out(j) = Enc((B(i + 2) 64) Or (B(i + 1) And 15) * 4): j = j + 1
Out(j) = Enc(B(i + 2) And 63): j = j + 1
Next i
For i = 1 To i - L: Out(UBound(Out) - i + 1) = 61: Next i
Base64Encode = StrConv(Out, vbUnicode)
End Function
Public Function Base64Decode$(S$)
Dim B() As Byte, Out() As Byte, i&, j&, L&, Enc() As Byte, Dec(0 To 255)
As Byte
If Len(S) = 0 Then Exit Function
Enc > StrConv("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/",
vbFromUnicode)
For i = 0 To 255: Dec(i) = 64: Next
For i = 0 To 63: Dec(Enc(i)) = i: Next
L = Len(S): B = StrConv(S, vbFromUnicode)
ReDim Preserve Out(0 To (L 4) * 3 - 1)
For i = 0 To UBound(B) Step 4
Out(j) = (Dec(B(i)) * 4) Or (Dec(B(i + 1)) 16): j = j + 1
Out(j) = (Dec(B(i + 1)) And 15) * 16 Or (Dec(B(i + 2)) 4): j = j + 1
Out(j) = (Dec(B(i + 2)) And 3) * 64 Or Dec(B(i + 3)): j = j + 1
Next i
If B(L - 2) = 61 Then j = 2 Else If B(L - 1) = 61 Then j = 1 Else j = 0
ReDim Preserve Out(0 To UBound(Out) - j)
Base64Decode = StrConv(Out, vbUnicode)
End Function
Exemple :
Debug.Print ConvISO8859("=?iso-8859-1?Q?à?=") '//Renvoie à
--
Nicolas G.
FAQ VB : http://faq.vb.free.fr
API Guide : http://www.allapi.net
Google Groups : http://groups.google.fr/
MZ-Tools : http://www.mztools.com/
Gloops wrote:Bonjour tout le monde,
Dans mes titres de mails, je trouve des choses du style
Forum sur le site Internet =?iso-8859-1?Q?à?= propos de
A la place de =?iso-8859-1?Q?à?= je verrais bien plutôt un a accent
grave.
Est-ce qu'il faut que je m'amuse à une recherche de =?iso-8859-1?Q? et
remplacer par le caractère dont le code ASCII suit en hexadécimal, ou
bien la fonction utilisée par pratiquement tous les clients de mail
pour
ce faire est disponible quelque part, par exemple dans les API ?
Re-salut,
Bon, pour l'exemple que j'ai donné (recopié ci-dessous), la conversion
par ConvISO8859 donne
à? propos de
ce qui fait qu'il y a un point d'interrogation en trop après le a
accent grave, et tout ce qui est devant a disparu.
La conversion par Base64Decode donne un dépassement de capacité, et la
conversion par Base64Encode donne une chaîne illisible (de toute
manière
là on ne code pas, on décode).
Est-ce que des fois il y aurait quelque chose que j'aurais fait à
l'envers ?
Dis-moi si tu penses que c'est évident, sinon laisse, autant que je
développe un truc à ma sauce, comme ça je saurai au juste comment
c'est structuré (tu as été un peu avare en commentaires dans le code,
non ?)
Exemple 1:
ConvISO8859("Forum sur le site Internet =?iso-8859-1?Q?à?= propos
de") donne:
à? propos de
au lieu de:
Forum sur le site Internet à propos de
Exemple 2:
ConvISO8859("Forum sur le site Internet =?iso-8859-1?Q?à?= propos de
la consultation des =?iso-8859-1?Q?adhérents?= sur le
=?iso-8859-1?Q?référendum?=")
donne:
à? propos de la consultation des ?iso-8859-1?Q?adhérents? sur le
?iso-8859-1?Q?référendum
au lieu de:
Forum sur le site Internet à propos de la consultation des adhérents
sur
le référendum
(c'est du sport, que j'ai tenté, de transcrire ça dans les newsgroups
;
ça ne sera pas lisible pour tout le monde)
Pour qu'on parle bien de la même chose, on reçoit une chaîne de
caractères comportant des parties à décoder délimitées au début par
"=?iso-8859-1?Q?" et à la fin par "?=", guillemets non compris.
Dans chaque partie à décoder, chaque caractère = est suivi de deux
caractères constituant le code ASCII hexadécimal d'un caractère à
placer
à la place du signe égal et de son code ASCII : c'est ainsi qu'au sein
de la partie à décoder "à" devient "à".
Je m'exprime de façon un peu lourde mais j'espère que ça permet
d'éviter des ambiguïtés.
Deux précisions :
- chaque partie à décoder (délimitée comme je viens de le dire) peut
comporter plusieurs codes ASCII, précédés chacun d'un signe > - la chaîne à convertir (passée en argument de la fonction) peut
comporter plusieurs parties à décoder
Ceci ressort de l'exemple 2 ci-dessus.
_________________________________
ng a écrit, le 15/10/2004 13:34 :Salut,
J'avais fait ca il y a longtemps pour un client mail, tu peux
essayer :
Public Function ConvISO8859(sText As String) As String
If Right$(sText, 1) = "=" Then sText = Left$(sText, Len(sText) -
1) If Right$(sText, 1) = "?" Then sText = Left$(sText,
Len(sText) - 1) If LCase$(sText) Like "*?q?*" Then
Dim strTemp As String
Dim i As Integer
strTemp = sText
strTemp = Right$(strTemp, Len(strTemp) - InStr(1, strTemp,
"?Q?", vbTextCompare) - 2)
For i = 255 To 32 Step -1
If InStr(1, strTemp, "=" & Hex(i)) <> 0 Then
strTemp = Replace(strTemp, "=" & Hex(i), Chr(i))
End If
Next
strTemp = Replace(strTemp, "_", " ")
strTemp = Replace(strTemp, "=", "")
strTemp = Replace(strTemp, Chr$(255) & Chr$(254), "=")
ConvISO8859 = strTemp
ElseIf LCase(sText) Like "*?b?*" Then
sText = Right$(sText, Len(sText) - InStr(1, sText, "?B?",
vbTextCompare) - 2)
ConvISO8859 = Base64Decode$(sText)
End If
End Function
Public Function Base64Encode$(S$)
Dim B() As Byte, Out() As Byte, i&, j&, L&, Enc() As Byte
If Len(S) = 0 Then Exit Function
Enc >>
vbFromUnicode)
L = Len(S): B = StrConv(S, vbFromUnicode)
ReDim Preserve B(0 To (UBound(B) 3) * 3 + 2)
ReDim Preserve Out(0 To (UBound(B) 3) * 4 + 3)
For i = 0 To UBound(B) - 1 Step 3
Out(j) = Enc(B(i) 4): j = j + 1
Out(j) = Enc((B(i + 1) 16) Or (B(i) And 3) * 16): j = j + 1
Out(j) = Enc((B(i + 2) 64) Or (B(i + 1) And 15) * 4): j = j + 1
Out(j) = Enc(B(i + 2) And 63): j = j + 1
Next i
For i = 1 To i - L: Out(UBound(Out) - i + 1) = 61: Next i
Base64Encode = StrConv(Out, vbUnicode)
End Function
Public Function Base64Decode$(S$)
Dim B() As Byte, Out() As Byte, i&, j&, L&, Enc() As Byte, Dec(0
To 255) As Byte
If Len(S) = 0 Then Exit Function
Enc >>
vbFromUnicode)
For i = 0 To 255: Dec(i) = 64: Next
For i = 0 To 63: Dec(Enc(i)) = i: Next
L = Len(S): B = StrConv(S, vbFromUnicode)
ReDim Preserve Out(0 To (L 4) * 3 - 1)
For i = 0 To UBound(B) Step 4
Out(j) = (Dec(B(i)) * 4) Or (Dec(B(i + 1)) 16): j = j + 1
Out(j) = (Dec(B(i + 1)) And 15) * 16 Or (Dec(B(i + 2)) 4): j >> j + 1 Out(j) = (Dec(B(i + 2)) And 3) * 64 Or Dec(B(i + 3)): j >> j + 1 Next i
If B(L - 2) = 61 Then j = 2 Else If B(L - 1) = 61 Then j = 1 Else
j = 0 ReDim Preserve Out(0 To UBound(Out) - j)
Base64Decode = StrConv(Out, vbUnicode)
End Function
Exemple :
Debug.Print ConvISO8859("=?iso-8859-1?Q?à?=") '//Renvoie à
--
Nicolas G.
FAQ VB : http://faq.vb.free.fr
API Guide : http://www.allapi.net
Google Groups : http://groups.google.fr/
MZ-Tools : http://www.mztools.com/
Gloops wrote:Bonjour tout le monde,
Dans mes titres de mails, je trouve des choses du style
Forum sur le site Internet =?iso-8859-1?Q?à?= propos de
A la place de =?iso-8859-1?Q?à?= je verrais bien plutôt un a
accent grave.
Est-ce qu'il faut que je m'amuse à une recherche de =?iso-8859-1?Q?
et remplacer par le caractère dont le code ASCII suit en
hexadécimal, ou bien la fonction utilisée par pratiquement tous les
clients de mail pour
ce faire est disponible quelque part, par exemple dans les API ?
Re-salut,
Bon, pour l'exemple que j'ai donné (recopié ci-dessous), la conversion
par ConvISO8859 donne
à? propos de
ce qui fait qu'il y a un point d'interrogation en trop après le a
accent grave, et tout ce qui est devant a disparu.
La conversion par Base64Decode donne un dépassement de capacité, et la
conversion par Base64Encode donne une chaîne illisible (de toute
manière
là on ne code pas, on décode).
Est-ce que des fois il y aurait quelque chose que j'aurais fait à
l'envers ?
Dis-moi si tu penses que c'est évident, sinon laisse, autant que je
développe un truc à ma sauce, comme ça je saurai au juste comment
c'est structuré (tu as été un peu avare en commentaires dans le code,
non ?)
Exemple 1:
ConvISO8859("Forum sur le site Internet =?iso-8859-1?Q?à?= propos
de") donne:
à? propos de
au lieu de:
Forum sur le site Internet à propos de
Exemple 2:
ConvISO8859("Forum sur le site Internet =?iso-8859-1?Q?à?= propos de
la consultation des =?iso-8859-1?Q?adhérents?= sur le
=?iso-8859-1?Q?référendum?=")
donne:
à? propos de la consultation des ?iso-8859-1?Q?adhérents? sur le
?iso-8859-1?Q?référendum
au lieu de:
Forum sur le site Internet à propos de la consultation des adhérents
sur
le référendum
(c'est du sport, que j'ai tenté, de transcrire ça dans les newsgroups
;
ça ne sera pas lisible pour tout le monde)
Pour qu'on parle bien de la même chose, on reçoit une chaîne de
caractères comportant des parties à décoder délimitées au début par
"=?iso-8859-1?Q?" et à la fin par "?=", guillemets non compris.
Dans chaque partie à décoder, chaque caractère = est suivi de deux
caractères constituant le code ASCII hexadécimal d'un caractère à
placer
à la place du signe égal et de son code ASCII : c'est ainsi qu'au sein
de la partie à décoder "à" devient "à".
Je m'exprime de façon un peu lourde mais j'espère que ça permet
d'éviter des ambiguïtés.
Deux précisions :
- chaque partie à décoder (délimitée comme je viens de le dire) peut
comporter plusieurs codes ASCII, précédés chacun d'un signe > - la chaîne à convertir (passée en argument de la fonction) peut
comporter plusieurs parties à décoder
Ceci ressort de l'exemple 2 ci-dessus.
_________________________________
ng a écrit, le 15/10/2004 13:34 :
Salut,
J'avais fait ca il y a longtemps pour un client mail, tu peux
essayer :
Public Function ConvISO8859(sText As String) As String
If Right$(sText, 1) = "=" Then sText = Left$(sText, Len(sText) -
1) If Right$(sText, 1) = "?" Then sText = Left$(sText,
Len(sText) - 1) If LCase$(sText) Like "*?q?*" Then
Dim strTemp As String
Dim i As Integer
strTemp = sText
strTemp = Right$(strTemp, Len(strTemp) - InStr(1, strTemp,
"?Q?", vbTextCompare) - 2)
For i = 255 To 32 Step -1
If InStr(1, strTemp, "=" & Hex(i)) <> 0 Then
strTemp = Replace(strTemp, "=" & Hex(i), Chr(i))
End If
Next
strTemp = Replace(strTemp, "_", " ")
strTemp = Replace(strTemp, "=", "")
strTemp = Replace(strTemp, Chr$(255) & Chr$(254), "=")
ConvISO8859 = strTemp
ElseIf LCase(sText) Like "*?b?*" Then
sText = Right$(sText, Len(sText) - InStr(1, sText, "?B?",
vbTextCompare) - 2)
ConvISO8859 = Base64Decode$(sText)
End If
End Function
Public Function Base64Encode$(S$)
Dim B() As Byte, Out() As Byte, i&, j&, L&, Enc() As Byte
If Len(S) = 0 Then Exit Function
Enc >>
vbFromUnicode)
L = Len(S): B = StrConv(S, vbFromUnicode)
ReDim Preserve B(0 To (UBound(B) 3) * 3 + 2)
ReDim Preserve Out(0 To (UBound(B) 3) * 4 + 3)
For i = 0 To UBound(B) - 1 Step 3
Out(j) = Enc(B(i) 4): j = j + 1
Out(j) = Enc((B(i + 1) 16) Or (B(i) And 3) * 16): j = j + 1
Out(j) = Enc((B(i + 2) 64) Or (B(i + 1) And 15) * 4): j = j + 1
Out(j) = Enc(B(i + 2) And 63): j = j + 1
Next i
For i = 1 To i - L: Out(UBound(Out) - i + 1) = 61: Next i
Base64Encode = StrConv(Out, vbUnicode)
End Function
Public Function Base64Decode$(S$)
Dim B() As Byte, Out() As Byte, i&, j&, L&, Enc() As Byte, Dec(0
To 255) As Byte
If Len(S) = 0 Then Exit Function
Enc >>
vbFromUnicode)
For i = 0 To 255: Dec(i) = 64: Next
For i = 0 To 63: Dec(Enc(i)) = i: Next
L = Len(S): B = StrConv(S, vbFromUnicode)
ReDim Preserve Out(0 To (L 4) * 3 - 1)
For i = 0 To UBound(B) Step 4
Out(j) = (Dec(B(i)) * 4) Or (Dec(B(i + 1)) 16): j = j + 1
Out(j) = (Dec(B(i + 1)) And 15) * 16 Or (Dec(B(i + 2)) 4): j >> j + 1 Out(j) = (Dec(B(i + 2)) And 3) * 64 Or Dec(B(i + 3)): j >> j + 1 Next i
If B(L - 2) = 61 Then j = 2 Else If B(L - 1) = 61 Then j = 1 Else
j = 0 ReDim Preserve Out(0 To UBound(Out) - j)
Base64Decode = StrConv(Out, vbUnicode)
End Function
Exemple :
Debug.Print ConvISO8859("=?iso-8859-1?Q?à?=") '//Renvoie à
--
Nicolas G.
FAQ VB : http://faq.vb.free.fr
API Guide : http://www.allapi.net
Google Groups : http://groups.google.fr/
MZ-Tools : http://www.mztools.com/
Gloops wrote:
Bonjour tout le monde,
Dans mes titres de mails, je trouve des choses du style
Forum sur le site Internet =?iso-8859-1?Q?à?= propos de
A la place de =?iso-8859-1?Q?à?= je verrais bien plutôt un a
accent grave.
Est-ce qu'il faut que je m'amuse à une recherche de =?iso-8859-1?Q?
et remplacer par le caractère dont le code ASCII suit en
hexadécimal, ou bien la fonction utilisée par pratiquement tous les
clients de mail pour
ce faire est disponible quelque part, par exemple dans les API ?
Re-salut,
Bon, pour l'exemple que j'ai donné (recopié ci-dessous), la conversion
par ConvISO8859 donne
à? propos de
ce qui fait qu'il y a un point d'interrogation en trop après le a
accent grave, et tout ce qui est devant a disparu.
La conversion par Base64Decode donne un dépassement de capacité, et la
conversion par Base64Encode donne une chaîne illisible (de toute
manière
là on ne code pas, on décode).
Est-ce que des fois il y aurait quelque chose que j'aurais fait à
l'envers ?
Dis-moi si tu penses que c'est évident, sinon laisse, autant que je
développe un truc à ma sauce, comme ça je saurai au juste comment
c'est structuré (tu as été un peu avare en commentaires dans le code,
non ?)
Exemple 1:
ConvISO8859("Forum sur le site Internet =?iso-8859-1?Q?à?= propos
de") donne:
à? propos de
au lieu de:
Forum sur le site Internet à propos de
Exemple 2:
ConvISO8859("Forum sur le site Internet =?iso-8859-1?Q?à?= propos de
la consultation des =?iso-8859-1?Q?adhérents?= sur le
=?iso-8859-1?Q?référendum?=")
donne:
à? propos de la consultation des ?iso-8859-1?Q?adhérents? sur le
?iso-8859-1?Q?référendum
au lieu de:
Forum sur le site Internet à propos de la consultation des adhérents
sur
le référendum
(c'est du sport, que j'ai tenté, de transcrire ça dans les newsgroups
;
ça ne sera pas lisible pour tout le monde)
Pour qu'on parle bien de la même chose, on reçoit une chaîne de
caractères comportant des parties à décoder délimitées au début par
"=?iso-8859-1?Q?" et à la fin par "?=", guillemets non compris.
Dans chaque partie à décoder, chaque caractère = est suivi de deux
caractères constituant le code ASCII hexadécimal d'un caractère à
placer
à la place du signe égal et de son code ASCII : c'est ainsi qu'au sein
de la partie à décoder "à" devient "à".
Je m'exprime de façon un peu lourde mais j'espère que ça permet
d'éviter des ambiguïtés.
Deux précisions :
- chaque partie à décoder (délimitée comme je viens de le dire) peut
comporter plusieurs codes ASCII, précédés chacun d'un signe > - la chaîne à convertir (passée en argument de la fonction) peut
comporter plusieurs parties à décoder
Ceci ressort de l'exemple 2 ci-dessus.
_________________________________
ng a écrit, le 15/10/2004 13:34 :Salut,
J'avais fait ca il y a longtemps pour un client mail, tu peux
essayer :
Public Function ConvISO8859(sText As String) As String
If Right$(sText, 1) = "=" Then sText = Left$(sText, Len(sText) -
1) If Right$(sText, 1) = "?" Then sText = Left$(sText,
Len(sText) - 1) If LCase$(sText) Like "*?q?*" Then
Dim strTemp As String
Dim i As Integer
strTemp = sText
strTemp = Right$(strTemp, Len(strTemp) - InStr(1, strTemp,
"?Q?", vbTextCompare) - 2)
For i = 255 To 32 Step -1
If InStr(1, strTemp, "=" & Hex(i)) <> 0 Then
strTemp = Replace(strTemp, "=" & Hex(i), Chr(i))
End If
Next
strTemp = Replace(strTemp, "_", " ")
strTemp = Replace(strTemp, "=", "")
strTemp = Replace(strTemp, Chr$(255) & Chr$(254), "=")
ConvISO8859 = strTemp
ElseIf LCase(sText) Like "*?b?*" Then
sText = Right$(sText, Len(sText) - InStr(1, sText, "?B?",
vbTextCompare) - 2)
ConvISO8859 = Base64Decode$(sText)
End If
End Function
Public Function Base64Encode$(S$)
Dim B() As Byte, Out() As Byte, i&, j&, L&, Enc() As Byte
If Len(S) = 0 Then Exit Function
Enc >>
vbFromUnicode)
L = Len(S): B = StrConv(S, vbFromUnicode)
ReDim Preserve B(0 To (UBound(B) 3) * 3 + 2)
ReDim Preserve Out(0 To (UBound(B) 3) * 4 + 3)
For i = 0 To UBound(B) - 1 Step 3
Out(j) = Enc(B(i) 4): j = j + 1
Out(j) = Enc((B(i + 1) 16) Or (B(i) And 3) * 16): j = j + 1
Out(j) = Enc((B(i + 2) 64) Or (B(i + 1) And 15) * 4): j = j + 1
Out(j) = Enc(B(i + 2) And 63): j = j + 1
Next i
For i = 1 To i - L: Out(UBound(Out) - i + 1) = 61: Next i
Base64Encode = StrConv(Out, vbUnicode)
End Function
Public Function Base64Decode$(S$)
Dim B() As Byte, Out() As Byte, i&, j&, L&, Enc() As Byte, Dec(0
To 255) As Byte
If Len(S) = 0 Then Exit Function
Enc >>
vbFromUnicode)
For i = 0 To 255: Dec(i) = 64: Next
For i = 0 To 63: Dec(Enc(i)) = i: Next
L = Len(S): B = StrConv(S, vbFromUnicode)
ReDim Preserve Out(0 To (L 4) * 3 - 1)
For i = 0 To UBound(B) Step 4
Out(j) = (Dec(B(i)) * 4) Or (Dec(B(i + 1)) 16): j = j + 1
Out(j) = (Dec(B(i + 1)) And 15) * 16 Or (Dec(B(i + 2)) 4): j >> j + 1 Out(j) = (Dec(B(i + 2)) And 3) * 64 Or Dec(B(i + 3)): j >> j + 1 Next i
If B(L - 2) = 61 Then j = 2 Else If B(L - 1) = 61 Then j = 1 Else
j = 0 ReDim Preserve Out(0 To UBound(Out) - j)
Base64Decode = StrConv(Out, vbUnicode)
End Function
Exemple :
Debug.Print ConvISO8859("=?iso-8859-1?Q?à?=") '//Renvoie à
--
Nicolas G.
FAQ VB : http://faq.vb.free.fr
API Guide : http://www.allapi.net
Google Groups : http://groups.google.fr/
MZ-Tools : http://www.mztools.com/
Gloops wrote:Bonjour tout le monde,
Dans mes titres de mails, je trouve des choses du style
Forum sur le site Internet =?iso-8859-1?Q?à?= propos de
A la place de =?iso-8859-1?Q?à?= je verrais bien plutôt un a
accent grave.
Est-ce qu'il faut que je m'amuse à une recherche de =?iso-8859-1?Q?
et remplacer par le caractère dont le code ASCII suit en
hexadécimal, ou bien la fonction utilisée par pratiquement tous les
clients de mail pour
ce faire est disponible quelque part, par exemple dans les API ?
