{$IFDEF WtrGate}{$IFDEF UseOvr}{$O+,F+}{$ENDIF}{$ENDIF}
UNIT Decode;

{$i platform.inc}

{ this routine is used to decode files from the internal format without  }
{ modifying the internal message. When import the message into a message }
{ base, you call ExtractFile for each line you want to process. It can   }
{ either be on disk or in the swapfile. This routine returns the line    }
{ you have to import into the message base in Regel. If it has found an  }
{ enclosed file, it extracts it, writes it to disk and returns TRUE,     }
{ which means that you have to attach the file. The path to the file is  }
{ in ExtractedPath.                                                      }
{ Before starting to call ExtractFile, you have to set ExtractPath to    }
{ the directory where you want to store the extracted files.             }
{ This routines automatically updates EenRegelPtr so it points to the    }
{ next line.                                                             }


INTERFACE

USES Msgs;

CONST BINHEX_HEADER = '(This file must be converted with BinHex 4.0)';

TYPE Decode_AttachFile_Proc = PROCEDURE (Path,OriginalName : STRING);

{ for MIME encoded headers }
PROCEDURE DecodeAttachedFiles (Path : STRING; AttachProc : Decode_AttachFile_Proc);
FUNCTION  DecodeMimeQP (Regel : STRING) : STRING;
FUNCTION  DecodeMimeBase64 (Line : STRING) : STRING;


IMPLEMENTATION

USES Ramon,
     Dos,
     SwapMem,
     Logs,
     Fido,
     Language,
     Globals;

TYPE ChSetType = STRING[64];

CONST XXChars : ChSetType = '+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
      UUChars : ChSetType = '`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
      Base64  : ChSetType = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
      BinHex  : ChSetType = '!"#$%&''()*+,-012345689@ABCDEFGHIJKLMNPQRSTUVXYZ[`abcdefhijklmpqr';

TYPE StateType = (dsFindStart1,             { 0 }
                  dsFindStart2,             { 1 }
                  dsCheckXXUUType,          { 2 }
                  dsDecodeUUXX,             { 3 }
                  dsPostUUXX,               { 4 }
                  dsMimeHeader,             { 5 }
                  dsMimeInit64,             { 6 }
                  dsMimeBase64,             { 7 }
                  dsMimePlain,              { 8 }
                  dsMimeQP,                 { 9 }
                  dsBinHexHeader1,          { 10 }
                  dsBinHexHeader2,          { 11 }
                  dsDecodeBinHex,           { 12 }
                  dsAbort                   { 13 }
                  );

VAR ContainedAFile  : BOOLEAN;
    AttachFileProc  : Decode_AttachFile_Proc;
    AttachFilePath  : STRING;
    DecodeState     : StateType;
    Decode_HalfLine : STRING;
    OriginalName    : STRING;
    DecodeFilename  : STRING;
    FileIsOpen      : BOOLEAN;
    DecodeFile      : FILE;
    DecodeFileSize  : LONGINT;
    Ch2Byte         : ARRAY[0..255] OF BYTE;

{--------------------------------------------------------------------------}
{ CreateDecodeFile                                                         }
{                                                                          }
{ This routine is called with the extracted filename, containing possible  }
{ paths as well. We remove the paths here and try to create the file with  }
{ a unique filename in the given decode directory. If anything goes wrong, }
{ we return FALSE.                                                         }
{                                                                          }
FUNCTION CreateDecodeFile (Filename : STRING) : BOOLEAN;

VAR Search       : SearchRec;
    Dir          : DirStr;
    Name         : NameStr;
    Ext          : ExtStr;
    IORes        : BYTE;

BEGIN
     { kijk of deze file al bestaat. Zoja, dan verzinnen we een }
     { andere naam.                                             }

     { RAWI 990822: plain Base64 encoded body (not an attachment) ends }
     { up here without a filename. Fix a filename.                     }
     IF (Filename = '') THEN
     BEGIN
          LogMessage (liReport,'[CreateDecodeFile] No filename! SEND EXAMPLE!');
          Filename:='NONAME.ATT';
     END;

     OriginalName:=Filename; { assume verandert en afdrukken }

     { RWI 960830: Strip paden, illegale tekens en te lange namen }
     Filename:=FilenameTo83 (Filename);

     { find a unique name (using ~1 etc.) }
     DecodeFilename:=FilenameTo83Instance (AttachFilePath,Filename);

     REPEAT
           FindFirst (DecodeFilename,saJustFiles,Search);
           IF (DosError = 0) THEN
           BEGIN
                { something went wrong - take a random name instead }
                FindClose (Search);
                FSplit (DecodeFilename,Dir,Name,Ext);
                DecodeFilename:=AttachFilePath+UpCaseString (GetFidoPktName)+Ext; { keep same extension }
                Continue; { nog een keer! }
           END;
     UNTIL (DosError <> 0);

     FindClose (Search);

     IF (AttachFilePath+OriginalName = DecodeFilename) THEN
        OriginalName:='';

     Assign (DecodeFile,DecodeFilename);
     {$I-} ReWrite (DecodeFile,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'[Decode] Error creating '+DecodeFilename);
          DecodeFilename:='';   { RWI 960608 }
          CreateDecodeFile:=FALSE;
     END ELSE
     BEGIN
          {$IFDEF LogFileIO}PostOpenF (DecodeFile);{$ENDIF}
          CreateDecodeFile:=TRUE;
          FileIsOpen:=TRUE;
          LogMessage (liTrivial,'Extracting '+DecodeFilename);
     END;
END;


{--------------------------------------------------------------------------}
{ CloseDecodeFile                                                          }
{                                                                          }
{ This routine closes the DecodeFile if it is open. It also calls the      }
{ AttachFile procedure so it gets attached to a message base or written to }
{ the outbound holding file.                                               }
{                                                                          }
PROCEDURE CloseDecodeFile;

VAR IORes : BYTE;

BEGIN
     IF FileIsOpen THEN
     BEGIN
          DecodeFileSize:=FileSize (DecodeFile);

          {$IFDEF LogFileIO}PreCloseF (DecodeFile);{$ENDIF}
          {$I-} Close (DecodeFile); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
          BEGIN
               { there is no good way to handle this }
               LogDiskIOError (IORes,'Error closing '+DecodeFilename);
          END;

          FileIsOpen:=FALSE;

          IF (@AttachFileProc <> NIL) THEN
             AttachFileProc (DecodeFilename,OriginalName);

          ContainedAFile:=TRUE; { for updating PartStatus }
     END;
END;


{--------------------------------------------------------------------------}
{ BuildAttachmentInfo                                                      }
{                                                                          }
{ This routine returns the string that can be stored in the AttachmentInfo }
{ variable in the TopRegelRecord block. This information is added in the   }
{ message when the message is stored.                                      }
{ This routine writes the same info it returns to the logfile.             }
{ OriginalName contains the filename as taken from the message, but is     }
{              empty if it equals the DecodeFilename (not in upper/lower). }
{ DecodedFilename contains the path plus filename where the file now is.   }
{                                                                          }
FUNCTION BuildAttachmentInfo : STRING;

VAR Filename : STRING;
    Info     : STRING;

