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

{$i platform.inc}

{ unit die UU-encode en UU-decode en nog wat meer in de toekomst }

INTERFACE

PROCEDURE XX_FileToBody (Filename : STRING; SuppressInfo,ForceText,ForceEncode : BOOLEAN);


IMPLEMENTATION

USES Dos,
     Ramon,
     Globals,
     Logs,
     Msgs,
     Language,
     Cfg;

{--------------------------------------------------------------------------}
{ LocateFile                                                               }
{                                                                          }
{ Probeer de opgegeven file te openen in het opgegeven path of een van de  }
{ inbound directories. Geeft een van de volgende resultaten terug:         }
{  FALSE = Niet kunnen vinden                                              }
{  TRUE  = Gevonden                                                        }
{                                                                          }
{ In: Filename=pad+name+ext                                                }
{                                                                          }
{ Uit: Path=pad                                                            }
{      Filename=name+ext                                                   }
{                                                                          }
FUNCTION LocateFile (VAR Path,Filename : STRING) : BOOLEAN;

VAR Dir    : DirStr;
    Name   : NameStr;
    Ext    : ExtStr;
    Regel  : STRING;
    Search : SearchRec;

BEGIN
     { kijk of we de file kunnen vinden en openen }
     FSplit (Filename,Dir,Name,Ext);

     Regel:=Dir;
     IF (Regel = '') THEN
        GetDir (0,Regel);

     Path:=Dir;
     Filename:=Name+Ext;

     FindFirst (Path+Filename,saJustFiles,Search);
     IF (DosError = 2) OR (DosError = 18) THEN
     BEGIN
          FindClose (Search);

          { not found there, try inbounds }
          IF (Dir = '') THEN
          BEGIN
               IF (Config.Inbound_F[1] <> '') THEN
               BEGIN
                    IF (Regel <> '') THEN
                       Regel:=Regel+' and ';
                    Regel:=Regel+Config.Inbound_F[1];

                    Filename:=Name+Ext;
                    Path:=Config.Inbound_F[1];

                    FindFirst (Path+Filename,saJustFiles,Search);
               END;

               IF (DosError <> 0) AND (Config.Inbound_F[2] <> '') THEN
               BEGIN
                    IF (Regel <> '') THEN
                       Regel:=Regel+' and ';
                    Regel:=Regel+Config.Inbound_F[2];

                    Filename:=Name+Ext;
                    Path:=Config.Inbound_F[2];

                    FindFirst (Path+Filename,saJustFiles,Search);
               END;
          END;
     END;

     IF (DosError = 2) OR (DosError = 18) THEN
     BEGIN
          MsgsAddLineTo (Body,'*** '+GetLang1 (202,Filename));

          LogMessage (liFatal,'Could not find attached file to include in mail message:');
          LogDiskIOError (DosError,Path+Filename);
          LogExtraMessage ('Searched in '+Regel);

          FindClose (Search);

          LocateFile:=FALSE; { not found }
          Exit;
     END;

     IF (DosError <> 0) THEN
     BEGIN
          LogDiskIOError (DosError,'Error opening attached file '+Filename);
          LogExtraMessage ('Searched in '+Regel);

          MsgsAddLineTo (Body,'*** '+GetLang1 (202,Filename));

          FindClose (Search);

          LocateFile:=FALSE;
          Exit;
     END;

     FindClose (Search);

     LocateFile:=TRUE;
END;


{--------------------------------------------------------------------------}
{ XX_EncodeFileToBody                                                      }
{                                                                          }
{ Deze routine opent de opgegeven file en stopt deze in het bericht.       }
{                                                                          }
PROCEDURE XX_EncodeFileToBody (Path,Filename : STRING);

CONST {XXChars : STRING[64] = '+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';}
      Chars : STRING[64] = '`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';

TYPE FourString = STRING[4];

    FUNCTION Three8ToFour6 (C1,C2,C3 : BYTE) : FourString;
    BEGIN
         { 76543210 76543210 76543210 }
         { 11111122 22223333 33444444 }

         Three8ToFour6:=Chars[(C1 SHR 2)+1]+
                        Chars[(((C1 AND 3) SHL 4)+(C2 SHR 4))+1]+
                        Chars[(((C2 AND 15) SHL 2) OR (C3 SHR 6))+1]+
                        Chars[(C3 AND 63)+1];
    END;

TYPE BufArray    = ARRAY[1..60000] OF BYTE;
     BufArrayPtr = ^BufArray;

VAR InFile     : FILE;
    IORes      : BYTE;
    BufSize    : WORD;
    BufPtr     : BufArrayPtr;
    BytesRead  : WordLong;
    Regel      : STRING[80];
    GetPos     : WORD;
    CodedCount : BYTE;
    TheEnd     : BOOLEAN;

