Module

XlfMime

Path

C:\CPRS\CPRS30\XuDigSig\XlfMime.pas

Last Modified

7/15/2014 3:26:44 PM

Comments

Project JEDI Code Library (JCL)                                              
                                                                              
 The contents of this file are subject to the Mozilla Public License Version  
 1.1 (the "License"); you may not use this file except in compliance with the 
 License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ 
                                                                              
 Software distributed under the License is distributed on an "AS IS" basis,   
 WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for 
 the specific language governing rights and limitations under the License.    
                                                                              
 The Original Code is XlfMime.pas.                                            
                                                                              
 The Initial Developer of the Original Code is documented in the accompanying 
 help file JCL.chm. Portions created by these individuals are Copyright (C)   
 2000 of these individuals.                                                   
                                                                              

                                                                              
 Lightening fast Mime (Base64) Encoding and Decoding routines. Coded by Ralf  
 Junker (ralfjunker@gmx.de).                                                  
                                                                              
 Unit owner: Marcel van Brakel                                                
 Last modified: January 29, 2001                                              
                                                                              


{$I JCL.INC}

Procedures

Name Owner Declaration Scope Comments
MimeDecodeStream - procedure MimeDecodeStream(const InputStream: TStream; const OutputStream: TStream); Interfaced ------------------------------------------------------------------------------
MimeEncode - procedure MimeEncode(var InputBuffer; const InputByteCount: Cardinal; var OutputBuffer); Interfaced
------------------------------------------------------------------------------
 Primary functions & procedures
------------------------------------------------------------------------------
MimeEncodeStream - procedure MimeEncodeStream(const InputStream: TStream; const OutputStream: TStream); Interfaced ------------------------------------------------------------------------------

Functions

Name Owner Declaration Scope Comments
MimeDecode - function MimeDecode(var InputBuffer; const InputBytesCount: Cardinal; var OutputBuffer): Cardinal; Interfaced ------------------------------------------------------------------------------
MimeDecodedSize - function MimeDecodedSize(const I: Cardinal): Cardinal; Interfaced ------------------------------------------------------------------------------
MimeDecodePartial - function MimeDecodePartial(var InputBuffer; const InputBytesCount: Cardinal; var OutputBuffer; var ByteBuffer: Cardinal; var ByteBufferSpace: Cardinal): Cardinal; Interfaced ------------------------------------------------------------------------------
MimeDecodePartialEnd - function MimeDecodePartialEnd(var OutputBuffer; const ByteBuffer: Cardinal; const ByteBufferSpace: Cardinal): Cardinal; Interfaced ------------------------------------------------------------------------------
MimeDecodeString - function MimeDecodeString(const S: AnsiString): AnsiString; Interfaced ------------------------------------------------------------------------------
MimeEncodedSize - function MimeEncodedSize(const I: Cardinal): Cardinal; Interfaced
------------------------------------------------------------------------------
 Helper functions
------------------------------------------------------------------------------
MimeEncodeString - function MimeEncodeString(const S: AnsiString): AnsiString; Interfaced
------------------------------------------------------------------------------
 Wrapper functions & procedures
------------------------------------------------------------------------------

Constants

