PROGRAM SpoolMgr;

{ dit programma beheert je spool directories }

USES Dos,
     Ramon;

CONST PrgVersion = '1.0';

{$I KIT\STRUCTS.PAS}

CONST MAXUUCPDIRS   = 50;         { max 50 sub UUCP directories }
      MAXDIRENTRIES = 1500;       { meer dan 1500 files in een system dir is waanzin }
                                  { 1500x13 = 19500 in dseg }

VAR SpoolPath : STRING;
    UUCPCount : 0..MAXUUCPDIRS;
    UUCPDirs  : ARRAY[1..MAXUUCPDIRS] OF STRING[8];
    DirName   : STRING;
    DirCount  : 0..MAXDIRENTRIES;
    DirList   : ARRAY[1..MAXDIRENTRIES] OF STRING[12]; { 88888888.333 }

{---------------------------------------------------------------------------}
{ WritePrgLines                                                             }
{                                                                           }
PROCEDURE WritePrgLines;
BEGIN
     WriteLn ('Spool Directories Manager v',PrgVersion);
     WriteLn ('(c) Waterline Software Development 1995');
     WriteLn ('Written by Ramon van der Winkel');
     WriteLn;
END;


{---------------------------------------------------------------------------}
{ GetSpoolPath                                                              }
{                                                                           }
{ Deze routine probeert de SPOOL directory te vinden. Als er wat dingen mis }
{ gaan, dan wordt het programma hard gestopt en een melding op het scherm   }
{ gezet.                                                                    }
{                                                                           }
PROCEDURE GetSpoolPath;

TYPE MyConfigRecord = RECORD
                            Header : STRING[25];
                            Cfg    : ConfigRecord;
                      END;

VAR Path    : STRING;
    CfgFile : FILE;
    IORes   : BYTE;
    Cfg     : MyConfigRecord;

BEGIN
     SpoolPath:='';

     IF (ParamCount = 0) THEN
     BEGIN
          { kijk of wtrcfg.tdb in de buurt is }
          { zoek eerst via wtrgate environment variabele }

          Path:=GetEnv ('WTRGATE');
          Path:=FExpand (Path)+'\WTRCFG.TDB';

          Assign (CfgFile,Path);
          {$I-} Reset (CfgFile,1); {$I+} IORes:=IOResult;
          IF (IORes = 0) THEN
          BEGIN
               BlockRead (CfgFile,Cfg,SizeOf (MyConfigRecord));
               SpoolPath:=Cfg.Cfg.SpoolBaseDir;
               Close (CfgFile);
          END ELSE
          BEGIN
               WriteLn (' þ Cannot find SPOOL path');
               WriteLn;
               WriteLn ('Usage:   spoolmgr <spool path>');
               WriteLn ('Example: spoolmsg c:\spool');
               WriteLn;
               WriteLn ('or start this program in the directory where a WTRCFG.TDB file can be');
               WriteLn ('found, or let the WTRGATE environment variable point to that directory.');
               WriteLn;
               Halt (1);
          END;

     END ELSE
         SpoolPath:=ParamStr (1);

     SpoolPath:=FExpand (SpoolPath);
END;


{---------------------------------------------------------------------------}
{ ScanForUUCPDirs                                                           }
{                                                                           }
{ Deze routine doorzoekt de SPOOL directory voor UUCP systeem directories.  }
{ Hier wordt een lijst van gemaakt in UUCPDirs.                             }
{                                                                           }
PROCEDURE ScanForUUCPDirs;

VAR Search : SearchRec;

BEGIN
     UUCPCount:=0;

     FindFirst (SpoolPath+'\*.*',$30{Archive+Dir},Search);
     WHILE (DosError = 0) DO
     BEGIN
          IF (Pos ('.',Search.Name) = 0) AND (Search.Name <> 'STATUS') THEN
          BEGIN
               IF (UUCPCount = MAXUUCPDIRS) THEN
               BEGIN
                    Error ('Only supporting '+Byte2String (MAXUUCPDIRS)+' system directories');
                    Exit;   { forget about the rest }
               END;

               Inc (UUCPCount);
               UUCPDirs[UUCPCount]:=Search.Name;
          END;

          FindNext (Search);
     END;
END;


{---------------------------------------------------------------------------}
{ ReadDirContents                                                           }
{                                                                           }
{ Deze routine leest de inhoud van een UUCP directory en slaat alle         }
{ informatie daarover op in de Dir structuur.                               }
{                                                                           }
PROCEDURE ReadDirContents;