BEGIN
     Assign (InFile,Path+Filename);
     {$I-} Reset (InFile,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'[EncodeFileIntoBody] Error opening file '+Path+Filename);
          MsgsAddLineTo (Body,'*** '+GetLang1 (202,Filename));
          Exit;
     END;

     {$IFDEF LogFileIO}PostOpenF (InFile);{$ENDIF}

     IF (FileSize (InFile) < 10000) THEN
        Regel:=Longint2String (FileSize (InFile))
     ELSE
         Regel:=Longint2String (FileSize (InFile) DIV 1024)+'K';

     LogMessage (liTrivial,'Encoding '+Path+Filename+' ('+Regel+'b) into message body');

     IF (NOT CalcMaxAllowedMem (BufSize,512,10000)) THEN
     BEGIN
          LogMessage (liFatal,'Not enough memory to encode file into message body');
          MsgsAddLineTo (Body,'');
          MsgsAddLineTo (Body,'*** '+GetLang1 (202,Filename));

          {$IFDEF LogFileIO}PreCloseF (InFile);{$ENDIF}
          Close (InFile);
          Exit;
     END;

     BufSize:=Trunc (BufSize/3)*3; { must be a three-fold! }
     GetMem (BufPtr,BufSize);

     MsgsAddLineTo (Body,'');
     MsgsAddLineTo (Body,GetLang1 (200,DesktopProgramName+' v'+MainVersionNr));
     MsgsAddLineTo (Body,'');
     MsgsAddLineTo (Body,'begin 600 '+LoCaseString (Filename));

     Regel:=''; { nothing yet }
     CodedCount:=0;

     TheEnd:=FALSE;
     REPEAT
           BlockRead (InFile,BufPtr^,BufSize,BytesRead);
           IF (BytesRead < BufSize) THEN
              TheEnd:=TRUE;

           GetPos:=1;

           WHILE (BytesRead > 0) DO
           BEGIN
                IF (BytesRead >= 3) THEN
                BEGIN
                     Regel:=Regel+Three8ToFour6 (BufPtr^[GetPos],BufPtr^[GetPos+1],BufPtr^[GetPos+2]);
                     Inc (GetPos,3);
                     Dec (BytesRead,3);
                     Inc (CodedCount,3);
                END ELSE
                BEGIN
                     Inc (CodedCount,BytesRead);

                     IF (BytesRead = 2) THEN
                        Regel:=Regel+Three8ToFour6 (BufPtr^[GetPos],BufPtr^[GetPos],0)
                     ELSE
                         IF (BytesRead = 1) THEN
                            Regel:=Regel+Three8ToFour6 (BufPtr^[GetPos],0,0);

                     { RWI 960323: hier heen verplaatst. Stond vOOr de     }
                     {             twee IFs hierboven. Hence the result... }
                     BytesRead:=0; { nothing left to do }
                END;

                IF (Length (Regel) = 60) THEN
                BEGIN
                     MsgsAddLineTo (Body,Chars[CodedCount+1]+Regel);
                     Regel:='';
                     CodedCount:=0;
                END;
           END;

     UNTIL TheEnd;

     IF (Regel <> '') THEN
        MsgsAddLineTo (Body,Chars[CodedCount+1]+Regel);

     MsgsAddLineTo (Body,'`');
     MsgsAddLineTo (Body,'end');
     MsgsAddLineTo (Body,'');

     FreeMem (BufPtr,BufSize);

     {$IFDEF LogFileIO}PreCloseF (InFile);{$ENDIF}
     Close (InFile);
END;


{--------------------------------------------------------------------------}
{ XX_IncludeFileToBody                                                     }
{                                                                          }
{ Deze routine opent een file en neemt deze in de body op, zonder          }
{ encoding.                                                                }
{                                                                          }
PROCEDURE XX_IncludeFileToBody (Path : STRING; Filename : STRING; SuppressInfo : BOOLEAN);

VAR InFile : TEXT;
    IORes  : BYTE;
    Regel  : STRING;
    P      : BYTE;

BEGIN
     Assign (InFile,Path+Filename);
     {$I-} Reset (InFile); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          MsgsAddLineTo (Body,'');
          MsgsAddLineTo (Body,'*** '+GetLang1 (202,Filename));
          LogDiskIOError (IORes,'[IncludeFileToBody] Error opening file '+Path+Filename);
          Exit;
     END;

     {$IFDEF LogFileIO}PostOpenT (InFile);{$ENDIF}

     LogMessage (liTrivial,'Including '+Path+Filename+' into message body');

     IF (NOT SuppressInfo) THEN
     BEGIN
          MsgsAddLineTo (Body,'');
          MsgsAddLineTo (Body,GetLang1 (201,DesktopProgramName+' v'+MainVersionNr));
          MsgsAddLineTo (Body,'');
     END;

     WHILE (NOT Eof (InFile)) DO
     BEGIN
          ReadLn (InFile,Regel);
          MsgsAddLineTo (Body,Regel);
     END;

     IF (Regel <> '') THEN
        MsgsAddLineTo (Body,'');

     {$IFDEF LogFileIO}PreCloseT (InFile);{$ENDIF}
     Close (InFile);