Name Declaration Scope Comments
BUFFER_SIZE $3000 Global -
EqualSign Byte('=') Global -
MIME_DECODE_TABLE array [Byte] of Cardinal = ( Global -
MIME_ENCODE_TABLE array [0..63] of Byte = ( Global -


Module Source

1     {******************************************************************************}
2     {                                                                              }
3     { Project JEDI Code Library (JCL)                                              }
4     {                                                                              }
5     { The contents of this file are subject to the Mozilla Public License Version  }
6     { 1.1 (the "License"); you may not use this file except in compliance with the }
7     { License. You may obtain a copy of the License at http://www.mozilla.org/MPL/ }
8     {                                                                              }
9     { Software distributed under the License is distributed on an "AS IS" basis,   }
10    { WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for }
11    { the specific language governing rights and limitations under the License.    }
12    {                                                                              }
13    { The Original Code is XlfMime.pas.                                            }
14    {                                                                              }
15    { The Initial Developer of the Original Code is documented in the accompanying }
16    { help file JCL.chm. Portions created by these individuals are Copyright (C)   }
17    { 2000 of these individuals.                                                   }
18    {                                                                              }
19    {******************************************************************************}
20    {                                                                              }
21    { Lightening fast Mime (Base64) Encoding and Decoding routines. Coded by Ralf  }
22    { Junker (ralfjunker@gmx.de).                                                  }
23    {                                                                              }
24    { Unit owner: Marcel van Brakel                                                }
25    { Last modified: January 29, 2001                                              }
26    {                                                                              }
27    {******************************************************************************}
28    
29    unit XlfMime;
30    
31    //{$I JCL.INC}
32    
33    {$WEAKPACKAGEUNIT ON}
34    
35    interface
36    
37    uses
38      Classes, SysUtils;
39    
40    function MimeEncodeString(const S: AnsiString): AnsiString;
41    function MimeDecodeString(const S: AnsiString): AnsiString;
42    procedure MimeEncodeStream(const InputStream: TStream; const OutputStream: TStream);
43    procedure MimeDecodeStream(const InputStream: TStream; const OutputStream: TStream);
44    function MimeEncodedSize(const I: Cardinal): Cardinal;
45    function MimeDecodedSize(const I: Cardinal): Cardinal;
46    procedure MimeEncode(var InputBuffer; const InputByteCount: Cardinal; var OutputBuffer);
47    function MimeDecode(var InputBuffer; const InputBytesCount: Cardinal; var OutputBuffer): Cardinal;
48    function MimeDecodePartial(var InputBuffer; const InputBytesCount: Cardinal;
49      var OutputBuffer; var ByteBuffer: Cardinal; var ByteBufferSpace: Cardinal): Cardinal;
50    function MimeDecodePartialEnd(var OutputBuffer; const ByteBuffer: Cardinal;
51      const ByteBufferSpace: Cardinal): Cardinal;
52    
53    implementation
54    
55    // Caution: For MimeEncodeStream and all other kinds of multi-buffered
56    // Mime encodings (i.e. Files etc.), BufferSize must be set to a multiple of 3.
57    // Even though the implementation of the Mime decoding routines below
58    // do not require a particular buffer size, they work fastest with sizes of
59    // multiples of four. The chosen size is a multiple of 3 and of 4 as well.
60    // The following numbers are, in addition, also divisible by 1024:
61    // $2400, $3000, $3C00, $4800, $5400, $6000, $6C00.
62    
63    const
64      BUFFER_SIZE = $3000;
65      EqualSign = Byte('=');
66    
67      MIME_ENCODE_TABLE: array [0..63] of Byte = (
68         65,  66,  67,  68,  69,  70,  71,  72,  // 00 - 07
69         73,  74,  75,  76,  77,  78,  79,  80,  // 08 - 15
70         81,  82,  83,  84,  85,  86,  87,  88,  // 16 - 23
71         89,  90,  97,  98,  99, 100, 101, 102,  // 24 - 31
72        103, 104, 105, 106, 107, 108, 109, 110,  // 32 - 39
73        111, 112, 113, 114, 115, 116, 117, 118,  // 40 - 47
74        119, 120, 121, 122,  48,  49,  50,  51,  // 48 - 55
75         52,  53,  54,  55,  56,  57,  43,  47); // 56 - 63
76    
77      MIME_DECODE_TABLE: array [Byte] of Cardinal = (
78        255, 255, 255, 255, 255, 255, 255, 255, //  00 -  07
79        255, 255, 255, 255, 255, 255, 255, 255, //  08 -  15
80        255, 255, 255, 255, 255, 255, 255, 255, //  16 -  23
81        255, 255, 255, 255, 255, 255, 255, 255, //  24 -  31
82        255, 255, 255, 255, 255, 255, 255, 255, //  32 -  39
83        255, 255, 255,  62, 255, 255, 255,  63, //  40 -  47
84         52,  53,  54,  55,  56,  57,  58,  59, //  48 -  55
85         60,  61, 255, 255, 255, 255, 255, 255, //  56 -  63
86        255,   0,   1,   2,   3,   4,   5,   6, //  64 -  71
87          7,   8,   9,  10,  11,  12,  13,  14, //  72 -  79
88         15,  16,  17,  18,  19,  20,  21,  22, //  80 -  87
89         23,  24,  25, 255, 255, 255, 255, 255, //  88 -  95
90        255,  26,  27,  28,  29,  30,  31,  32, //  96 - 103
91         33,  34,  35,  36,  37,  38,  39,  40, // 104 - 111
92         41,  42,  43,  44,  45,  46,  47,  48, // 112 - 119
93         49,  50,  51, 255, 255, 255, 255, 255, // 120 - 127
94        255, 255, 255, 255, 255, 255, 255, 255,
95        255, 255, 255, 255, 255, 255, 255, 255,
96        255, 255, 255, 255, 255, 255, 255, 255,
97        255, 255, 255, 255, 255, 255, 255, 255,
98        255, 255, 255, 255, 255, 255, 255, 255,
99        255, 255, 255, 255, 255, 255, 255, 255,
100       255, 255, 255, 255, 255, 255, 255, 255,
101       255, 255, 255, 255, 255, 255, 255, 255,
102       255, 255, 255, 255, 255, 255, 255, 255,
103       255, 255, 255, 255, 255, 255, 255, 255,
104       255, 255, 255, 255, 255, 255, 255, 255,
105       255, 255, 255, 255, 255, 255, 255, 255,
106       255, 255, 255, 255, 255, 255, 255, 255,
107       255, 255, 255, 255, 255, 255, 255, 255,
108       255, 255, 255, 255, 255, 255, 255, 255,
109       255, 255, 255, 255, 255, 255, 255, 255);
110   
111   type
112     PByte4 = ^TByte4;
113     TByte4 = packed record
114       B1: Byte;
115       B2: Byte;
116       B3: Byte;
117       B4: Byte;
118     end;
119   
120     PByte3 = ^TByte3;
121     TByte3 = packed record
122       B1: Byte;
123       B2: Byte;
124       B3: Byte;
125     end;
126   
127   //------------------------------------------------------------------------------
128   // Wrapper functions & procedures
129   //------------------------------------------------------------------------------
130   
131   function MimeEncodeString(const S: AnsiString): AnsiString;
132   var
133     L: Cardinal;
134   begin
135     L := Length(S);
136     if L > 0 then
137     begin
138       SetLength(Result, MimeEncodedSize(L));
139       MimeEncode(PChar(S)^, L, PChar(Result)^);
140     end
141     else
142       Result := '';
143   end;
144   
145   //------------------------------------------------------------------------------
146   
147   function MimeDecodeString(const S: AnsiString): AnsiString;
148   var
149     ByteBuffer, ByteBufferSpace: Cardinal;
150     L: Cardinal;
151   begin
152     L := Length(S);
153     if L > 0 then
154     begin
155       SetLength(Result, MimeDecodedSize(L));
156       ByteBuffer := 0;
157       ByteBufferSpace := 4;
158       L := MimeDecodePartial(PChar(S)^, L, PChar(Result)^, ByteBuffer, ByteBufferSpace);
159       Inc(L, MimeDecodePartialEnd(PChar(Cardinal(Result) + L)^, ByteBuffer, ByteBufferSpace));
160       SetLength(Result, L);
161     end;
162   end;
163   
164   //------------------------------------------------------------------------------
165   
166   procedure MimeEncodeStream(const InputStream: TStream; const OutputStream: TStream);
167   var
168     InputBuffer: array [0..BUFFER_SIZE - 1] of Byte;
169     OutputBuffer: array [0..((BUFFER_SIZE + 2) div 3) * 4 - 1] of Byte;
170     BytesRead: Integer;
171   begin
172     BytesRead := InputStream.Read(InputBuffer, SizeOf(InputBuffer));
173     while BytesRead > 0 do
174     begin
175       MimeEncode(InputBuffer, BytesRead, OutputBuffer);
176       OutputStream.Write(OutputBuffer, MimeEncodedSize(BytesRead));
177       BytesRead := InputStream.Read(InputBuffer, SizeOf(InputBuffer));
178     end;
179   end;
180   
181   //------------------------------------------------------------------------------
182   
183   procedure MimeDecodeStream(const InputStream: TStream; const OutputStream: TStream);
184   var
185     ByteBuffer, ByteBufferSpace: Cardinal;
186     InputBuffer: array [0..(BUFFER_SIZE + 3) div 4 * 3 - 1] of Byte;
187     OutputBuffer: array [0..BUFFER_SIZE - 1] of Byte;
188     BytesRead: Integer;
189   begin
190     ByteBuffer := 0;
191     ByteBufferSpace := 4;
192     BytesRead := InputStream.Read(InputBuffer, SizeOf(InputBuffer));
193     while BytesRead > 0 do
194     begin
195       OutputStream.Write(OutputBuffer, MimeDecodePartial(InputBuffer, BytesRead, OutputBuffer, ByteBuffer, ByteBufferSpace));
196       BytesRead := InputStream.Read(InputBuffer, SizeOf(InputBuffer));
197     end;
198     OutputStream.Write(OutputBuffer, MimeDecodePartialEnd(OutputBuffer, ByteBuffer, ByteBufferSpace));
199   end;
200   
201   //------------------------------------------------------------------------------
202   // Helper functions
203   //------------------------------------------------------------------------------
204   
205   function MimeEncodedSize(const I: Cardinal): Cardinal;
206   begin
207     Result := (I + 2) div 3 * 4;
208   end;
209   
210   //------------------------------------------------------------------------------
211   
212   function MimeDecodedSize(const I: Cardinal): Cardinal;
213   begin
214     Result := (I + 3) div 4 * 3;
215   end;
216   
217   //------------------------------------------------------------------------------
218   // Primary functions & procedures
219   //------------------------------------------------------------------------------
220   
221   procedure MimeEncode(var InputBuffer; const InputByteCount: Cardinal; var OutputBuffer);
222   var
223     B: Cardinal;
224     InMax3: Cardinal;
225     InPtr, InLimitPtr: ^Byte;
226     OutPtr: PByte4;
227   begin
228     if InputByteCount <= 0 then
229       Exit;
230   
231     InPtr := @InputBuffer;
232     InMax3 := InputByteCount div 3 * 3;
233     OutPTr := @OutputBuffer;
234     Cardinal(InLimitPtr) := Cardinal(InPtr) + InMax3;
235   
236     while InPtr <> InLimitPtr do
237     begin
238       B := InPtr^;
239       B := B shl 8;
240       Inc(InPtr);
241       B := B or InPtr^;
242       B := B shl 8;
243       Inc(InPtr);
244       B := B or InPtr^;
245       Inc(InPtr);
246       // Write 4 bytes to OutputBuffer (in reverse order).
247       OutPtr.B4 := MIME_ENCODE_TABLE[B and $3F];
248       B := B shr 6;
249       OutPtr.B3 := MIME_ENCODE_TABLE[B and $3F];
250       B := B shr 6;
251       OutPtr.B2 := MIME_ENCODE_TABLE[B and $3F];
252       B := B shr 6;
253       OutPtr.B1 := MIME_ENCODE_TABLE[B];
254       Inc(OutPtr);
255     end;
256   
257     case InputByteCount - InMax3 of
258       1:
259         begin
260           B := InPtr^;
261           B := B shl 4;
262           OutPtr.B2 := MIME_ENCODE_TABLE[B and $3F];
263           B := B shr 6;
264           OutPtr.B1 := MIME_ENCODE_TABLE[B];
265           OutPtr.B3 := EqualSign; // Fill remaining 2 bytes.
266           OutPtr.B4 := EqualSign;
267         end;
268       2:
269         begin
270           B := InPtr^;
271           Inc(InPtr);
272           B := B shl 8;
273           B := B or InPtr^;
274           B := B shl 2;
275           OutPtr.B3 := MIME_ENCODE_TABLE[B and $3F];
276           B := B shr 6;
277           OutPTr.b2 := MIME_ENCODE_TABLE[B and $3F];
278           B := B shr 6;
279           OutPtr.B1 := MIME_ENCODE_TABLE[B];
280           OutPtr.B4 := EqualSign; // Fill remaining byte.
281         end;
282     end;
283   end;
284   
285   //------------------------------------------------------------------------------
286   
287   function MimeDecode(var InputBuffer; const InputBytesCount: Cardinal; var OutputBuffer): Cardinal;
288   var
289     ByteBuffer, ByteBufferSpace: Cardinal;
290     ob: pchar;
291   begin
292     ByteBuffer := 0;
293     ByteBufferSpace := 4;
294     Result := MimeDecodePartial(InputBuffer, InputBytesCount, OutputBuffer, ByteBuffer, ByteBufferSpace);
295     ob := @OutputBuffer;
296     inc(ob,integer(Result));
297     //Inc(Result, MimeDecodePartialEnd(PChar(Cardinal(OutputBuffer) + Result)^, ByteBuffer, ByteBufferSpace));
298     Inc(Result, MimeDecodePartialEnd(ob^, ByteBuffer, ByteBufferSpace));
299   end;
300   
301   //------------------------------------------------------------------------------
302   
303   function MimeDecodePartial(var InputBuffer; const InputBytesCount: Cardinal;
304     var OutputBuffer; var ByteBuffer: Cardinal; var ByteBufferSpace: Cardinal): Cardinal;
305   var
306     lByteBuffer, lByteBufferSpace, C: Cardinal;
307     InPtr, InLimitPtr: ^Byte;
308     OutPtr: PByte3;
309   begin
310     if InputBytesCount > 0 then
311     begin
312       InPtr := @InputBuffer;
313       Cardinal(InLimitPtr) := Cardinal(InPtr) + InputBytesCount;
314       OutPtr := @OutputBuffer;
315       lByteBuffer := ByteBuffer;
316       lByteBufferSpace := ByteBufferSpace;
317       while InPtr <> InLimitPtr do
318       begin
319         C := MIME_DECODE_TABLE[InPtr^]; // Read from InputBuffer.
320         Inc(InPtr);
321         if C = $FF then
322           Continue;
323   
324         lByteBuffer := lByteBuffer shl 6;
325         lByteBuffer := lByteBuffer or C;
326         Dec(lByteBufferSpace);
327         if lByteBufferSpace <> 0 then
328           Continue; // Read 4 bytes from InputBuffer?
329   
330         OutPtr.B3 := Byte(lByteBuffer); // Write 3 bytes to OutputBuffer (in reverse order).
331         lByteBuffer := lByteBuffer shr 8;
332         OutPtr.B2 := Byte(lByteBuffer);
333         lByteBuffer := lByteBuffer shr 8;
334         OutPtr.B1 := Byte(lByteBuffer);
335         lByteBuffer := 0;
336         Inc(OutPtr);
337         lByteBufferSpace := 4;
338       end;
339       ByteBuffer := lByteBuffer;
340       ByteBufferSpace := lByteBufferSpace;
341       Result := Cardinal(OutPtr) - Cardinal(@OutputBuffer);
342     end
343     else
344       Result := 0;
345   end;
346   
347   //------------------------------------------------------------------------------
348   
349   function MimeDecodePartialEnd(var OutputBuffer; const ByteBuffer: Cardinal;
350     const ByteBufferSpace: Cardinal): Cardinal;
351   var
352     lByteBuffer: Cardinal;
353   begin
354     case ByteBufferSpace of
355       1:
356         begin
357           lByteBuffer := ByteBuffer shr 2;
358           PByte3(@OutputBuffer).B2 := Byte(lByteBuffer);
359           lByteBuffer := lByteBuffer shr 8;
360           PByte3(@OutputBuffer).B1 := Byte(lByteBuffer);
361           Result := 2;
362         end;
363       2:
364         begin
365           lByteBuffer := ByteBuffer shr 4;
366           PByte3(@OutputBuffer).B1 := Byte(lByteBuffer);
367           Result := 1;
368         end;
369     else
370       Result := 0;
371     end;
372   end;
373   
374   end.

Module Calls (2 levels)

-

Module Called-By (2 levels)


        XlfMime
      XuDsigS┘ 
    uOrders┤   
     fFrame┤   
fOrdersSign┤   
    fReview┘