idcoderbinhex4.pas

photo.163.com 相册下载器 多线程下载

{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  54505: IdCoderBinHex4.pas 
{
{   Rev 1.7    10/6/2004 10:47:00 PM  BGooijen
{ changed array indexer from 64 to 32 bit, it gave errors in dotnet, and making
{ >2GB arrays is not done anyways
}
{
{   Rev 1.6    2004.05.20 1:39:28 PM  czhower
{ Last of the IdStream updates
}
{
{   Rev 1.5    2004.05.20 11:37:24 AM  czhower
{ IdStreamVCL
}
{
{   Rev 1.4    2004.05.19 3:06:56 PM  czhower
{ IdStream / .NET fix
}
{
{   Rev 1.3    2004.02.03 5:45:50 PM  czhower
{ Name changes
}
{
{   Rev 1.2    1/21/2004 1:19:58 PM  JPMugaas
{ InitComponent.
}
{
{   Rev 1.1    16/01/2004 18:00:26  CCostelloe
{ This is now working code.
}
{
{   Rev 1.0    14/01/2004 00:46:14  CCostelloe
{ An implementation of Apple's BinHex4 encoding.  It is a "work-in-progress",
{ it does not yet work properly, only checked in as a placeholder.
}
unit IdCoderBinHex4;

{
Written by Ciaran Costelloe, [e-mail], December 2003.  Based on
TIdCoderMIME, derived from TIdCoder3to4, derived from TIdCoder.

DESCRIPTION:

This is an implementation of the BinHex 4.0 decoder used particularly by Apple.
It is defined in RFC 1741.  It is a variant of a 3-to-4 decoder, but it uses
character 90 for sequences of repeating characters, allowing some compression,
but thereby not allowing it to be mapped in as another 3-to-4 decoder.
Per the RFC, it must be encapsulated in a MIME part (it cannot be directly coded
inline in an email "body"), the part is strictly defined to have a header entry
(with the appropriate "myfile.ext"):
    Content-Type: application/mac-binhex40; name="myfile.ext"
After the header, the part MUST start with the text (NOT indented):
    (This file must be converted with BinHex 4.0)
This allows the option AND the ambiguity of identifying it by either the
Content-Type OR by the initial text line.  However, it is also stated that any
text before the specified text line must be ignored, implying the line does not
have to be the first - an apparent contradiction.
The encoded file then follows, split with CRLFs (to avoid lines that are too long
for emails) that must be discarded.
The file starts with a colon (:), a header, followed by the file contents, and
ending in another colon.
There is also an interesting article on the web, "BinHex 4.0 Definition by Peter
N Lewis, Aug 1991", which has very useful information on what is implemeted in
practice, and seems to come with the good provenance of bitter experience.
From RFC 1741:
--------------------------------------------------------------------
      1) 8 bit encoding of the file:

   Byte:    Length of FileName (1->63)
   Bytes:   FileName ("Length" bytes)
   Byte:    Version
   Long:    Type
   Long:    Creator
   Word:    Flags (And $F800)
   Long:    Length of Data Fork
   Long:    Length of Resource Fork
   Word:    CRC
   Bytes:   Data Fork ("Data Length" bytes)
   Word:    CRC
   Bytes:   Resource Fork ("Rsrc Length" bytes)
   Word:    CRC

      2) Compression of repetitive characters.

   ($90 is the marker, encoding is made for 3->255 characters)

   00 11 22 33 44 55 66 77   -> 00 11 22 33 44 55 66 77
   11 22 22 22 22 22 22 33   -> 11 22 90 06 33
   11 22 90 33 44            -> 11 22 90 00 33 44

   The whole file is considered as a stream of bits.  This stream will
   be divided in blocks of 6 bits and then converted to one of 64
   characters contained in a table.  The characters in this table have
   been chosen for maximum noise protection.  The format will start
   with a ":" (first character on a line) and end with a ":".
   There will be a maximum of 64 characters on a line.  It must be
   preceded, by this comment, starting in column 1 (it does not start
   in column 1 in this document):

    (This file must be converted with BinHex 4.0)

   Any text before this comment is to be ignored.

   The characters used are:

    !"#$%&'()*+,- 012345689@ABCDEFGHIJKLMNPQRSTUVXYZ[`abcdefhijklmpqr

--------------------------------------------------------------------
IMPLEMENTATION NOTES:

There are older variants referred to in RFC 1741, but I have only come
across encodings in current use as separate MIME parts, which this
implementation is targetted at.

When encoding into BinHex4, you do NOT have to implement the run-length
encoding (the character 90 for sequences of repeating characters), and
this encoder does not do it.  The CRC values generated in the header have
NOT been tested (because this decoder ignores them).

The decoder has to allow for the run-length encoding.  The decoder works
irrespective of whether it is preceded by the identification string
or not (GBinHex4IdentificationString below).  The string to be decoded must
include the starting and ending colons.  It can deal with embedded CR and LFs.
Unlike base64 and quoted-printable, we cannot decode line-by-line cleanly,
because the lines do not contain a clean number of 4-byte blocks due to the
first line starting with a colon, leaving 63 bytes on that line, plus you have
the problem of dealing with the run-length encoding and stripping the header.
If the attachment only has a data fork, it is saved; if only a resource fork,
it is saved; if both, only the data fork is saved.  The decoder does NOT
check that the CRC values are correct.

Indy units use the content-type to decide if the part is BinHex4:
    Content-Type: application/mac-binhex40; name="myfile.ext"

WARNING: This code only implements BinHex4.0 when used as a part in a
MIME-encoded email.  To have a part encoded, set the parts
ContentTransfer := 'binhex40'.

--------------------------------------------------------------------
}

interface

uses
  Classes,
  IdCoder, IdCoder3to4, IdGlobal, IdStream, IdStreamRandomAccess,
  SysUtils;

type
  TIdEncoderBinHex4 = class(TIdEncoder3to4)
  protected
    function GetCRC(ABlock: TIdBytes): word;
    procedure AddByteCRC(var ACRC: word; AByte: Byte);
    procedure InitComponent; override;
  public
    //We cannot override Encode because we need different parameters...
    procedure EncodeFile(AFileName: string; ASrcStream: TIdStreamRandomAccess; ADestStream: TIdStream);
  end;
  TIdDecoderBinHex4 = class(TIdDecoder4to3)
  protected
    procedure InitComponent; override;
  public
    procedure Decode(const AIn: string; const AStartPos: Integer = 1;
     const ABytes: Integer = -1); override;
  end;

const
  //Note the 7th characeter is a ' which is represented in a string as ''
  GBinHex4CodeTable: string = '!"#$%&''()*+,-012345689@ABCDEFGHIJKLMNPQRSTUVXYZ[`abcdefhijklmpqr';    {Do not Localize}
  GBinHex4IdentificationString: string = '(This file must be converted with BinHex 4.0)';             {Do not Localize}

type
  EIdMissingColon = class(Exception);

var
  GBinHex4DecodeTable: TIdDecodeTable;

implementation

uses
  IdException, IdResourceStrings, IdStreamVCL;

{ TIdDecoderBinHex4 }

procedure TIdDecoderBinHex4.InitComponent;
begin
  inherited;
  FDecodeTable := GBinHex4DecodeTable;
  FCodingTable := GBinHex4CodeTable;
  FFillChar := '=';  {Do not Localize}
end;

procedure TIdDecoderBinHex4.Decode(const AIn: string; const AStartPos: Integer = 1;
  const ABytes: Integer = -1);
var
  LCopyToPos: integer;
  LIn : TIdBytes;
  LOut: TIdBytes;
  LN: integer;
  LM: integer;
  LRepetition: integer;
  LForkLength: integer;
begin
  if AIn = '' then Exit;
  LIn := ToBytes(AIn);

  //We don't need to check if the identification string is present, since the
  //attachment is bounded by a : at the start and end, and the identification
  //string may have been stripped off already.
  //While we are at it, remove all the CRs and LFs...
  LCopyToPos := -1;
  for LN := 0 to Length(LIn)-1 do begin
    if LIn[LN] = 58 then begin  //Ascii 58 is a colon :
      if LCopyToPos = -1 then begin
        //This is the start of the file...
        LCopyToPos := 0;
      end else begin
        //This is the second :, i.e. the end of the file...
        SetLength(Lin, LCopyToPos);
        LCopyToPos := -2; //Flag that we got an end marker
        break;
      end;
    end else begin
      if LCopyToPos > -1 then begin
        if ((LIn[LN] <> 13) and (LIn[LN] <> 10)) then begin
          LIn[LCopyToPos] := LIn[LN];
          Inc(LCopyToPos);
        end;
      end;
    end;
  end;
  //Did we get the start and end : ?
  if LCopyToPos = -1 then begin
    //We did not get the initial :
    raise EIdMissingColon.Create('Block passed to TIdDecoderBinHex4.Decode is missing a starting colon :');    {Do not Localize}
  end else if LCopyToPos <> -2 then begin
    //We did not get the terminating :
    raise EIdMissingColon.Create('Block passed to TIdDecoderBinHex4.Decode is missing a terminating colon :'); {Do not Localize}
  end;

  if Length(LIn) = 0 then Exit;
  LOut := InternalDecode(LIn, AStartPos, ABytes);

  //Now expand the run-length encoding.