KOLIndy/myindy/IdCoderText.pas

   1 // 25-nov-2002
   2 unit IdCoderText;
   3
   4 interface
   5
   6 uses KOL { ,
   7   Classes } ,
   8   IdCoder;
   9
  10 type
  11   TIdQuotedPrintableEncoder = object(TIdCoder)
  12   protected
  13     FQPOutputString: string;
  14     procedure QPOutput(const sOut: string); virtual;
  15     function ToQuotedPrintable(const b: Byte): string;
  16     procedure Coder; virtual;//override;
  17     procedure CompleteCoding; virtual;//override;
  18
  19   public
  20      { constructor Create(AOwner: TComponent); override;
  21      } destructor Destroy;
  22
  23      virtual; procedure Reset; virtual;//override;
  24   end;
  25 PIdQuotedPrintableEncoder=^TIdQuotedPrintableEncoder;
  26 function NewIdQuotedPrintableEncoder(AOwner: PControl):PIdQuotedPrintableEncoder;
  27 type
  28
  29   TIdQuotedPrintableDecoder = object(TIdCoder)
  30   protected
  31     fQPTriple: string;
  32     fInTriple: Byte;
  33     procedure Coder; virtual;//override;
  34     procedure CompleteCoding; virtual;//override;
  35   public
  36      { constructor Create(AOwner: TComponent); override;
  37      } destructor Destroy;
  38
  39      virtual; procedure Reset; virtual;//override;
  40   end;
  41 PIdQuotedPrintableDecoder=^TIdQuotedPrintableDecoder;
  42 function NewIdQuotedPrintableDecoder(AOwner: PControl):PIdQuotedPrintableDecoder;
  43
  44 implementation
  45
  46 uses
  47   IdGlobal;
  48
  49 const
  50   QPLowBound = 32;
  51   QPMidBound = 61;
  52   QPHighBound = 126;
  53   QPEDBDIC = '!"#$@[\]^`{|}~';
  54
  55   function NewIdQuotedPrintableEncoder(AOwner: PControl):PIdQuotedPrintableEncoder;
  56   //constructor TIdQuotedPrintableEncoder.Create;
  57 begin
  58 //  inherited Create(AOwner);
  59   New( Result, Create );
  60 with Result^ do
  61 begin
  62   fAddCRLF := False;
  63   FQPOutputString := '';
  64 end;
  65 end;
  66
  67 destructor TIdQuotedPrintableEncoder.Destroy;
  68 begin
  69   inherited;
  70 end;
  71
  72 procedure TIdQuotedPrintableEncoder.Reset;
  73 begin
  74   FQPOutputString := '';
  75 end;
  76
  77 procedure TIdQuotedPrintableEncoder.Coder;
  78 var
  79   i: LongWord;
  80   b: Byte;
  81   s: string;
  82 begin
  83   s := '';
  84   i := 1;
  85   while i <= FCBufferSize do
  86   begin
  87     b := Byte(FCBuffer[i]);
  88     if (b >= QPLowBound) and (b <= QPHighBound) then
  89     begin
  90       if b = QPMidBound then
  91       begin
  92         s := s + ToQuotedPrintable(QPMidBound);
  93       end
  94       else
  95         if IndyPos(Char(b), QPEDBDIC) > 0 then
  96       begin
  97         s := s + ToQuotedPrintable(b);
  98       end
  99       else
 100       begin
 101         s := s + Char(b);
 102       end;
 103     end
 104     else
 105     begin
 106       if b = Byte(CR) then
 107       begin
 108         if i < FCBufferSize then
 109         begin
 110           if FCBuffer[i + 1] = LF then
 111           begin
 112             s := s + EOL;
 113             Inc(i);
 114           end
 115           else
 116           begin
 117             s := s + ToQuotedPrintable(b);
 118           end;
 119         end
 120         else
 121         begin
 122           FCBufferedData := 1;
 123           FCBuffer[1] := Char(b);
 124           QPOutput(s);
 125           Exit;
 126         end;
 127       end
 128       else
 129       begin
 130         s := s + ToQuotedPrintable(b);
 131       end;
 132     end;
 133     Inc(i);
 134   end;
 135   QPOutput(s);
 136   FCBufferedData := 0;
 137 end;
 138
 139 procedure TIdQuotedPrintableEncoder.QPOutput;
 140 var
 141   s: string;
 142   i: LongWord;
 143 begin
 144   FQPOutputString := FQPOutputString + sOut;
 145   i := IndyPos(EOL, FQPOutputString);
 146   while i > 0 do
 147   begin
 148     s := Copy(FQPOutputString, 1, i - 1);
 149     FQPOutputString := Copy(FQPOutputString, i + 2, length(FQPOutputString));
 150     i := length(s);
 151     if i > 0 then
 152     begin
 153       case s[i] of
 154         ' ', TAB:
 155           begin
 156             s := s + Copy(ToQuotedPrintable(Byte(s[i])), 2, 2);
 157             s[i] := '=';
 158           end;
 159       else
 160         s := s + CR + LF;
 161       end;
 162     end
 163     else
 164     begin
 165       s := CR + LF;
 166     end;
 167     OutputString(s);
 168     i := IndyPos(EOL, FQPOutputString);
 169   end;
 170   while length(FQPOutputString) > 75 do
 171   begin
 172     if FQPOutputString[73] = '=' then
 173     begin
 174       i := 72;
 175     end
 176     else
 177       if FQPOutputString[74] = '=' then
 178     begin
 179       i := 73;
 180     end
 181     else
 182       if FQPOutputString[75] = '=' then
 183     begin
 184       i := 74;
 185     end
 186     else
 187     begin
 188       i := 75;
 189     end;
 190     OutputString(Copy(FQPOutputString, 1, i) + '=');
 191     FQPOutputString := Copy(FQPOutputString, i + 1, length(FQPOutputString));
 192   end;
 193 end;
 194
 195 procedure TIdQuotedPrintableEncoder.CompleteCoding;
 196 var
 197   i, j: LongWord;
 198 begin
 199   fInCompletion := True;
 200   i := FCBufferSize;
 201 //  InternSetBufferSize(FCBufferedData);
 202   FCBufferedData := FCBufferSize;
 203   if FCBufferedData > 0 then
 204   begin
 205     Coder;
 206   end;
 207   if FCBufferedData > 0 then
 208   begin
 209     QPOutput(ToQuotedPrintable(13));
 210   end;
 211   j := Length(FQPOutputString);
 212   if j > 0 then
 213   begin
 214     case FQPOutputString[j] of
 215       ' ', TAB:
 216         begin
 217           FQPOutputString := FQPOutputString + Copy(ToQuotedPrintable(
 218             Byte(FQPOutputString[j])), 2, 2);
 219           FQPOutputString[j] := '=';
 220         end;
 221     end;
 222     while length(FQPOutputString) > 75 do
 223     begin
 224       if FQPOutputString[73] = '=' then
 225       begin
 226         i := 72;
 227       end
 228       else
 229         if FQPOutputString[74] = '=' then
 230       begin
 231         i := 73;
 232       end
 233       else
 234         if FQPOutputString[75] = '=' then
 235       begin
 236         i := 74;
 237       end
 238       else
 239       begin
 240         i := 75;
 241       end;
 242       OutputString(Copy(FQPOutputString, 1, i) + '=');
 243       FQPOutputString := Copy(FQPOutputString, i + 1, length(FQPOutputString));
 244     end;
 245     OutputString(FQPOutputString);
 246   end;
 247 //  InternSetBufferSize(i);
 248   FCBufferedData := 0;
 249 end;
 250
 251 function TIdQuotedPrintableEncoder.ToQuotedPrintable;
 252 begin
 253   result := '=' + UpperCase(Int2Hex(b, 2));
 254 end;
 255
 256 function NewIdQuotedPrintableDecoder(AOwner: PControl):PIdQuotedPrintableDecoder;
 257 //constructor TIdQuotedPrintableDecoder.Create;
 258 begin
 259 //  inherited Create(AOwner);
 260   New( Result, Create );
 261 with Result^ do
 262 begin
 263   fQPTriple := '';
 264   SetLength(fQPTriple, 2);
 265   UniqueString(fQPTriple);
 266   fAddCRLF := False;
 267   fInTriple := 0;
 268 end;
 269 end;
 270
 271 destructor TIdQuotedPrintableDecoder.Destroy;
 272 begin
 273   inherited;
 274 end;
 275
 276 procedure TIdQuotedPrintableDecoder.Reset;
 277 begin
 278   fAddCRLF := False;
 279   fInTriple := 0;
 280 end;
 281
 282 procedure TIdQuotedPrintableDecoder.Coder;
 283 var
 284   i: LongWord;
 285   s: string;
 286   c: Char;
 287
 288   function IsHex(c: Char): Boolean;
 289   begin
 290     case c of
 291       '0'..'9', 'a'..'f', 'A'..'F':
 292         begin
 293           result := true;
 294         end;
 295     else
 296       result := False;
 297     end;
 298   end;
 299
 300 begin
 301   i := 1;
 302   s := '';
 303   while i <= FCBufferedData do
 304   begin
 305     c := FCBuffer[i];
 306     if fInTriple > 0 then
 307     begin
 308       fQPTriple[fInTriple] := c;
 309       Inc(fInTriple);
 310
 311       if fInTriple >= 3 then
 312       begin
 313         if IsHex(fQPTriple[1]) and IsHex(fQPTriple[2]) then
 314         begin
 315           s := s + Chr(Str2Int('$' + fQPTriple));
 316         end
 317         else
 318           if (fQPTriple[1] = CR) and (fQPTriple[2] = LF) then
 319         begin
 320         end
 321         else
 322         begin
 323           s := s + '=' + fQPTriple;
 324         end;
 325         fInTriple := 0;
 326       end;
 327     end
 328     else
 329       if c = '=' then
 330     begin
 331       Inc(fInTriple);
 332     end
 333     else
 334     begin
 335       s := s + c;
 336     end;
 337     Inc(i);
 338   end;
 339   OutputString(s);
 340   FCBufferedData := 0;
 341 end;
 342
 343 procedure TIdQuotedPrintableDecoder.CompleteCoding;
 344 begin
 345   fInCompletion := True;
 346   Coder;
 347   if fInTriple > 0 then
 348   begin
 349     OutputString(Copy(fQPTriple, 1, fInTriple - 1));
 350     FCBufferedData := 0;
 351   end;
 352 end;
 353
 354 initialization
 355 {  RegisterCoderClass(TIdQuotedPrintableEncoder, CT_CREATION, CP_STANDARD,
 356     '', 'quoted-printable');
 357   RegisterCoderClass(TIdQuotedPrintableDecoder, CT_REALISATION, CP_STANDARD,
 358     '', 'quoted-printable');}
 359 end.