END;


{--------------------------------------------------------------------------}
{ XX_TestForEncodingNeed                                                   }
{                                                                          }
{ Deze routine opent de opgegeven file en kijkt of de inhoud uberhaupt wel }
{ gecodeerd hoeft te worden.                                               }
{                                                                          }
{ Result values: 0 = Doesn't need encoding                                 }
{                1 = Needs encoding                                        }
{                2 = Not found or access error                             }
{                                                                          }
{ If ForceText is set, then the user indicated with SENDTEXTFILE that this }
{ file must not be uu/base64 encoded.                                      }
{                                                                          }
FUNCTION XX_TestForEncodingNeed (VAR Path : STRING;
                                 VAR Filename : STRING;
                                 ForceText : BOOLEAN;
                                 ForceEncode : BOOLEAN) : BYTE;

TYPE BufArray    = ARRAY[1..5000] OF BYTE;
     BufArrayPtr = ^BufArray;

VAR InFile     : FILE;
    IORes      : BYTE;
    BufSize    : WORD;
    BufPtr     : BufArrayPtr;
    BytesRead  : WordLong;
    Lp         : WORD;
    TotalBytes : LONGINT;
    TotalBad   : LONGINT;

BEGIN
     XX_TestForEncodingNeed:=2; { not found or access error }

     IF (NOT LocateFile (Path,Filename)) THEN
        Exit; { 2: not found }

     IF ForceEncode THEN
     BEGIN
          XX_TestForEncodingNeed:=1; { encode }
          Exit;
     END;

     IF ForceText THEN
     BEGIN
          XX_TestForEncodingNeed:=0; { text }
          Exit;
     END;

     Assign (InFile,Path+Filename);
     {$I-} Reset (InFile,1); {$I+} IORes:=IOResult;
     IF (IORes <> 0) THEN
     BEGIN
          LogDiskIOError (IORes,'Error opening '+Path+Filename);
          Exit; { 2: access error }
     END;

     XX_TestForEncodingNeed:=1; { needs encoding }

     IF (NOT CalcMaxAllowedMem (BufSize,512,5000)) THEN
     BEGIN
          Close (InFile);
          Exit; { 1: needs encoding }
     END;

     GetMem (BufPtr,BufSize);

     TotalBytes:=0;
     TotalBad:=0;

     REPEAT
           BlockRead (InFile,BufPtr^,BufSize,BytesRead);

           FOR Lp:=1 TO BytesRead DO
               IF NOT (BufPtr^[Lp] IN [9,13,10,32..126]) THEN
                  Inc (TotalBad);

           TotalBytes:=TotalBytes+BytesRead;

           { RWI 970130: changed from 10% to 15% (16.7% is limit) }
           IF ((TotalBad/TotalBytes) > 0.15) THEN
           BEGIN
                Close (InFile);
                FreeMem (BufPtr,BufSize);
                Exit; { 1: needs encoding }
           END;

           { stop at end of file, or when ForceText is set and we have }
           { found some 8bit data to require quoted-printable encoding }
     UNTIL (BytesRead = 0);

     FreeMem (BufPtr,BufSize);
     Close (InFile);

     XX_TestForEncodingNeed:=0; { does not need encoding }
END;


{--------------------------------------------------------------------------}
{ XX_FileToBody                                                            }
{                                                                          }
{ Deze routine bekijkt een file en als het nodig is wordt deze in de       }
{ body opgenomen. Don't forget to call FtnBodyToMime if this is used for   }
{ building an Mail body.                                                   }
{                                                                          }
PROCEDURE XX_FileToBody (Filename : STRING; SuppressInfo,ForceText,ForceEncode : BOOLEAN);

VAR Path    : STRING;
    Any8Bit : BOOLEAN;
    OldMode : BYTE;

BEGIN
     OldMode:=FileMode;
     FileMode:=fmReadOnly+fmDenyNone;

     { if ForceText is set, then still call TestForEncodingNeed to }
     { split the path and filename.                                }
     CASE XX_TestForEncodingNeed (Path,Filename,ForceText,ForceEncode) OF
          0 : XX_IncludeFileToBody (Path,Filename,SuppressInfo);
          1 : XX_EncodeFileToBody (Path,Filename);
          2 : ;{ not found or access error; already logged }
     END; { case }

     FileMode:=OldMode;
END;


END.
