source: tags/1.1.0/UQuotedPrintable.pas

Last change on this file was 46, checked in by chronos, 4 years ago
  • Fixed: Long BASE64 encoded lines were not automatically wrapped to limit max line length.
  • Fixed: Missing quoted-printable encoding for saving files.
File size: 8.2 KB
Line 
1unit UQuotedPrintable;
2
3{$mode delphi}
4
5interface
6
7uses
8 Classes, SysUtils;
9
10function DecodeQuotedPrintable(Text: string): string;
11function EncodeQuotedPrintable(Text: string): string;
12
13
14implementation
15
16resourcestring
17 SLineLengthErr = 'Invalid line length for encoded text';
18
19const
20 MaxLine = 1000;
21
22function DecodeQuotedPrintable(Text: string): string;
23var
24 O, Count, WS: Integer;
25 I: integer;
26 InBuf: array[0..Pred(MaxLine)] of Byte;
27 OutBuf: array[0..Pred(MaxLine)] of Byte;
28 Decoding: Boolean;
29 Keeper: Boolean;
30 Abort: Boolean;
31 InStream: TMemoryStream;
32 OutStream: TMemoryStream;
33begin
34 Result := '';
35 InStream := TMemoryStream.Create;
36 OutStream := TMemoryStream.Create;
37 try
38 if Text <> '' then begin
39 InStream.Write(Text[1], Length(Text));
40 InStream.Position := 0;
41 end;
42 Abort := False;
43 FillChar(InBuf, SizeOf(InBuf), #0);
44 WS := $FF;
45 Decoding := True;
46 Keeper := False;
47
48 { Skip any CR/LF's to get to the encoded stuff }
49 while True do begin
50 if InStream.Read(Char(InBuf[0]), 1) = 0then
51 Exit;
52 if ((InBuf[0] <> $0D) and (InBuf[0] <> $0A)) then begin
53 Keeper := True;
54 Break;
55 end;
56 end;
57
58 while Decoding and not Abort do begin
59 { Initialize }
60 if Keeper then begin
61 I := 1;
62 Keeper := False;
63 end else begin
64 I := 0;
65 end;
66 O := 0;
67
68 { Read in one line at a time - skipping over bad characters }
69 while True do begin
70 if (I > High(InBuf)) then
71 raise Exception.Create(SLineLengthErr);
72 if InStream.Read(Char(InBuf[I]), 1) = 0 then
73 Break;
74 case InBuf[I] of
75 $0A : Continue;
76 $0D : begin
77 Inc(I);
78 Break;
79 end;
80 { Test for potential end of data }
81 { '--' is probably the next Mime boundary }
82 { $2D : if (I = 1) and (InBuf[0] = $2D) then Exit;}
83 end;
84 Inc(I);
85 end;
86
87 if I = 0 then Break;
88 Count := I;
89 I := 0;
90
91 { Decode data to output stream }
92 while I < Count do begin
93 case InBuf[I] of
94 9 : begin
95 if WS = $FF then
96 WS := O;
97 OutBuf[O] := InBuf[I];
98 Inc(O);
99 Inc(I);
100 end;
101 13 : if WS = $FF then begin
102 OutBuf[O] := 13;
103 OutBuf[O+1] := 10;
104 Inc(O, 2);
105 Inc(I);
106 end else begin
107 OutBuf[WS] := 13;
108 OutBuf[WS+1] := 10;
109 O := WS+2;
110 Inc(I);
111 end;
112 32 : begin
113 if WS = $FF then
114 WS := O;
115 OutBuf[O] := InBuf[I];
116 Inc(O);
117 Inc(I);
118 end;
119 33..60 : begin
120 WS := $FF;
121 OutBuf[O] := InBuf[I];
122 Inc(O);
123 Inc(I);
124 end;
125 61 : begin
126 WS := $FF;
127 if I+2 >= Count then Break;
128 case InBuf[I+1] of
129 48 : OutBuf[O] := 0; {0}
130 49 : OutBuf[O] := 16; {1}
131 50 : OutBuf[O] := 32; {2}
132 51 : OutBuf[O] := 48; {3}
133 52 : OutBuf[O] := 64; {4}
134 53 : OutBuf[O] := 80; {5}
135 54 : OutBuf[O] := 96; {6}
136 55 : OutBuf[O] := 112; {7}
137 56 : OutBuf[O] := 128; {8}
138 57 : OutBuf[O] := 144; {9}
139 65 : OutBuf[O] := 160; {A}
140 66 : OutBuf[O] := 176; {B}
141 67 : OutBuf[O] := 192; {C}
142 68 : OutBuf[O] := 208; {D}
143 69 : OutBuf[O] := 224; {E}
144 70 : OutBuf[O] := 240; {F}
145 97 : OutBuf[O] := 160; {a}
146 98 : OutBuf[O] := 176; {b}
147 99 : OutBuf[O] := 192; {c}
148 100 : OutBuf[O] := 208; {d}
149 101 : OutBuf[O] := 224; {e}
150 102 : OutBuf[O] := 240; {f}
151 end;
152 case InBuf[I+2] of
153 48 : ; {0}
154 49 : OutBuf[O] := OutBuf[O] + 1; {1}
155 50 : OutBuf[O] := OutBuf[O] + 2; {2}
156 51 : OutBuf[O] := OutBuf[O] + 3; {3}
157 52 : OutBuf[O] := OutBuf[O] + 4; {4}
158 53 : OutBuf[O] := OutBuf[O] + 5; {5}
159 54 : OutBuf[O] := OutBuf[O] + 6; {6}
160 55 : OutBuf[O] := OutBuf[O] + 7; {7}
161 56 : OutBuf[O] := OutBuf[O] + 8; {8}
162 57 : OutBuf[O] := OutBuf[O] + 9; {9}
163 65 : OutBuf[O] := OutBuf[O] + 10; {A}
164 66 : OutBuf[O] := OutBuf[O] + 11; {B}
165 67 : OutBuf[O] := OutBuf[O] + 12; {C}
166 68 : OutBuf[O] := OutBuf[O] + 13; {D}
167 69 : OutBuf[O] := OutBuf[O] + 14; {E}
168 70 : OutBuf[O] := OutBuf[O] + 15; {F}
169 97 : OutBuf[O] := OutBuf[O] + 10; {a}
170 98 : OutBuf[O] := OutBuf[O] + 11; {b}
171 99 : OutBuf[O] := OutBuf[O] + 12; {c}
172 100 : OutBuf[O] := OutBuf[O] + 13; {d}
173 101 : OutBuf[O] := OutBuf[O] + 14; {e}
174 102 : OutBuf[O] := OutBuf[O] + 15; {f}
175 end;
176 Inc(I, 3);
177 Inc(O);
178 end;
179 62..126 : begin
180 WS := $FF;
181 OutBuf[O] := InBuf[I];
182 Inc(O);
183 Inc(I);
184 end;
185 else
186 Inc(I);
187 end;
188 end;
189
190 if O > 0 then
191 OutStream.Write(OutBuf, O)
192 else
193 Break; { OutBuf is empty }
194 end;
195 SetLength(Result, OutStream.Size);
196 OutStream.Position := 0;
197 if OutStream.Size > 0 then
198 OutStream.Read(Result[1], Length(Result));
199 finally
200 OutStream.Free;
201 InStream.Free;
202 end;
203end;
204
205function EncodeQuotedPrintable(Text: string): string;
206var
207 O, W: Integer;
208 WordBuf, OutBuf: array[0..80] of AnsiChar;
209 CurChar: AnsiChar;
210 Abort: Boolean;
211 InStream: TStream;
212 OutStream: TMemoryStream;
213
214 procedure SendLine;
215 begin
216 if (OutBuf[O - 1] = #9) or (OutBuf[O - 1] = #32) then begin
217 OutBuf[O] := '=';
218 Inc(O);
219 end;
220 OutStream.Write(OutBuf, O);
221 FillChar(OutBuf, SizeOf(OutBuf), #0);
222 O := 0;
223 end;
224
225 procedure AddWordToOutBuf;
226 var
227 J : Integer;
228 begin
229 if (O + W) > 74 then SendLine;
230 for J := 0 to (W - 1) do begin
231 OutBuf[O] := WordBuf[J];
232 Inc(O);
233 end;
234 W := 0;
235 end;
236
237 procedure AddHexToWord(B : Byte);
238 const
239 HexDigits : array[0..$F] of AnsiChar = '0123456789ABCDEF';
240 begin
241 if W > 73 then AddWordToOutBuf;
242 WordBuf[W] := '=';
243 WordBuf[W + 1] := HexDigits[B shr 4];
244 WordBuf[W + 2] := HexDigits[B and $F];
245 Inc(W, 3)
246 end;
247
248begin
249 Result := '';
250 InStream := TMemoryStream.Create;
251 OutStream := TMemoryStream.Create;
252 try
253 if Text <> '' then begin
254 InStream.Write(Text[1], Length(Text));
255 InStream.Position := 0;
256 end;
257
258 Abort := False;
259 O := 0;
260 W := 0;
261 FillChar(OutBuf, SizeOf(OutBuf), #0);
262 while (InStream.Read(CurChar, 1) = 1) and not Abort do begin
263 if (Ord(CurChar) in [33..60, 62..126]) then begin
264 WordBuf[W] := CurChar;
265 Inc(W);
266 if W > 74 then AddWordToOutBuf;
267 end else if (CurChar = ' ') or (CurChar = #9) then begin
268 WordBuf[W] := CurChar;
269 Inc(W);
270 AddWordToOutBuf;
271 end else if (CurChar = #13) then begin
272 AddWordToOutBuf;
273 SendLine;
274 end else if (CurChar = #10) then begin
275 { Do nothing }
276 end else begin
277 AddHexToWord(Byte(CurChar));
278 end;
279 end;
280 AddWordToOutBuf;
281 OutStream.Write(OutBuf, O);
282 SetLength(Result, OutStream.Size);
283 OutStream.Position := 0;
284 if OutStream.Size > 0 then
285 OutStream.Read(Result[1], Length(Result));
286 finally
287 OutStream.Free;
288 InStream.Free;
289 end;
290end;
291
292end.
293
Note: See TracBrowser for help on using the repository browser.