1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
| Public Function DecodeQuotedPrintable(Text As String) As String
Dim lPntIn As Long 'compteur caractères dans Text
Dim lPntOut As Long 'position insertion dans buffer
Dim Buffer As String 'buffer reception du dé-codage
Dim Char As String 'le caratére en cours d'analyse
Dim AsciiCode As String 'son code asccii en hexadécimal
If Text = "" Then
DecodeQuotedPrintable = ""
Exit Function
End If
Buffer = String(Len(Text), 0) ' au max, 1 caractère en sortie pour chaque caractère en entrée
lPntOut = 1
For lPntIn = 1 To Len(Text)
Char = Mid(Text, lPntIn, 1)
Select Case Char
Case "="
AsciiCode = Mid(Text, lPntIn + 1, 2)
If AsciiCode = vbCrLf Then
'caractère continuation de ligne
lPntIn = lPntIn + 2
Else
'caractère codé
Mid(Buffer, lPntOut, 1) = Chr(Val("&H" & AsciiCode))
lPntOut = lPntOut + 1
lPntIn = lPntIn + 2
End If
Case Else
'caractère litéral
Mid(Buffer, lPntOut, 1) = Char
lPntOut = lPntOut + 1
End Select
Next
DecodeQuotedPrintable= Left(Buffer, lPntOut - 1)
End Function
Public Function EncodeQuotedPrintable(Text As String) As String
Dim lPntIn As Long 'compteur caractères dans Text
Dim lPntOut As Long 'position insertion dans buffer
Dim lLenLign As Long 'Longeur ligne en cours
Dim Buffer As String 'buffer reception du codage
Dim Char As String 'le caratére en cours d'analyse
Dim AsciiCode As Integer 'son code asccii
If Text = "" Then
EncodeQuotedPrintable = ""
Exit Function
End If
Buffer = String(Len(Text) * 3, 0) ' au max, 3 caractères en sortie pour chaque caractère en entrée
lPntOut = 1
lLenLign = 1
For lPntIn = 1 To Len(Text)
Char = Mid(Text, lPntIn, 1)
AsciiCode = Asc(Char)
Select Case AsciiCode
Case 33 To 60, 62 To 126
'caractère litéral
'tous ces caractères peuvent être acceptés tels quels
Mid(Buffer, lPntOut, 1) = Char
lPntOut = lPntOut + 1
lLenLign = lLenLign + 1
Case 9, 32
'----------------------------------------
'version abandonnée
'Mid(Buffer, lPntOut, 1) = Char
'lPntOut = lPntOut + 1
'lLenLign = lLenLign + 1
'----------------------------------------
'le caractère blanc et le caractère tab sont censés être acceptés sans codage
'mais pas s'ils terminent une ligne ! auquel cas il doivent être codés.
'Comme ce n'est pas simple à coder, je les code tous
Mid(Buffer, lPntOut, 3) = "=" & Right("00" & Hex(AsciiCode), 2)
lPntOut = lPntOut + 3
lLenLign = lLenLign + 3
Case Else
'on code tous les autres caractères
Mid(Buffer, lPntOut, 3) = "=" & Right("00" & Hex(AsciiCode), 2)
lPntOut = lPntOut + 3
lLenLign = lLenLign + 3
End Select
If lLenLign > 72 Then
'si on arrive en bout de ligne (qui ne doit pas passer 76 caractères)
'on insére une continuation de ligne ( =CRLF )
Mid(Buffer, lPntOut, 3) = "=" & vbCrLf
lPntOut = lPntOut + 3
lLenLign = 1
End If
Next
EncodeQuotedPrintable= Left(Buffer, lPntOut - 1)
'si on termine par "= & vbcrlf , on le retire
If Right(EncodeQuotedPrintable, 3) = "=" & vbCrLf Then
EncodeQuotedPrintable= Left(EncodeQuotedPrintable, Len(EncodeQuotedPrintable) - 3)
End If
End Function |