VAR Search : SearchRec;

BEGIN
     Message ('Reading...');

     DirCount:=0;

     FindFirst (DirName+'*.*',$20{archive},Search);
     WHILE (DosError = 0) DO
     BEGIN
          Inc (DirCount);
          DirList[DirCount]:=Search.Name;

          FindNext (Search);
     END;

     WindowPop; { message }
END;


{---------------------------------------------------------------------------}
{ TranslateDirContentsIntoList                                              }
{                                                                           }
{ Deze routine interpreteert de inhoud van de directory en plaatst deze in  }
{ de lijst. De volgende volgorde wordt aangehouden:                         }
{                                                                           }
{ .CMD - Transfer job for transmission                                      }
{        Filters bijbehorende files uit de lijst                            }
{ .XQT - Enveloppe file for transmission                                    }
{        Filtert bijbehorende .DAT file uit de lijst                        }
{ .DAT - Data file for transmission                                         }
{ .X   - Received enveloppe file                                            }
{        Filtert bijbehorende .D file uit de lijst                          }
{ .D   - Received data file                                                 }
{ rest - Raw                                                                }
{                                                                           }
{ Eventueel nog eens interpreteren: BAX, BAD                                }
{                                                                           }
PROCEDURE TranslateDirContentsIntoList;

VAR DirDone : ARRAY[1..MAXDIRENTRIES] OF BOOLEAN;

    {-----------------------------------------------------------------------}
    { SearchCMD                                                             }
    {                                                                       }
    PROCEDURE SearchCMD;

    VAR Lp,
        Lp2      : 0..MAXDIRENTRIES;
        CmdFile  : TEXT;
        IORes    : BYTE;
        Line     : STRING;
        Regel    : STRING[80];
        AddRegel : STRING[80];

    BEGIN
         FOR Lp:=1 TO DirCount DO
             IF (NOT DirDone[Lp]) AND (Pos ('.CMD',DirList[Lp]) > 0) THEN
             BEGIN
                  DirDone[Lp]:=TRUE;

                  Assign (CmdFile,DirName+DirList[Lp]);
                  {$I-} Reset (CmdFile); {$I+} IORes:=IOResult;
                  IF (IORes = 0) THEN
                  BEGIN
                       AddRegel:='for ';

                       WHILE (NOT Eof (CmdFile)) DO
                       BEGIN
                            ReadLn (CmdFile,Line);

                            REPEAT
                                  IF (Pos (#10,Line) > 0) THEN
                                  BEGIN
                                       Regel:=Copy (Line,1,Pos (#10,Line)-1);
                                       Delete (Line,1,Pos (#10,Line));
                                  END ELSE
                                  BEGIN
                                       Regel:=Line;
                                       Line:='';
                                  END;

                                  IF (Copy (Regel,1,2) = 'S ') THEN
                                  BEGIN
                                       Delete (Regel,1,2);
                                       Regel:=Copy (Regel,1,Pos (' ',Regel)-1);

                                       IF (Length (AddRegel) > 4) THEN
                                          AddRegel:=AddRegel+', ';

                                       { de te verzenden filename zit nu in Regel }
                                       { zoek deze naam op en verwijder em uit de lijst }
                                       FOR Lp2:=1 TO DirCount DO
                                           IF (NOT DirDone[Lp2]) AND (DirList[Lp2] = Regel) THEN
                                           BEGIN
                                                AddRegel:=AddRegel+Regel;
                                                Regel:='';
                                                DirDone[Lp2]:=TRUE;
                                                Break; { uit de for }
                                           END; { if,for }

                                       { als we em niet konden vinden, dan zetten we em tussen haakjes }
                                       IF (Regel <> '') THEN
                                          AddRegel:=AddRegel+'('+Regel+')';
                                  END; { if S }
                            UNTIL (Line = '');
                       END; { while not eof }

                       Close (CmdFile);
                  END ELSE
                      AddRegel:='(cannot read file; error '+Byte2String (IORes)+')';

                  ListAddItem (AddUpWithSpaces (13,DirList[Lp])+'Transfer command file '+AddRegel,0,Bottom);
             END;
    END;

    {-----------------------------------------------------------------------}
    { SearchX                                                               }
    {                                                                       }
    PROCEDURE SearchX;

    VAR Lp    : 1..MAXDIRENTRIES;
        XFile : TEXT;
        IORes : BYTE;

    BEGIN
         FOR Lp:=1 TO DirCount DO
             IF (NOT DirDone[Lp]) AND (Pos ('.XQT',DirList[Lp]) > 0) THEN
             BEGIN
                  { open de .X file en haal de .D file naam op }

                  Assign (XFile,DirName+DirList[Lp]);
                  {$I-} Reset (XFile); {$I+} IORes:=IOResult;
                  IF (IORes = 0) THEN
                  BEGIN
                       ListAddItem (AddUpWithSpaces (13,DirList[Lp])+'Incoming file',0,Bottom);
                       Close (XFile);
                       DirDone[Lp]:=TRUE;
                  END ELSE
                      ListAddItem (AddUpWithSpaces (13,DirList[Lp])+'(cannot open file; error '+
                                   Byte2String (IORes)+')',0,Bottom);
             END;
    END;

    {-----------------------------------------------------------------------}
    { SearchRest                                                            }
    {                                                                       }
    PROCEDURE SearchRest;

    VAR Lp : 0..MAXDIRENTRIES;

    BEGIN
         FOR Lp:=1 TO DirCount DO
             IF (NOT DirDone[Lp]) THEN
                ListAddItem (AddUpWithSpaces (13,DirList[Lp])+'(unknown)',0,Bottom);
    END;

{TranslateDirContentsIntoList}
VAR Lp : 0..MAXDIRENTRIES;

BEGIN
     FOR Lp:=0 TO MAXDIRENTRIES DO
         DirDone[Lp]:=FALSE;

     SearchCMD;
     SearchX;
     SearchRest;
END;


{---------------------------------------------------------------------------}
{ ExploreSpoolDir                                                           }
{                                                                           }
{ Deze routine laat de inhoud van een van de spool directories zien, waarna }
{ er leuke dingen mee gedaan kunnen worden.                                 }
{                                                                           }
PROCEDURE ExploreSpoolDir (UUCPNr : BYTE);

VAR ReRead,
    Rebuild,
    First,
    Quit    : BOOLEAN;
    Search  : SearchRec;
    Keuze   : WORD;
    Lp      : WORD;

BEGIN
     DirName:=SpoolPath+UUCPDirs[UUCPNr]+'\';

     ReRead:=TRUE;
     Rebuild:=TRUE;
     First:=TRUE;

     Quit:=FALSE;
     REPEAT
           IF ReRead THEN
           BEGIN
                ReadDirContents;
                Rebuild:=TRUE;
                ReRead:=FALSE;
           END;

           IF Rebuild THEN
           BEGIN
                IF First THEN
                   First:=FALSE
                ELSE
                    ListErase;

                ListDefine (2,3,75,20,Default,'Contents of '+DirName,0);

                TranslateDirContentsIntoList;

                Rebuild:=FALSE;
           END; { rebuild }

           Keuze:=ListSelect (DoTag,[]);

           CASE Key OF
                kEsc :
                    Quit:=TRUE;

                kRet :
                    BEGIN
                         IF (ListTagCount = 0) THEN
                         BEGIN
                              { show info }
                         END ELSE
                         BEGIN
                              { global menu acties }
                         END;
                    END;
           END;

     UNTIL Quit;

     ListErase;
END;


{---------------------------------------------------------------------------}
{ Main                                                                      }
{                                                                           }

VAR Lp        : BYTE;
    Quit      : BOOLEAN;
    Keuze     : WORD;

BEGIN
     WritePrgLines;

     GetSpoolPath;
     ScanForUUCPDirs;

     IF (UUCPCount = 0) THEN
     BEGIN
          WriteLn (' þ There are no system directories underneath the spool directory');
          Halt (1);
     END;

     OpenDesktop ('SpoolMgr',PrgVersion);

     ListDefine (2,3,75,20,Default,'System directories under '+SpoolPath,0);
     FOR Lp:=1 TO UUCPCount DO
         ListAddItem (UUCPDirs[Lp],Lp,Sorted);

     Quit:=FALSE;
     REPEAT
           Keuze:=ListSelect (NoTag,[]);

           CASE Key OF
                kEsc : Quit:=TRUE;

                kRet : ExploreSpoolDir (Keuze);

           END; { case }

     UNTIL Quit;

     ListErase;

     CloseDesktop;

     WritePrgLines;
END.
