home *** CD-ROM | disk | FTP | other *** search
/ Freelog 11 / Freelog011.iso / BestOf / PhoenixMail / Source / phoenix / BASE64Sup.pas next >
Pascal/Delphi Source File  |  1999-01-06  |  4KB  |  170 lines
  1. {*****************************************************************************
  2.  *
  3.  *  BASE64Sup.pas - BASE 64 support  (19-July-1998)
  4.  *
  5.  *  Copyright (c) 1998-99 Michael Haller
  6.  *
  7.  *  Author:     Michael Haller
  8.  *  E-mail:     michael@discountdrive.com
  9.  *  Homepage:   http://www.discountdrive.com/sunrise/
  10.  *
  11.  *  This program is free software; you can redistribute it and/or
  12.  *  modify it under the terms of the GNU General Public License
  13.  *  as published by the Free Software Foundation;
  14.  *
  15.  *  This program is distributed in the hope that it will be useful,
  16.  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
  17.  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18.  *  GNU General Public License for more details.
  19.  *
  20.  *  You should have received a copy of the GNU General Public License
  21.  *  along with this program; if not, write to the Free Software
  22.  *  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA
  23.  *
  24.  *----------------------------------------------------------------------------
  25.  *
  26.  *  Revision history:
  27.  *
  28.  *     DATE     REV                 DESCRIPTION
  29.  *  ----------- --- ----------------------------------------------------------
  30.  *
  31.  *****************************************************************************}
  32.  
  33. unit BASE64Sup;
  34.  
  35. interface
  36.  
  37. procedure PrepareBase64Support;
  38. function StringToBase64(S: String): String;
  39. function Base64ToString(S: String): String;
  40.  
  41. implementation
  42.  
  43. var
  44.   Bit6ToBase64: array[0..63] of Byte;
  45.   Base64ToBit6: array[0..255] of SmallInt;
  46.   iEncodeInput: SmallInt;
  47.   EncodeShifter: LongInt;
  48.   iDecodeInput: SmallInt;
  49.   DecodeShifter: LongInt;
  50.  
  51. procedure Init;
  52. begin
  53.   iEncodeInput := 0;
  54.   EncodeShifter := 0;
  55.   iDecodeInput := 0;
  56.   DecodeShifter := 0;
  57. end;
  58.  
  59. function AddByteToEncode(B: Byte): Boolean;
  60. begin
  61.   Result := True;
  62.   if iEncodeInput = 3 then Exit;
  63.   EncodeShifter := EncodeShifter shl 8;
  64.   EncodeShifter := EncodeShifter or B;
  65.   Inc(iEncodeInput);
  66.   Result := (iEncodeInput = 3);
  67. end;
  68.  
  69. function GetBase64String: String;
  70. var
  71.   S: String;
  72.   I: SmallInt;
  73. begin
  74.   Result := '';
  75.   if iEncodeInput = 0 then Exit;
  76.   EncodeShifter  := EncodeShifter shl ((3-iEncodeInput)*8);
  77.   S := '';
  78.   for I := 1 to 4 do begin
  79.     S := Chr(Bit6ToBase64[EncodeShifter and $3F])+S;
  80.     EncodeShifter := EncodeShifter shr 6;
  81.   end;
  82.  
  83.   for I := iEncodeInput+2 to Length(S) do S[I] := '=';
  84.   Result := S;
  85.   EncodeShifter := 0;
  86.   iEncodeInput := 0;
  87. end;
  88.  
  89. function AddBase64ToDecode(B: Byte): Boolean;
  90. begin
  91.   Result := True;
  92.   if iDecodeInput = 4 then Exit;
  93.   B := Base64ToBit6[B];
  94.   if B > $40 then begin Result := False; Exit; end;
  95.   if B = $40 then begin B := 0; {Exit;} end;
  96.   DecodeShifter := DecodeShifter shl 6;
  97.   DecodeShifter := DecodeShifter or B;
  98.   Inc(iDecodeInput);
  99.   Result := (iDecodeInput = 4);
  100. end;
  101.  
  102. function GetByteString: String;
  103. var
  104.   S: String;
  105.   I, iDecodeOutput: SmallInt;
  106. begin
  107.   Result := '';
  108.   if iDecodeInput = 0 then Exit;
  109.   DecodeShifter  := DecodeShifter shl ((4-iDecodeInput)*6);
  110.   S := '';
  111.   for I := 1 to 3 do begin
  112.     S := Chr(DecodeShifter and $FF)+S;
  113.     DecodeShifter := DecodeShifter shr 8;
  114.   end;
  115.   iDecodeOutput := iDecodeInput;
  116.   if iDecodeOutput = 4 then iDecodeOutput := 3;
  117.   Result := '';
  118.   for I :=  1 to iDecodeOutput do
  119.     Result := Result+S[I];
  120.   DecodeShifter := 0;
  121.   iDecodeInput := 0;
  122. end;
  123.  
  124. procedure PrepareBase64Support;
  125. var
  126.   I: SmallInt;
  127. begin
  128.   for I := 0 to 25 do Bit6ToBase64[I] := Ord('A')+I;
  129.   for I := 0 to 25 do Bit6ToBase64[26+I] := Ord('a')+I;
  130.   for I := 0 to 9 do Bit6ToBase64[52+I] := Ord('0')+I;
  131.   Bit6ToBase64[62] := Ord('+');
  132.   Bit6ToBase64[63] := Ord('/');
  133.   for I := 0 to 255 do Base64ToBit6[I] := 255;
  134.   for I := 0 to 63 do Base64ToBit6[Bit6ToBase64[I]] := I;
  135.   Base64ToBit6[Ord('=')] := $40;
  136.   Init;
  137. end;
  138.  
  139. function StringToBase64(S: String): String;
  140. var
  141.   I: SmallInt;
  142.   sOut: String;
  143. begin
  144.   Init;
  145.   sOut := '';
  146.   for I := 1 to Length(S) do
  147.     if AddByteToEncode(Ord(S[I])) then
  148.       sOut := sOut+GetBase64String;
  149.   sOut := sOut+GetBase64String;
  150.   Result := sOut;
  151. end;
  152.  
  153. function Base64ToString(S: String): String;
  154. var
  155.   I: SmallInt;
  156.   sOut: String;
  157. begin
  158.   Init;
  159.   sOut := '';
  160.   for I := 1 to Length(S) do begin
  161.     if AddBase64ToDecode(Ord(S[I])) then begin
  162.       sOut := sOut+GetByteString;
  163.     end;
  164.   end;
  165.   sOut := sOut+GetByteString;
  166.   Result := sOut;
  167. end;
  168.  
  169. end.
  170.