BEGIN
     { Original          Decode            Result                   }
     { ----------------- ----------------- ------------------------ }
     { ''                D:\DEC\A.ZIP      Extracted file: A.ZIP    }
     { a.zip             D:\DEC\A.ZIP      Extracted file: a.zip    }
     { a.zip             D:\DEC\A~1.ZIP    E.file: a.zip as A~1.ZIP }

     { remove the path from the DecodeFilename }
     Filename:=DecodeFilename;
     WHILE (Pos ('\',Filename) > 0) DO
           Delete (Filename,1,Pos ('\',Filename));

     IF (OriginalName = '') THEN
     BEGIN
          { Extracted file: @1@ }
          Info:=GetLang1 (203,Filename);
     END ELSE
     BEGIN
          { check for case 2 }
          IF (AttachFilePath+UpCaseString (OriginalName) = DecodeFilename) THEN
             Info:=GetLang1 (203,OriginalName)
          ELSE
              Info:=GetLang1 (203,OriginalName)+' '+GetLang1 (204,Filename);
     END;

     Info:=Info+' (';

     IF (DecodeFileSize < 25000) THEN
        Info:=Info+GetLang1 (205,Longint2String (DecodeFileSize))
     ELSE
         Info:=Info+GetLang1 (206,Longint2String (Round (DecodeFileSize/1024)));

     Info:=Info+')';

     LogMessage (liTrivial,Info);

     Info:='*** '+Info; { lege regel erachter }

     BuildAttachmentInfo:=Info;
END;


{--------------------------------------------------------------------------}
{ HandleBeginLine                                                          }
{                                                                          }
{ This routine extract the filename from the "begin nnn.." line and        }
{ creates it in the decode directory. If something goes wrong, FALSE is    }
{ returned and the decoding should be aborted.                             }
{                                                                          }
FUNCTION HandleBeginLine (OrigRegel : STRING) : BOOLEAN;

VAR Line : STRING;

BEGIN
     HandleBeginLine:=FALSE; { assume failure }

     Line:=OrigRegel;

     { remove "begin " }
     Delete (Line,1,6);

     { remove "nnn[n]" }
     WHILE (Line[1] IN ['0'..'7']) DO
           Delete (Line,1,1);

     { check for the space }
     IF (Line[1] <> ' ') THEN
     BEGIN
          LogMessage (liGeneral,'Invalid format in "'+OrigRegel+'"');
          Exit; { with FALSE: abort }
     END;

     { remove the space }
     Delete (Line,1,1);

     { rest is the filename, including the path }
     HandleBeginLine:=CreateDecodeFile (Line);
END;


{--------------------------------------------------------------------------}
{ InitCh2Byte                                                              }
{                                                                          }
{ This routine initialises the Ch2Byte array with the given set of decode  }
{ characters (UU, XX or Base64).                                           }
{                                                                          }
PROCEDURE InitCh2Byte (ChSet : ChSetType);

VAR Lp : BYTE;

BEGIN
     FOR Lp:=0 TO 255 DO
         Ch2Byte[Lp]:=255;

     FOR Lp:=1 TO Length (ChSet) DO
         Ch2Byte[Ord (ChSet[Lp])]:=Lp-1;
END;


{--------------------------------------------------------------------------}
{ AbortDecoding                                                            }
{                                                                          }
{ This routine is called when something goes wrong during decoding. This   }
{ routine closes the open file and deletes it.                             }
{                                                                          }
PROCEDURE AbortDecoding;

VAR IORes : BYTE;

BEGIN
     {## what more?}
     LogMessage (liReport,'AbortDecoding not complete yet!');

     LogMessage (liFatal,'Aborting decoding');

     IF FileIsOpen THEN
     BEGIN
          {$IFDEF LogFileIO}PreCloseF (DecodeFile);{$ENDIF}
          {$I-} Close (DecodeFile); {$I+} IORes:=IOResult;
          IF (IORes <> 0) THEN
             LogDiskIOError (IORes,'Error closing '+DecodeFilename)
          ELSE BEGIN
               {$I-} Erase (DecodeFile); {$I+} IORes:=IOResult;
               IF (IORes <> 0) THEN
                  LogDiskIOError (IORes,'Error deleting '+DecodeFilename);
          END;

          FileIsOpen:=FALSE;
     END;

     { reset a bunch? }
     { can do but caller already aborts the line processing loop }
END;


TYPE MimeEncodingType = (meUnknown,
                         meBase64,
                         me7bit,
                         me8bit,
                         meQuotedPrintable,
                         meXUUencode);

VAR MimeEncoding : MimeEncodingType;
    MimeFilename : STRING;
    MimeAttached : BOOLEAN; { TRUE if it has a "attachment" disposition }

{--------------------------------------------------------------------------}
{ DecodeMimeHeader_Init                                                    }
{                                                                          }
{ This routine resets the variables involved in processing MIME headers    }
{ and continuation headers.                                                }
{                                                                          }
PROCEDURE DecodeMimeHeader_Init;
BEGIN
     MimeEncoding:=meUnknown;
     MimeFilename:='';
     MimeAttached:=FALSE;
END;


{--------------------------------------------------------------------------}
{ DecodeMimeHeader_Process                                                 }
{                                                                          }
{ This routine is called with a Content-* header or ANY continuation       }
{ header. In multi-part headers, this is not really a problem. For single- }
{ part MIME headers, only continuation headers of Content-* headers will   }
{ be sent here.                                                            }
{ This routine interprets the headers, extracts the MIME variables and     }
{ tries to find the encoding format and filename of the attachment.        }
{ Everything unknown to it is barfed on.                                   }
{                                                                          }
PROCEDURE DecodeMimeHeader_Process (Regel : STRING);

    {----------------------------------------------------------------------}
    { ProcessMimeParam                                                     }
    {                                                                      }
    { This routine is fed a single MIME parameter. It checks for the NAME  }
    { paramter and opens the file if found.                                }
    {                                                                      }
    PROCEDURE ProcessMimeParam (Param : STRING);

    VAR UpTest : STRING[8];
        UpLen  : BYTE;

    BEGIN
         { sometimes there are redundant variables (in different headers) }
         { both containing the same filename. We simply stick to the      }
         { first one we found.                                            }
         IF (MimeFilename <> '') THEN
            Exit;

         WHILE (Pos (#9,Param) > 0) DO
               Param[Pos (#9,Param)]:=' ';

         Param:=DeleteFrontSpaces (Param);
         UpTest:=UpCaseString (Copy (Param,1,8));

         UpLen:=0;

         IF (Copy (UpTest,1,4) = 'NAME') THEN
            UpLen:=4
         ELSE
             IF (UpTest = 'FILENAME') THEN
                Uplen:=8;

         IF (UpLen <> 0) THEN
         BEGIN
              Delete (Param,1,UpLen);
              Param:=DeleteFrontSpaces (Param);

              IF (Param[1] = '=') THEN
              BEGIN
                   Delete (Param,1,1);
                   Param:=DeleteFrontSpaces (Param);

                   IF (Pos ('"',Param) > 0) THEN
                   BEGIN
                        MimeFilename:=Copy (Param,Pos ('"',Param)+1,255);
                        { remove closing double quote }
                        IF (Pos ('"',MimeFilename) > 0) THEN
                           MimeFilename:=Copy (MimeFilename,1,Pos ('"',MimeFilename)-1);
                   END ELSE
                       { RWI 970213 }
                       MimeFilename:=Param;
              END;
         END;
    END;

{DecodeMimeHeader_Process}

VAR Hulp : STRING;

BEGIN
     IF (Regel[Length (Regel)] = #13) THEN
        Dec (Regel[0]);

     IF (UpCaseString (Copy (Regel,1,14)) = 'CONTENT-TYPE: ') THEN
     BEGIN
          Delete (Regel,1,14);
          Regel:=DeleteFrontSpaces (Regel);

          Hulp:=UpCaseString (Regel);

          { RWI 960325: now supports all type of "application/", like }
          {             application/octet-stream                      }
          {             application/zip                               }
          (* RAWI 980929: now allowing anything
          IF ((Copy (Hulp,1,12) = 'APPLICATION/') OR
              (Copy (Hulp,1,8) = 'UNKNOWN/') OR
              (Copy (Hulp,1,6) = 'IMAGE/') OR
              (Copy (Hulp,1,6) = 'BASE64')) THEN
          *)
          BEGIN
               IF (Pos (';',Regel) > 0) THEN
               BEGIN
                    Delete (Regel,1,Pos (';',Regel));
                    Regel:=DeleteFrontSpaces (Regel);

                    { als er nog meer argumenten op deze }
                    { regel staan, verwerk die dan.      }
                    WHILE (Regel <> '') DO
                    BEGIN
                         IF (Pos (';',Regel) > 0) THEN
                         BEGIN
                              ProcessMimeParam (Copy (Regel,1,Pos (';',Regel)));
                              Delete (Regel,1,Pos (';',Regel));
                              Regel:=DeleteFrontSpaces (Regel);
                         END ELSE
                         BEGIN
                              ProcessMimeParam (Regel);
                              Regel:='';
                         END;
                    END; { while }
               END;

          END; { application/xxx, etc. }

          { have modified Regel so must exit here }
          Exit; { ## EXIT ## }
     END; { content-type }

     { controleer op een Content-Transfer-Encoding regel }
     IF (UpCaseString (Copy (Regel,1,27)) = 'CONTENT-TRANSFER-ENCODING: ') THEN
     BEGIN
          Delete (Regel,1,27);

          IF (MimeEncoding <> meUnknown) THEN
             LogMessage (liGeneral,'Double MIME content transfer encoding information!');

          { if correct encoding found, then continue }
          IF (UpCaseString (Regel) = 'BASE64') THEN
          BEGIN
               MimeEncoding:=meBase64;
               Exit;
          END;

          IF (UpCaseString (Regel) = 'X-UUENCODE') THEN
          BEGIN
               MimeEncoding:=meXUUencode;
               Exit;
          END;

          IF (UpCaseString (Regel) = '7BIT') THEN
          BEGIN
               MimeEncoding:=me7bit;
               Exit;
          END;

          IF (UpCaseString (Regel) = '8BIT') THEN
          BEGIN
               MimeEncoding:=me7bit;
               Exit;
          END;

          IF (UpCaseString (Regel) = 'QUOTED-PRINTABLE') THEN
          BEGIN
               MimeEncoding:=meQuotedPrintable;
               Exit;
          END;

          LogMessage (liFatal,'[DecodeMIME] Unsupported encoding method: '+Regel);
          Exit;      { ## EXIT ## }
     END;

     IF (UpCaseString (Copy (Regel,1,21)) = 'CONTENT-DISPOSITION: ') THEN
     BEGIN
          Delete (Regel,1,21);
          Regel:=DeleteFrontSpaces (Regel);

          IF (UpCaseString (Copy (Regel,1,10)) = 'ATTACHMENT') THEN
          BEGIN
               Delete (Regel,1,10);
               MimeAttached:=TRUE;
          END;

          IF (Pos ('FILENAME',UpCaseString (Regel)) > 0) THEN
             MimeAttached:=TRUE;

          IF (Pos ('NAME',UpCaseString (Regel)) > 0) THEN
             MimeAttached:=TRUE;

          { zorg dat blok beneden triggert voor variables processing }
          Regel:=' '+Regel;
     END;

     { controleer op vervolg regel }
     { bijv: ' x-mac-type="705A4950"; x-mac-creator="705A4950"' }
     IF (Regel[1] = ' ') OR (Regel[1] = #9) THEN
     BEGIN
          { continuatie regel }
          WHILE (Regel <> '') DO
          BEGIN
               IF (Pos (';',Regel) > 0) THEN
               BEGIN
                    ProcessMimeParam (Copy (Regel,1,Pos (';',Regel)-1));
                    Delete (Regel,1,Pos (';',Regel));
                    Regel:=DeleteFrontSpaces (Regel);
               END ELSE
               BEGIN
                    ProcessMimeParam (Regel);
                    Regel:='';
               END;
          END; { while }
     END;
END;


(* BinHex format:                                  (maxlen)
     Byte:      Length of FileName (1->63)         1
     Bytes:     FileName ("Length" bytes)          64
     Byte:      Version                            65
     Long:      Type                               69
     Long:      Creator                            73
     Word:      Flags (And $F800)                  75
     Long:      Length of Data Fork                79
     Long:      Length of Resource Fork            83
     Word:      CRC                                85
     Bytes:     Data Fork ("Data Length" bytes)
     Word:      CRC
     Bytes:     Resource Fork ("Rsrc Length" bytes)
     Word:      CRC
*)

TYPE BinHex_InfoRecord = RECORD
                               Filename : STRING[63];

                               CASE INTEGER OF
                                    0 : (Raw : ARRAY[1..21] OF BYTE);

                                    1 : (Version  : BYTE;
                                         LongType : ARRAY[1..4] OF CHAR;
                                         Creator  : ARRAY[1..4] OF CHAR;
                                         Flags    : WORD;
                                         DataLen  : LONGINT;
                                         RsrcLen  : LONGINT;
                                         CRC      : WORD;
                                         );
                         END;

TYPE BinHexState = (bhHeader,
                    bhBody);

VAR BinHex_LeftChars  : STRING[4];
    BinHex_State      : BinHexState;
    BinHex_InfoLen    : BYTE;
    BinHex_Info       : BinHex_InfoRecord;
    BinHex_RLE_Active : BOOLEAN;
    BinHex_RLE_Prev   : BYTE;
    BinHex_BodyLeft   : LONGINT;

{--------------------------------------------------------------------------}
{ DecodeBinHex_Init                                                        }
{                                                                          }
{ This routine is called when the BinHex header was found. Variables used  }
{ during the BinHex decoding are initialised here.                         }
{                                                                          }
PROCEDURE DecodeBinHex_Init;
BEGIN
     InitCh2Byte (BinHex);
     BinHex_LeftChars:='';
     BinHex_State:=bhHeader;
     BinHex_InfoLen:=0;
     BinHex_RLE_Active:=FALSE;
END;


{--------------------------------------------------------------------------}
{ DecodeBinHex_ProcessBytes                                                }
{                                                                          }
{ This routine process a number of bytes that have been decoded from the   }
{ character stream. This byte stream can still contain repeat count.       }
{ FALSE is returned when something doesn't work out as expected. Each call }
{ to this function must not deliver more than 189 bytes (255 div 4 * 3).   }
{                                                                          }
{ Run-length encoding can be applied. The character to be repeated is      }
{ first followed by a 90(hex) and a number. If the number is 0, just add   }
{ the 90(hex). If it is 1, do nothing. If it is 2, add one extra copy of   }
{ the char before the 90(hex) (we have to remember this one), etc.         }
{                                                                          }
FUNCTION DecodeBinHex_ProcessBytes (VAR Buf; Count : BYTE) : BOOLEAN;

TYPE ByteBuf = ARRAY[1..255] OF BYTE;

CONST MAXLEN_OUTBUF   = 128;
      BINHEX_RLE_CHAR = $90;

VAR OutBuf   : ARRAY[1..MAXLEN_OUTBUF] OF BYTE;
    OutCount : BYTE;
    Result   : BOOLEAN;

    PROCEDURE Flush;

    VAR IORes : BYTE;

    BEGIN
         IF (OutCount > BinHex_BodyLeft) THEN
            OutCount:=BinHex_BodyLeft;

         IF (OutCount > 0) THEN
         BEGIN
             {$I-} BlockWrite (DecodeFile,OutBuf[1],OutCount); {$I+} IORes:=IOResult;
             IF (IORes <> 0) THEN
             BEGIN
                  LogDiskIOError (IORes,'Error writing to attach file');
                  Result:=FALSE; { stop }
             END;

             Dec (BinHex_BodyLeft,OutCount);
             OutCount:=0;
         END;
    END;

    PROCEDURE Store (C : BYTE);
    BEGIN
         Inc (OutCount);
         OutBuf[OutCount]:=C;

         IF (OutCount = MAXLEN_OUTBUF) THEN
            Flush;
    END;

VAR Lp       : BYTE;
    B        : BYTE;

BEGIN
     Result:=TRUE; { no error }
     OutCount:=0;

     FOR Lp:=1 TO Count DO
         IF Result THEN
         BEGIN
              B:=ByteBuf(Buf)[Lp];

              IF BinHex_RLE_Active THEN
              BEGIN
                   { B holds the number of repeats }
                   IF (B = 0) THEN
                      Store (BINHEX_RLE_CHAR)
                   ELSE
                       WHILE (B > 1) DO
                             Store (BinHex_RLE_Prev);

                   BinHex_RLE_Active:=FALSE;
              END ELSE
                  IF (B = BINHEX_RLE_CHAR) THEN
                     { next is RLE count }
                     BinHex_RLE_Active:=TRUE
                  ELSE BEGIN
                       Store (B);
                       BinHex_RLE_Prev:=B;
                  END;
         END; { for }

     IF Result AND (OutCount > 0) THEN
        Flush;

     DecodeBinHex_ProcessBytes:=Result;
END;


{--------------------------------------------------------------------------}
{ DecodeBinHex_BuildHeader                                                 }
{                                                                          }
{ This routine is called with one byte at a time to build up the BinHex    }
{ binary header.                                                           }
{                                                                          }
FUNCTION DecodeBinHex_BuildHeader (B : BYTE) : BOOLEAN;

VAR L : BYTE;

BEGIN
     DecodeBinHex_BuildHeader:=TRUE; { assume OK }

     IF (B = $90) THEN
     BEGIN
          LogMessage (liDebug,'Unexpected run-length encoding in BinHex header ** SEND EXAMPLE **');
          DecodeBinHex_BuildHeader:=FALSE;
          Exit;
     END;

     IF (BinHex_InfoLen = 0) THEN
     BEGIN
          BinHex_Info.Filename[0]:=Char (B);
          BinHex_InfoLen:=1;

          IF NOT (B IN [1..63]) THEN
          BEGIN
               LogMessage (liFatal,'BinHex: invalid filename length: '+Byte2String (B));
               DecodeBinHex_BuildHeader:=FALSE; { error: abort }
          END;

          Exit;
     END;

     { calculate how many bytes go in the filename before the rest follows }
     L:=Byte (BinHex_Info.Filename[0]);

     IF (BinHex_InfoLen < 1+L) THEN
     BEGIN
          { fill up the filename }
          BinHex_Info.Filename[BinHex_InfoLen]:=Char (B);
          Inc (BinHex_InfoLen);
          Exit; { with TRUE: OK }
     END;

     { add to the raw block }
     BinHex_Info.Raw[BinHex_InfoLen-L]:=B;
     Inc (BinHex_InfoLen);

     { have we completed the header? }
     IF (BinHex_InfoLen = L+22) THEN
     BEGIN
          { yes! }

          WITH BinHex_Info DO
          BEGIN
               { swap the order of the DataLen }
               L:=Raw[12];
               Raw[12]:=Raw[15];
               Raw[15]:=L;

               L:=Raw[13];
               Raw[13]:=Raw[14];
               Raw[14]:=L;

               BinHex_BodyLeft:=DataLen;

               { swap the order of the RrscLen }
               L:=Raw[16];
               Raw[16]:=Raw[19];
               Raw[19]:=L;

               L:=Raw[17];
               Raw[17]:=Raw[18];
               Raw[18]:=L;

               {$IFDEF Pre}
               LogMessage (liDebug,'BinHex: DataLen = '+Longint2String (DataLen)+', RsrcLen = '+Longint2String (RsrcLen));
               {$ENDIF}
          END; { with }

          { try to create the file }
          IF (NOT CreateDecodeFile (BinHex_Info.Filename)) THEN
          BEGIN
               DecodeBinHex_BuildHeader:=FALSE;
               Exit;
          END;

          { the rest of body }
          BinHex_State:=bhBody;
     END;
END;


{--------------------------------------------------------------------------}
{ DecodeBinHex_ProcessCharStream                                           }
{                                                                          }
{ This routine is called with a set of characters and does the 6-bit to    }
{ 8-bit conversion. If something is wrong, then FALSE is returned.         }
{                                                                          }
FUNCTION DecodeBinHex_ProcessCharStream (Regel : STRING) : BOOLEAN;

VAR L           : BYTE;
    Lp          : BYTE;
    StorePos,
    GetPos      : BYTE;
    V1,V2,V3,V4 : BYTE;
    Buf         : ARRAY[1..128] OF BYTE;
    IORes       : BYTE;

BEGIN
     DecodeBinHex_ProcessCharStream:=FALSE; { assume error }

     IF (Regel[Length (Regel)] = ':') THEN
        Dec (Regel[0]);

     Regel:=BinHex_LeftChars+Regel; { max 4 chars }
     BinHex_LeftChars:='';

     { see how many blocks of 4 chars can be handled this run }
     L:=Length (Regel) DIV 4;

     IF (L*4 <> Length (Regel)) THEN
        BinHex_LeftChars:=Copy (Regel,L*4+1,4);

     GetPos:=1;
     StorePos:=1;

     FOR Lp:=1 TO L DO
     BEGIN
          V1:=Ch2Byte[Byte (Regel[GetPos+0])];
          V2:=Ch2Byte[Byte (Regel[GetPos+1])];
          V3:=Ch2Byte[Byte (Regel[GetPos+2])];
          V4:=Ch2Byte[Byte (Regel[GetPos+3])];

          IF (V1 = 255) OR (V2 = 255) OR (V3 = 255) OR (V4 = 255) THEN
          BEGIN
               {## add verification for "correct" error where }
               { V3 and V4 were taken from the #13 + whatever }
               { or ' ' and #13.                              }
               { Use Lp, L, GetPos and Len for the check.     }
               LogMessage (liFatal,'[DecodeBinHex] Error in line sequence: '+Copy (Regel,GetPos,4));
               Exit; { with FALSE: abort }
          END;

          Inc (GetPos,4);

          Buf[StorePos+0]:=(V1 SHL 2) OR ((V2 AND $30) SHR 4);
          Buf[StorePos+1]:=((V2 AND 15) SHL 4) OR ((V3 AND $3C) SHR 2);
          Buf[StorePos+2]:=((V3 AND 3) SHL 6) OR V4;

          Inc (StorePos,3);
     END; { for }

     IF (BinHex_State = bhBody) THEN
        DecodeBinHex_ProcessCharStream:=DecodeBinHex_ProcessBytes (Buf,StorePos-1)
     ELSE BEGIN
          { header processing }
          FOR Lp:=1 TO StorePos-1 DO
          BEGIN
               IF (NOT DecodeBinHex_BuildHeader (Buf[Lp])) THEN
                  Exit; { with FALSE: abort }

               { did we made the transition? }
               IF (BinHex_State = bhBody) THEN
               BEGIN
                    { yes, send the rest of the bytes to the body processor }
                    {##verify again}
                    DecodeBinHex_ProcessCharStream:=DecodeBinHex_ProcessBytes (Buf[Lp+1],StorePos-1-Lp);
                    Exit;
               END;
          END; { for }

          { reached end and not in body mode, so the header is simply not }
          { complete yet.                                                 }
          DecodeBinHex_ProcessCharStream:=TRUE; { no error }
     END; { not body }
END;


{--------------------------------------------------------------------------}
{ DecodeMimeQP                                                             }
{                                                                          }
{ This routine translates quoted printable into plain characters and       }
{ returns that. The return string is never bigger than the input string.   }
{                                                                          }
FUNCTION DecodeMimeQP (Regel : STRING) : STRING;

VAR I     : BYTE;
    Digit : CHAR;
    Getal : BYTE;

BEGIN
     { translate soft returns }
     REPEAT
           I:=Pos ('='+#13,Regel);
           IF (I > 0) THEN
              Delete (Regel,I,2);
     UNTIL (I = 0);

     I:=0;
     WHILE (Length (Regel) > 2) AND (I < Length (Regel)-2) DO
     BEGIN
          Inc (I);

          IF (Regel[I] = '=') AND
             (Regel[I+1] IN ['0'..'9','A'..'F','a'..'f']) AND
             (Regel[I+2] IN ['0'..'9','A'..'F','a'..'f']) THEN
          BEGIN
               Digit:=UpCase (Regel[I+1]);

               IF (Digit IN ['0'..'9']) THEN
                  Getal:=Ord (Digit)-Ord ('0')
               ELSE
                   IF (Digit IN ['A'..'F']) THEN
                      Getal:=Ord (Digit)-Ord ('A')+10;

               Getal:=Getal SHL 4;

               Digit:=UpCase (Regel[I+2]);

               IF (Digit IN ['0'..'9']) THEN
                  Getal:=Getal OR (Ord (Digit)-Ord ('0'))
               ELSE
                   IF (Digit IN ['A'..'F']) THEN
                      Getal:=Getal OR (Ord (Digit)-Ord ('A')+10);

               { opslaan als 8-bit data }
               Regel[I]:=Char (Getal);
               Delete (Regel,I+1,2);
          END;
     END;

     DecodeMimeQP:=Regel;
END;


{--------------------------------------------------------------------------}
{ CheckForMimeHeader                                                       }
{                                                                          }
{ This routine is called for each line in the header of a message and has  }
{ to search for MIME headers that indicate encoding. If found it calls     }
{ DecodeMimeHeader_Process.                                                }
{                                                                          }
FUNCTION CheckForMimeHeader (VAR Regel : STRING) : BOOLEAN; FAR;
BEGIN
     IF CaselessStartMatch (Regel,'Content-') THEN
        DecodeMimeHeader_Process (Regel);

     CheckForMimeHeader:=FALSE; { do not abort }
END;


{--------------------------------------------------------------------------}
{ DecideMimeDecodingState                                                  }
{                                                                          }
{ This routine decides what the next decode state is based on the          }
{ information found in the MIME headers. This routine returns TRUE if it   }
{ could not decide and decoding should be stopped.                         }
{                                                                          }
FUNCTION DecideMimeDecodingState : BOOLEAN;
BEGIN
     DecideMimeDecodingState:=FALSE;

     { end of the multi-part header reached.      }
     { check the information we got our hands on. }

     IF (MimeEncoding = meXUUencode) THEN
     BEGIN
          { check for "begin" line again }
          DecodeState:=dsFindStart2;
          Exit;
     END;

     IF (MimeEncoding = meBase64) OR
        (MimeAttached{forced as attachement}) THEN
     BEGIN
          IF (NOT CreateDecodeFile (MimeFilename)) THEN
          BEGIN
               AbortDecoding;
               DecideMimeDecodingState:=TRUE; { abort }
               Exit;
          END;

          IF (MimeEncoding = meBase64) THEN
          BEGIN
               { created file - start decoding }
               InitCh2Byte (Base64);
               Ch2Byte[Ord ('=')]:=254; { voor detectie aan het einde }
               DecodeState:=dsMimeInit64;
               Exit;
          END;

          IF (MimeEncoding IN [me7Bit,me8Bit]) THEN
          BEGIN
               DecodeState:=dsMimePlain;
               Exit;
          END;

          IF (MimeEncoding = meQuotedPrintable) THEN
          BEGIN
               DecodeState:=dsMimeQP;
               Exit;
          END;

          IF (MimeEncoding = meUnknown) THEN
          BEGIN
               LogMessage (liGeneral, '[DecideMimeState] Unsupported MIME encoding method, attempting to use ''Plain''');

               {## should we perhaps ignore this attachment?}
               DecodeState:=dsMimePlain;
               Exit;
          END;

          (* done now?
          {## add something to catch unsupported formats }
          {   so we don't end up with a 0-bytes decoded  }
          {   files as used to be the case before I inserted }
          {   meUnknown above.                               }
          *)
     END;

     { not a known attachment or encoding type }

     DecideMimeDecodingState:=TRUE; { stop }
     Exit;
END;


{--------------------------------------------------------------------------}
{ Decode_ProcessLine                                                       }
{                                                                          }
{ This routine is called for each line in the body. It runs the decode     }
{ state machine and extracts files. On the fly, it calculates the number   }
{ of bytes in the body not belonging to the extracted files. Do not modify }
{ OrigRegel!!                                                              }
{                                                                          }
FUNCTION Decode_ProcessLine (VAR OrigRegel : STRING) : BOOLEAN; FAR;

VAR L           : INTEGER;
    Len         : BYTE;
    Lp          : BYTE;
    GetPos,
    StorePos    : BYTE;
    V1,V2,V3,V4 : BYTE;
    Buf         : ARRAY[1..128] OF BYTE;
    IORes       : BYTE;
    Hulp        : STRING;

BEGIN
     Decode_ProcessLine:=FALSE; { do not abort }

     CASE DecodeState OF
          dsFindStart1,
          dsFindStart2 :
              BEGIN
                   { Find the start of a UU, XX or BASE64 encoded }
                   { file by examining the MIME headers.          }
                   { This state is only used for the first line,  }
                   { which in the UU and XX encoded case must     }
                   { contain "begin nnn[n] <filename>". If not,   }
                   { it is a MIME thing or plain text.            }
                   IF Msg.IsMime THEN
                   BEGIN
                        IF (Msg.MultiPartBoundary <> '') THEN
                        BEGIN
                             IF (OrigRegel = '--'+Msg.MultiPartBoundary+#13) THEN
                             BEGIN
                                  { Start of a multi-part header }
                                  DecodeState:=dsMimeHeader;
                                  DecodeMimeHeader_Init;
                                  Exit;
                             END;

                             IF (OrigRegel = '--'+Msg.MultiPartBoundary+'--'+#13) THEN
                             BEGIN
                                  { found the last part }
                                  Decode_ProcessLine:=TRUE; { abort }
                                  Exit;
                             END;
                        END;

                        { might be a UU,XX or BinHex encoded block inside }
                        { a single part MIME message. IRex does this.     }

                        (*
                        { Not a multi-part message. should have been aborted before this point?? }
                        LogMessage ('Unhandled situation in dsFindStart1 ** PLEASE REPORT **');

                        Decode_ProcessLine:=TRUE; { abort here }
                        Exit;
                        *)
                   END;

                   IF (Length (OrigRegel) > 10) AND
                      (Copy (OrigRegel,1,6) = 'begin ') AND
                      (OrigRegel[7] IN ['0'..'7']) AND
                      (OrigRegel[8] IN ['0'..'7']) AND
                      (OrigRegel[9] IN ['0'..'7']) THEN
                   BEGIN
                        { begin of a UU or XX encoded file }
                        IF HandleBeginLine (Copy (OrigRegel,1,Length (OrigRegel)-1{#13})) THEN
                           DecodeState:=dsCheckXXUUType
                        ELSE
                            Decode_ProcessLine:=TRUE; { abort here }

                        Exit;
                   END;

                   IF (OrigRegel = BINHEX_HEADER+#13) THEN
                   BEGIN
                        DecodeBinHex_Init;
                        DecodeState:=dsBinHexHeader1;
                        Exit;
                   END;

                   { if we are not searching for "begin" inside a MIME }
                   { part (case dsFindStart2 / "multiple empty lines   }
                   { after header") then abort here.                   }

                   IF (DecodeState = dsFindStart1) THEN
                   BEGIN
                        { could not detect the type of encoding. }
                        { Log the line for the moment and stop   }
                        { decoding here.                         }
                        {$IFDEF Pre}
                        (*LogMessage (liDebug,'Not encoded "'+Copy (OrigRegel,1,Length (OrigRegel)-1{#13})+'"');*)
                        {$ENDIF}
                        Decode_ProcessLine:=TRUE; { abort right here }
                   END;

                   Exit;
              END;

          dsMimeHeader :
              BEGIN
                   IF (OrigRegel = #13) THEN
                   BEGIN
                        IF DecideMimeDecodingState THEN
                           Decode_ProcessLine:=TRUE; { abort }
                   END ELSE
                       IF (UpCaseString (Copy (OrigRegel,1,8)) = 'CONTENT-') OR
                          (OrigRegel[1] IN [' ',#9])
                       THEN
                          DecodeMimeHeader_Process (OrigRegel);

                   Exit;
              END;

          dsMimeInit64 :
              BEGIN
                   { RAWI 980315: inserted this state for skipping }
                   {              additional empty lines between   }
                   {              the Content-* headers and the    }
                   {              encoded block.                   }
                   IF (OrigRegel = #13) THEN
                      Exit  { skip }
                   ELSE
                       DecodeState:=dsMimeBase64;
              END;

          dsCheckXXUUType :
              BEGIN
                   L:=Length (OrigRegel)-2; { 1 for the #13, 1 for the length byte }

                   { support lines with an extra space at the end }
                   IF (OrigRegel[Length (OrigRegel)-1] = ' ') THEN
                      Dec (L);

                   IF (L > 0) THEN
                   BEGIN
                        L:=(L DIV 4)*3;
                        IF (OrigRegel[1] IN [UUChars[L+1],UUChars[L],UUChars[L-1]]) THEN
                        BEGIN
                             InitCh2Byte (UUChars);
                             Ch2Byte[32]:=0;  { spatie ipv ` }
                             DecodeState:=dsDecodeUUXX;
                        END ELSE
                            IF (XXChars[L+1] = OrigRegel[1]) THEN
                            BEGIN
                                 InitCh2Byte (XXChars);
                                 DecodeState:=dsDecodeUUXX;
                            END ELSE
                                L:=0;
                   END;

                   IF (L = 0) THEN
                   BEGIN
                        { invalid or not supported: log and abort }
                        LogMessage (liReport,'Could not detect UU or XX encoding from: ');
                        LogExtraMessage ('"'+Copy (OrigRegel,1,Length (OrigRegel)-1)+'"');

                        AbortDecoding;
                        Decode_ProcessLine:=TRUE; { abort }
                        Exit;
                   END;
              END;

          dsPostUUXX :
              BEGIN
                   { just stay in this state until the end of this part. }
                   { we can then detect that the encoded file was ended  }
                   { correctly instead of aborted or split.              }

                   { check for "sum -r" lines for future verification }
                   IF (OrigRegel = 'end'#13) THEN
                      Exit;

                   LogMessage (liDebug,'PostUUXX: "'+Copy (OrigRegel,1,Length (OrigRegel)-1)+'"');
                   Exit;
              END;

          dsBinHexHeader1 :
              BEGIN
                   { this routine checks the semi-colon at the start   }
                   { and runs the character stream through the decoder }

                   IF (OrigRegel[1] <> ':') THEN
                   BEGIN
                        LogMessage (liFatal,'Error in first BinHex line: "'+OrigRegel+'"');
                        Decode_ProcessLine:=FALSE;
                        Exit;
                   END;

                   IF DecodeBinHex_ProcessCharStream (Copy (OrigRegel,2,Length (OrigRegel)-2{: and #13})) THEN
                      DecodeState:=dsDecodeBinHex
                   ELSE BEGIN
                        AbortDecoding;
                        Decode_ProcessLine:=TRUE; { abort now }
                   END;

                   Exit;
              END;

          dsAbort :
              BEGIN
                   { single part MIME message with no file in it }
                   Decode_ProcessLine:=TRUE; { abort now }
                   Exit;
              END;
     END; { case }

     { split case because the first line we detected the XX/UU type on }
     { must be decoded as well.                                        }

     CASE DecodeState OF

          dsMimeBase64 :
              BEGIN
                   IF (OrigRegel = #13) THEN
                   BEGIN
                        {##log?}
                        Decode_ProcessLine:=TRUE;
                        Exit;
                   END;

                   L:=Length (OrigRegel)-1{#13};
                   IF ((L MOD 4) <> 0) THEN
                   BEGIN
                        LogMessage (liDebug,'[DecodeBase64] Line does not comply to the pair4 test');
                        AbortDecoding;
                        Decode_ProcessLine:=TRUE;
                        Exit;
                   END;

                   L:=L DIV 4;

                   GetPos:=1;
                   StorePos:=1;

                   FOR Lp:=1 TO L DO
                   BEGIN
                        V1:=Ch2Byte[Byte (OrigRegel[GetPos+0])];
                        V2:=Ch2Byte[Byte (OrigRegel[GetPos+1])];
                        V3:=Ch2Byte[Byte (OrigRegel[GetPos+2])];
                        V4:=Ch2Byte[Byte (OrigRegel[GetPos+3])];

                        IF (V1 = 255) OR (V2 = 255) OR (V3 = 255) OR (V4 = 255) THEN
                        BEGIN
                             LogMessage (liDebug,'[DecodeBase64] Error in line sequence: '+Copy (OrigRegel,GetPos,4));
                             AbortDecoding;
                             Decode_ProcessLine:=TRUE;
                             Exit;
                        END;

                        Inc (GetPos,4);

                        Buf[StorePos+0]:=(V1 SHL 2) OR ((V2 AND $30) SHR 4);
                        Buf[StorePos+1]:=((V2 AND 15) SHL 4) OR ((V3 AND $3C) SHR 2);
                        Buf[StorePos+2]:=((V3 AND 3) SHL 6) OR V4;

                        IF (V4 = 254) THEN
                        BEGIN
                             Inc (StorePos); { at least 8 bits at the end }

                             IF (V3 <> 254) THEN
                                Inc (StorePos);  { 16 bits at the end }
                        END ELSE
                            Inc (StorePos,3); { normal 24 bits }
                   END;

                   BlockWrite (DecodeFile,Buf,StorePos-1);

                   Exit;
              END;

          dsMimeQP :
              BEGIN
                   { this is only used when the multi-part was forced }
                   { as an attachment.                                }
                   {Hulp:=DecodeMimeQP (Copy (OrigRegel,1,Length (OrigRegel)-1));}
                   Hulp:=DecodeMimeQP (OrigRegel); { keep #13!! }
                   { do not add CR/LF pairs - they must be encoded if }
                   { they were required.                              }
                   BlockWrite (DecodeFile,Hulp[1],Length (Hulp));
                   Exit;
              END;

          dsMimePlain :
              BEGIN
                   { this is only used when the multi-part is forced as }
                   { an attachment.                                     }
                   Hulp:=OrigRegel+#10; {## verify this }
                   BlockWrite (DecodeFile,Hulp[1],Length (Hulp));
                   Exit;
              END;

          dsDecodeUUXX :
              BEGIN
                   { detect the end line }
                   IF (OrigRegel = #13) THEN
                   BEGIN
                        LogMessage (liFatal,'Unexpected empty line in UU/XX encoded block; aborting');
                        AbortDecoding;
                        Decode_ProcessLine:=TRUE; { abort at once }
                        Exit;
                   END;

                   { decodeer en controleer lengte van de regel }
                   Len:=Ch2Byte[Byte (OrigRegel[1])];

                   IF (Len = 0) THEN
                   BEGIN
                        { this is how it is supposed to work! }
                        DecodeState:=dsPostUUXX;
                        Exit;
                   END;

                   IF (Len = 255) THEN
                   BEGIN
                        LogMessage (liReport,'[DecodeUUXX] Invalid line length specifier in line:');
                        LogExtraMessage ('"'+Copy (OrigRegel,1,Length (OrigRegel)-1)+'"');
                        AbortDecoding;
                        Decode_ProcessLine:=TRUE; { abort at once }
                        Exit;
                   END;

                   L:=Len DIV 3;

                   { RWI 960512: 'E' = Len=37 -> L=12 = 36 tekens  }
                   { BlockWrite neemt Len=37 -> laatste byte fout! }
                   IF (L*3 < Len) THEN
                      Inc (L); { note: an additional THREE bytes }

                   { Zorg voor genoeg data }
                   {## adjust for #13 and space at end of line }
                   {
                   IF (Length (Regel) < 1+L*4) THEN
                      Regel:=Regel+'AA';
                   }

                   GetPos:=2;
                   StorePos:=1;

                   FOR Lp:=1 TO L DO
                   BEGIN
                        V1:=Ch2Byte[Byte (OrigRegel[GetPos+0])];
                        V2:=Ch2Byte[Byte (OrigRegel[GetPos+1])];
                        V3:=Ch2Byte[Byte (OrigRegel[GetPos+2])];
                        V4:=Ch2Byte[Byte (OrigRegel[GetPos+3])];

                        IF (V1 = 255) OR (V2 = 255) OR (V3 = 255) OR (V4 = 255) THEN
                           IF (Lp < L) THEN
                           BEGIN
                                {## add verification for "correct" error where }
                                { V3 and V4 were taken from the #13 + whatever }
                                { or ' ' and #13.                              }
                                { Use Lp, L, GetPos and Len for the check.     }
                                LogMessage (liFatal,'[DecodeUUXX] Error in line sequence: '+Copy (OrigRegel,GetPos,4));
                                AbortDecoding;
                                Decode_ProcessLine:=TRUE; { abort }
                                Exit;
                           END;
                           { else: BlockWrite schrijft laatste byte(s) toch niet }

                        Inc (GetPos,4);

                        Buf[StorePos+0]:=(V1 SHL 2) OR ((V2 AND $30) SHR 4);
                        Buf[StorePos+1]:=((V2 AND 15) SHL 4) OR ((V3 AND $3C) SHR 2);
                        Buf[StorePos+2]:=((V3 AND 3) SHL 6) OR V4;

                        Inc (StorePos,3);
                   END; { for }

                   {$I-} BlockWrite (DecodeFile,Buf,Len); {$I+} IORes:=IOResult;
                   IF (IORes <> 0) THEN
                   BEGIN
                        LogDiskIOError (IORes,'Error writing to attached file');
                        AbortDecoding;
                        Decode_ProcessLine:=TRUE;
                   END;

                   Exit;
              END; { dsDecodeUUXX }

          dsDecodeBinHex :
              BEGIN
                   IF (NOT DecodeBinHex_ProcessCharStream (Copy (OrigRegel,1,Length (OrigRegel)-1{#13}))) THEN
                   BEGIN
                        AbortDecoding;
                        Decode_ProcessLine:=TRUE; { abort }
                   END;

                   { check if we have reached the end }
                   IF (OrigRegel[Length (OrigRegel)-1] = ':') THEN
                   BEGIN
                        {## not sure this is needed }
                        IF (BinHex_LeftChars <> '') THEN
                           DecodeBinHex_ProcessCharStream ('!!!');

                        Decode_ProcessLine:=TRUE; { stop }
                   END;

                   IF (BinHex_BodyLeft = 0) THEN
                      Decode_ProcessLine:=TRUE;

                   Exit;
              END;
     END; { case }

     LogMessage (liReport,'[Decode] Unexpected state '+Byte2String (Byte (DecodeState)));
     Decode_ProcessLine:=TRUE; { abort right here }
     Exit;
END;


{--------------------------------------------------------------------------}
{ Decode_ProcessLine_Concat                                                }
{                                                                          }
{ This routine makes sure that MIME quoted-printable encoding has not      }
{ resulted in short lines with an equal sign at the end, which cause the   }
{ decoding to fail here because one Base64/UU/XX/BinHex line is too short. }
{ We check for incomplete lines (no #13 at the end) and remember them,     }
{ concattenating them with the next line.                                  }
{ There is no finalisation routine, so the last line will be lost if it    }
{ does not have a #13 at the end.                                          }
{                                                                          }
{ Cases:                                                                   }
{                                                                          }
{ #  OrigRegel_has_#13  Decode_HalfLine  Todo                              }
{ 1  Yes                ""               Call Decode_ProcessLine           }
{ 2  No                 ""               Decode_HalfLine:=OrigRegel; Exit; }
{ 3  Yes                <> ""            Concat, call Decode_ProcessLine   }
{ 4  No                 <> ""            Concat, exit                      }
{                                                                          }
FUNCTION Decode_ProcessLine_Concat (VAR OrigRegel : STRING) : BOOLEAN; FAR;

VAR Temp : STRING;
    P    : BYTE;

BEGIN
     IF (OrigRegel[Length (OrigRegel)] = #13) THEN
     BEGIN
          IF (Decode_HalfLine = '') THEN
          BEGIN
               { case 1 }
               Decode_ProcessLine_Concat:=Decode_ProcessLine (OrigRegel);
          END ELSE
          BEGIN
               { case 3 }
               IF (Length (Decode_HalfLine)+Length (OrigRegel) > 255) THEN
               BEGIN
                    IF Decode_ProcessLine (Decode_HalfLine) THEN
                       Decode_ProcessLine_Concat:=Decode_ProcessLine (OrigRegel)
                    ELSE
                        Decode_ProcessLine_Concat:=FALSE;
               END ELSE
               BEGIN
                    Decode_HalfLine:=Decode_HalfLine+OrigRegel;

                    IF (DecodeState IN [dsCheckXXUUType,dsDecodeUUXX,dsPostUUXX]) THEN
                    BEGIN
                         P:=Pos (' ',Decode_HalfLine);
                         IF (P > 0) THEN
                         BEGIN
                              Temp:=Copy (Decode_HalfLine,1,Pos (' ',Decode_HalfLine)-1)+#13;
                              Delete (Decode_HalfLine,1,P);

                              Decode_ProcessLine_Concat:=Decode_ProcessLine (Temp);
                         END;
                    END;

                    Decode_ProcessLine_Concat:=Decode_ProcessLine (Decode_HalfLine);
               END;

               Decode_HalfLine:='';
          END;
     END ELSE
     BEGIN
          { OrigRegel is incomplete }
          Decode_ProcessLine_Concat:=FALSE; { do not abort }

          IF (Length (Decode_HalfLine)+Length (OrigRegel) > 255) THEN
          BEGIN
               Decode_ProcessLine_Concat:=Decode_ProcessLine (Decode_HalfLine);
               Decode_HalfLine:='';
          END;

          Decode_HalfLine:=Decode_HalfLine+OrigRegel;

          { special handling for UU encoded inside MIME quoted-printable }
          { with end-of-lines replaced with space.                       }
          IF (DecodeState IN [dsCheckXXUUType,dsDecodeUUXX,dsPostUUXX]) THEN
          BEGIN
               REPEAT
                     P:=Pos (' ',Decode_HalfLine);
                     IF (P > 0) THEN
                     BEGIN
                          Temp:=Copy (Decode_HalfLine,1,Pos (' ',Decode_HalfLine)-1)+#13;
                          Delete (Decode_HalfLine,1,P);

                          Decode_ProcessLine_Concat:=Decode_ProcessLine (Temp);
                     END;
               UNTIL (P = 0);
          END;
     END;
END;


{--------------------------------------------------------------------------}
{ Decode_Init                                                              }
{                                                                          }
{ This routine resets all internal variables used for decoding files. It   }
{ is called for each part before each of its lines are run through the     }
{ Decode_ProcessLine function.                                             }
{                                                                          }
PROCEDURE Decode_Init (PartStatus : PartStatusType);
BEGIN
     ContainedAFile:=FALSE;
     FileIsOpen:=FALSE;
     DecodeFilename:='';
     OriginalName:='';
     DecodeFileSize:=0;
     DecodeState:=dsFindStart1;
     Decode_HalfLine:='';

     { special handling of single-part base64 attachments in MIME messages }
     IF Msg.IsMime AND (Msg.MultiPartBoundary = '') THEN
     BEGIN
          { if we have a single-part MIME message with a XX,UU or BinHex }
          { encoded block then run through the normal detection (IRex).  }
          IF (PartStatus = psAttachment) THEN
             Exit;

          { Not a multi-part MIME message. We now need to examine the }
          { headers to work out of this is an attachment or BASE64    }
          { encoded message only. If not, then it must be a text      }
          { message.                                                  }
          DecodeMimeHeader_Init;
          MsgsForEach (Msg.HeaderTop_U,CheckForMimeHeader);

          { peek at the first line of the body. if is empty, then let }
          { the dsMimeHeader state filter out the empty lines until   }
          { the encoded lines start. Otherwise, decide at once and    }
          { start in that decoding state so we don't miss a line.     }
          IF (MsgsGetFirstRowInBody = '') THEN
             DecodeState:=dsMimeHeader
          ELSE
              IF DecideMimeDecodingState THEN
                 DecodeState:=dsAbort;
     END;
END;


{--------------------------------------------------------------------------}
{ DecodeAttachedFiles                                                      }
{                                                                          }
{ This routine is called before a message is imported into a message base  }
{ or written to a .PKT file. The task of this routine is to identify and   }
{ extract files and to return the number of bytes of the message that are  }
{ to be imported so the correct number of split parts can be calculated.   }
{                                                                          }
PROCEDURE DecodeAttachedFiles (Path : STRING; AttachProc : Decode_AttachFile_Proc);

VAR Lp        : 0..MAX_BODY_PARTS;
    StartPart : 1..MAX_BODY_PARTS;

BEGIN
     AttachFileProc:=AttachProc; { used by Decode_ProcessLine }
     AttachFilePath:=CorrectPath (Path);

     StartPart:=1;

     { if this is a MIME multi-part message that the first part can }
     { just contain "If you read this then your editor doesn't      }
     { understand MIME". We skip this here, but make sure it really }
     { is there first to avoid skipping the first text block or     }
     { attachment!                                                  }
     IF Msg.IsMime AND (Msg.MultiPartBoundary <> '') AND
        (MsgsGetFirstRowInBody <> '--'+Msg.MultiPartBoundary+#13)
     THEN
         StartPart:=2;

     (* old
     IF Msg.IsMime AND (Msg.MultiPartBoundary <> '') THEN
        StartPart:=2  { skip "Your reader doesn't understand MIME" }
     ELSE
         StartPart:=1;
     *)

     FOR Lp:=StartPart TO MAX_BODY_PARTS DO
         IF (Msg.BodyParts[Lp] <> NIL) THEN
         BEGIN
              { initialize }
              Decode_Init (Msg.BodyParts[Lp]^.PartStatus);

              { run this part through the decoder }
              MsgsForEach (Msg.BodyParts[Lp],Decode_ProcessLine_Concat);

              IF (DecodeState = dsDecodeUUXX) THEN
              BEGIN
                   LogMessage (liFatal,'Unexpected end of encoded block.');
                   AbortDecoding;
              END;

              { close the file - if it was open and have ContainedAFile updated }
              CloseDecodeFile;

              { check the result }
              WITH Msg.BodyParts[Lp]^ DO
              BEGIN
                   IF ContainedAFile THEN
                   BEGIN
                        PartStatus:=psAttachment;
                        AttachmentInfo:=BuildAttachmentInfo;
                   END ELSE
                       PartStatus:=psUnknown;

              END; { with }

         END; { if, for }
END;


{--------------------------------------------------------------------------}
{ DecodeMimeBase64                                                         }
{                                                                          }
{ This routine decodes a base64 encoded line and returns the 8-bit result. }
{                                                                          }
FUNCTION DecodeMimeBase64 (Line : STRING) : STRING;

VAR Ch2Byte     : ARRAY[0..255] OF BYTE;
    Lp,
    L,
    GetPos,
    StorePos,
    V1,V2,V3,V4 : BYTE;

BEGIN
     DecodeMimeBase64:=Line; { original, in case of errors }

     { vul de decodeer tabel in voor MIME }
     FOR Lp:=0 TO 255 DO
         Ch2Byte[Lp]:=255;

     FOR Lp:=1 TO Length (Base64) DO
         Ch2Byte[Ord (Base64[Lp])]:=Lp-1;

     Ch2Byte[Ord ('=')]:=254; { voor detectie aan het einde }

     IF ((Length (Line) MOD 4) <> 0) THEN
     BEGIN
          LogMessage (liFatal,'[DecodeMimeBase64] Base64 coded line does not comply to the pair4 test');
          Exit; { ## EXIT ## }
     END;

     L:=Length (Line) DIV 4;

     GetPos:=1;
     StorePos:=1;

     FOR Lp:=1 TO L DO
     BEGIN
          V1:=Ch2Byte[Byte (Line[GetPos+0])];
          V2:=Ch2Byte[Byte (Line[GetPos+1])];
          V3:=Ch2Byte[Byte (Line[GetPos+2])];
          V4:=Ch2Byte[Byte (Line[GetPos+3])];

          Inc (GetPos,4);

          IF (V1 = 255) OR (V2 = 255) OR (V3 = 255) OR (V4 = 255) THEN
          BEGIN
               LogMessage (liFatal,'[DecodeMimeBase64] Error in line sequence: '+Copy (Line,1,4));
               Exit; { ## EXIT ## }
          END;

          Line[StorePos+0]:=Char ((V1 SHL 2) OR ((V2 AND $30) SHR 4));
          Line[StorePos+1]:=Char (((V2 AND 15) SHL 4) OR ((V3 AND $3C) SHR 2));
          Line[StorePos+2]:=Char (((V3 AND 3) SHL 6) OR V4);

          IF (V4 = 254) THEN
          BEGIN
               Inc (StorePos); { 16 bits at the end }

               IF (V3 <> 254) THEN
                  Inc (StorePos);  { 8 bits at the end }

               Line[0]:=Char (StorePos-1);
               DecodeMimeBase64:=Line;

               Exit; { ## EXIT ## }
          END;

          Inc (StorePos,3);
     END;

     { fill in changed length }
     Line[0]:=Char (StorePos-1);
     DecodeMimeBase64:=Line;
END;

END.
