home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / files / fileman / fm / fmfile.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-08-23  |  23.4 KB  |  695 lines
  1. {
  2. --------------------------------------------------------------------------
  3.                        F i l e    I n f o r m a t i o n
  4.  
  5. * DESCRIPTION
  6. File used with FM.PAS.
  7.  
  8. * ASSOCIATED FILES
  9. FM.PAS
  10. FM.DOC
  11. FM.EXE
  12. FM.TPU
  13. FMFILE.PAS
  14. FMINPUT.PAS
  15. FMSCREEN.PAS
  16. FMUTEST.EXE
  17. FMUTEST.PAS
  18. FMVIEW.PAS
  19.  
  20. ==========================================================================
  21. }
  22. {$R-}    { Range checking off }                         { Unit:    FMFile.PAS }
  23. {$S-}    { Stack checking off }                         { Program: FM.PAS     }
  24. {$V+}    { Strict String type checking on }             { Author:  Jim Zwick  }
  25. {$B-}    { Boolean short-circuit evaluation on }        { Version: 1.0        }
  26. {$I-}    { I/O checking off }                           { Date:    03-04-88   }
  27.  
  28. UNIT FMFile;
  29.  
  30. INTERFACE
  31.  
  32. USES
  33.   Crt,
  34.   Dos,
  35.   FMScreen,
  36.   FMInput;
  37.  
  38. TYPE
  39.   FileBufferType = ARRAY[1..65530] OF CHAR;
  40.   Str12   = STRING[12];
  41.   Str128  = STRING[128];
  42.   FilePtr = ^FileRec;
  43.   FileRec = RECORD
  44.               Key  : Str12;
  45.               FNum : INTEGER;
  46.               Mark : BOOLEAN;
  47.               Next : FilePtr;
  48.               Last : FilePtr;
  49.             END;
  50.  
  51. VAR
  52.   Attribute           : WORD;                 { Used to store file attributes }
  53.   SpoolOK             : BOOLEAN;
  54.   FirstFile, LastFile : FilePtr;
  55.   CurrFile            : FilePtr;
  56.   FileBuffer          : ^FileBufferType;
  57.   FileBufSize         : WORD;
  58.   Mask                : Str12;
  59.   CurrDir             : Str80;
  60.  
  61.  
  62.   PROCEDURE GetFilesList(Mask : Str12; VAR FirstFN, LastFN : FilePtr;
  63.                 VAR ListCount : WORD);
  64.   PROCEDURE DeleteFile(VAR FirstPtr, LastPtr : FilePtr; OldKey : Str12);
  65.   FUNCTION EnvSearch(SearchStr : Str80) : Str128;
  66.   PROCEDURE SpoolFile(FN : Str80; VAR Ok : BOOLEAN);
  67.   PROCEDURE ControlSpool;
  68.   PROCEDURE EraseFile;
  69.   PROCEDURE RenameFile;
  70.   PROCEDURE CopyFile;
  71.   PROCEDURE MoveFile;
  72.   PROCEDURE GetCurrDir;
  73.   PROCEDURE GetNewDirectory;
  74.  
  75.  
  76. IMPLEMENTATION
  77.  
  78.   FUNCTION DOSversion : REAL;
  79.   VAR
  80.     DReg     : Registers;
  81.     Maj, Min : INTEGER;
  82.   BEGIN
  83.     DReg.AH := $30;
  84.     INTR($21, DReg);
  85.     Maj := DReg.AL;
  86.     Min := DReg.AH;
  87.     DOSversion := Maj + (Min DIV 100);
  88.   END;
  89.   { ------------------------------------------------------------------------- }
  90.  
  91.   FUNCTION Exist(FN : Str80) : BOOLEAN;
  92.   VAR
  93.     DirInfo : SearchRec;
  94.   BEGIN
  95.     FindFirst(FN, ReadOnly + Hidden + SysFile, DirInfo);
  96.     Exist := (DosError = 0) AND (POS('*', FN) = 0) AND (POS('?', FN) = 0);
  97.   END;
  98.   { ------------------------------------------------------------------------- }
  99.  
  100.   FUNCTION DiskFull(SourceName : Str80; Drive : WORD) : BOOLEAN;
  101.   VAR
  102.     FV   : FILE OF BYTE;                       { Check to see if copy of file }
  103.     Attr : WORD;                               { will fit on destination disk }
  104.   BEGIN                                        { before copying               }
  105.     DiskFull := TRUE;
  106.     ASSIGN(FV, SourceName);
  107.     GetFAttr(FV, Attr);
  108.     SetFAttr(FV, Archive);
  109.     RESET(FV);
  110.     IF (IOResult = 0) THEN DiskFull := (DiskFree(Drive) < FileSize(FV));
  111.     CLOSE(FV);
  112.     IF (IOResult = 0) THEN SetFAttr(FV, Attr);
  113.   END;
  114.   { ------------------------------------------------------------------------- }
  115.  
  116.   PROCEDURE InsertFile(VAR FirstPtr, LastPtr, NewPtr : FilePtr);
  117.   VAR
  118.     SearchPtr : FilePtr;                       { FirstPtr and LastPtr must be }
  119.     Found     : BOOLEAN;                       { initialized to NIL before    }
  120.   BEGIN                                        { calling this routine the     }
  121.     SearchPtr := FirstPtr;                     { first time.  NewPtr must be  }
  122.     Found := FALSE;                            { allocated and initialized    }
  123.     NewPtr^.Next := NIL;
  124.     NewPtr^.Last := NIL;
  125.     IF (SearchPtr = NIL) THEN
  126.       BEGIN
  127.         FirstPtr := NewPtr;
  128.         LastPtr := FirstPtr;
  129.       END
  130.     ELSE
  131.       BEGIN
  132.         WHILE (SearchPtr <> NIL) AND (NOT Found) DO
  133.           IF (SearchPtr^.Key < NewPtr^.Key) THEN SearchPtr := SearchPtr^.Next
  134.           ELSE Found := TRUE;
  135.         NewPtr^.Next := SearchPtr;
  136.         IF (SearchPtr = FirstPtr) THEN
  137.           BEGIN
  138.             FirstPtr := NewPtr;
  139.             SearchPtr^.Last := FirstPtr;
  140.           END
  141.         ELSE IF (SearchPtr = NIL) THEN
  142.           BEGIN
  143.             NewPtr^.Last := LastPtr;
  144.             LastPtr^.Next := NewPtr;
  145.             LastPtr := NewPtr;
  146.           END
  147.         ELSE
  148.           BEGIN
  149.             NewPtr^.Last := SearchPtr^.Last;
  150.             SearchPtr^.Last^.Next := NewPtr;
  151.             SearchPtr^.Last := NewPtr;
  152.           END;
  153.       END;
  154.   END;
  155.   { ------------------------------------------------------------------------- }
  156.  
  157.   PROCEDURE DeleteFile(VAR FirstPtr, LastPtr : FilePtr; OldKey : Str12);
  158.   VAR
  159.     DelPtr : FilePtr;                             { FirstPtr and LastPtr must }
  160.   BEGIN                                           { be initialized to NIL     }
  161.     IF (FirstPtr = NIL) THEN DelPtr := NIL        { before calling  this      }
  162.     ELSE IF (OldKey = FirstPtr^.Key) THEN         { routine the first time    }
  163.       BEGIN
  164.         DelPtr := FirstPtr;
  165.         FirstPtr := FirstPtr^.Next;
  166.         IF (FirstPtr <> NIL) THEN FirstPtr^.Last := NIL;
  167.         IF (FirstPtr = NIL) THEN LastPtr := NIL;
  168.       END
  169.     ELSE IF (OldKey = LastPtr^.Key) THEN
  170.       BEGIN
  171.         DelPtr := LastPtr;
  172.         LastPtr := LastPtr^.Last;
  173.         IF (LastPtr <> NIL) THEN LastPtr^.Next := NIL;
  174.       END
  175.     ELSE
  176.       BEGIN
  177.         DelPtr := FirstPtr;
  178.         WHILE (DelPtr <> NIL) AND (DelPtr^.Key <> OldKey) DO
  179.           DelPtr := DelPtr^.Next;
  180.         IF (DelPtr <> NIL) THEN
  181.           BEGIN
  182.             DelPtr^.Next^.Last := DelPtr^.Last;
  183.             DelPtr^.Last^.Next := DelPtr^.Next;
  184.           END;
  185.       END;
  186.     IF (DelPtr <> NIL) THEN DISPOSE(DelPtr);
  187.   END;
  188.   { ------------------------------------------------------------------------- }
  189.  
  190.   PROCEDURE GetFilesList(Mask : Str12; VAR FirstFN, LastFN : FilePtr;
  191.                                              VAR ListCount : WORD);
  192.   VAR
  193.     TempPtr : FilePtr;               { FirstFN and LastFN must be initialized }
  194.     NewFRec : FileRec;               { to NIL before calling this routine the }
  195.     DirInfo : SearchRec;             { first time.  See Initialization below. }
  196.   BEGIN
  197.     WHILE (FirstFN <> NIL) DO DeleteFile(FirstFN, LastFN, FirstFN^.Key);
  198.     ListCount := 0;
  199.     FindFirst(Mask, ReadOnly, DirInfo);
  200.     WHILE (DosError = 0) DO
  201.       BEGIN
  202.         NewFRec.Key := DirInfo.Name;
  203.         NewFRec.Mark := FALSE;
  204.         NEW(TempPtr);
  205.         TempPtr^ := NewFRec;
  206.         InsertFile(FirstFN, LastFN, TempPtr);
  207.         FindNext(DirInfo);
  208.       END;
  209.     TempPtr := FirstFN;
  210.     WHILE (TempPtr <> NIL) DO
  211.       BEGIN
  212.         Inc(ListCount);
  213.         TempPtr^.FNum := ListCount;
  214.         TempPtr := TempPtr^.Next;
  215.       END;
  216.   END;
  217.   { ------------------------------------------------------------------------- }
  218.  
  219.   FUNCTION EnvSearch(SearchStr : Str80) : Str128;
  220.   VAR
  221.     EnvPtr        : ^INTEGER;   { Searches environment for left side of an    }
  222.     MemOffSet     : INTEGER;    { assignment statement and returns the right. }
  223.     EnvCh         : CHAR;       { This can be very useful with Turbo 4.0 EXEC }
  224.     ELeft, ERight : Str128;     { in finding COMSPEC so it can be loaded from }
  225.     EndOfEnviron  : BOOLEAN;    { any drive rather than using an              }
  226.   BEGIN                         { EXEC('\COMMAND.COM', '') statement.         }
  227.     EnvPtr := Ptr(PrefixSeg, $002C);    { Pointer to beginning of Environment }
  228.     MemOffSet := 0;
  229.     ERight[0] := #0;
  230.     REPEAT
  231.       ELeft[0] := #0;
  232.       EnvCh := CHR(MEM[EnvPtr^:MemOffSet]);
  233.       Inc(MemOffSet);
  234.       EndOfEnviron := (EnvCh = #0);
  235.       WHILE (EnvCh <> '=') AND (EnvCh <> #0) DO     { Read Env until equal    }
  236.         BEGIN                                       { found.  If equal found  }
  237.           ELeft := ELeft + EnvCh;                   { but ERight <> SearchStr }
  238.           EnvCh := CHR(MEM[EnvPtr^:MemOffSet]);     { then read until end of  }
  239.           Inc(MemOffSet);                           { assignment statement.   }
  240.         END;
  241.       IF (ELeft = SearchStr) THEN
  242.         BEGIN
  243.           EnvCh := CHR(MEM[EnvPtr^:MemOffSet]);             { Skip equal sign }
  244.           Inc(MemOffSet);
  245.           WHILE (EnvCh <> #0) DO
  246.             BEGIN                                     { Read Env until end of }
  247.               ERight := ERight + EnvCh;               { assignment statement  }
  248.               EnvCh := CHR(MEM[EnvPtr^:MemOffSet]);
  249.               Inc(MemOffSet);
  250.             END;
  251.         END;
  252.     UNTIL (ELeft = SearchStr) OR (EndOfEnviron);
  253.     EnvSearch := ERight;
  254.   END;
  255.   { ------------------------------------------------------------------------- }
  256.  
  257.   PROCEDURE SpoolStat(VAR Ok : BOOLEAN);           { Checks availablity of    }
  258.   VAR                                              { PRINT spooler.  DOS 3.xx }
  259.     StatReg : Registers;                           { is required and PRINT    }
  260.     RCode   : BYTE;                                { must be installed before }
  261.   BEGIN                                            { starting programs which  }
  262.     Ok := FALSE;                                   { use these routines.  Ok  }
  263.     IF (DOSversion >= 3.0) THEN                    { will return FALSE if DOS }
  264.       BEGIN                                        { version is less than 3.0 }
  265.         StatReg.AH := FCarry;                      { or if PRINT has not been }
  266.         StatReg.AL := $00;                         { installed.               }
  267.         INTR($2F, StatReg);
  268.         IF ((StatReg.FLAGS AND FCarry) <> FCarry) THEN
  269.           Ok := (StatReg.AL = 255);
  270.       END;
  271.   END;
  272.   { ------------------------------------------------------------------------- }
  273.  
  274.   PROCEDURE SpoolFile(FN : Str80; VAR Ok : BOOLEAN);
  275.   TYPE                                              { Sends FN to PRINT spool }
  276.     SubmitPacket = RECORD
  277.                       LevCode : BYTE;     { LevCode is apparently meaningless }
  278.                       FileOFS : INTEGER;  { but must be set to 0 and included }
  279.                       FileSEG : INTEGER;  { in the Submit Packet anyway.      }
  280.                     END;
  281.   VAR
  282.     SubPack : SubmitPacket;
  283.     SpReg   : Registers;
  284.   BEGIN
  285.     FN := FN + #0;                      { File names must be in ASCIIZ format }
  286.     WITH SubPack DO
  287.       BEGIN
  288.         LevCode := $00;
  289.         FileSEG := SEG(FN[1]);
  290.         FileOFS := OFS(FN[1]);
  291.       END;
  292.     WITH SpReg DO
  293.       BEGIN
  294.         AH := FCarry;
  295.         AL := FCarry;
  296.         DS := SEG(SubPack);
  297.         DX := OFS(SubPack);
  298.       END;
  299.     INTR($2F, SpReg);
  300.     Ok := ((SpReg.FLAGS AND FCarry) <> FCarry);
  301.   END;
  302.   { ------------------------------------------------------------------------- }
  303.  
  304.   PROCEDURE Cancel(VAR Ok : BOOLEAN);    { Cancels all files from print spool }
  305.   VAR
  306.     SpReg : Registers;
  307.   BEGIN
  308.     SpReg.AH := FCarry;
  309.     SpReg.AL := $03;
  310.     INTR($2F, SpReg);
  311.     Ok := ((SpReg.FLAGS AND FCarry) <> FCarry);
  312.   END;
  313.   { ------------------------------------------------------------------------- }
  314.  
  315.   PROCEDURE DeleteFromSpool(FSpec : Str80; VAR Ok : BOOLEAN);
  316.   VAR
  317.     SpReg : Registers;             { Deletes all files that match FSpec from  }
  318.   BEGIN                            { spool.  FSpec must be a full filespec    }
  319.     FSpec := FSpec + #0;           { but DOS wildcard characters * and ? can  }
  320.     WITH SpReg DO                  { be used.                                 }
  321.       BEGIN
  322.         AH := FCarry;
  323.         AL := $02;
  324.         DS := SEG(FSpec[1]);
  325.         DX := OFS(FSpec[1]);
  326.       END;
  327.     INTR($2F, SpReg);
  328.     Ok := (SpReg.FLAGS AND FCarry) <> FCarry;
  329.   END;
  330.   { ------------------------------------------------------------------------- }
  331.  
  332. TYPE                                               { Max Queue is 32 files    }
  333.   SpList = ARRAY[1..32] OF ARRAY[1..64] OF CHAR;   { Name length is always 64 }
  334.  
  335.   PROCEDURE GetSpoolQue(VAR QBuf : SpList; VAR Ok : BOOLEAN);
  336.   VAR
  337.     SpReg : Registers;                             { MOVEs current queue from }
  338.   BEGIN                                            { DS:SI to QBuf for return }
  339.      SpReg.AH := FCarry;                           { to ListQue.              }
  340.      SpReg.AL := $04;                                          { Access Queue }
  341.      INTR($2F, SpReg);
  342.      IF ((SpReg.FLAGS AND FCarry) <> FCarry) THEN
  343.        BEGIN
  344.          MOVE(MEM[SpReg.DS:SpReg.SI], MEM[SEG(QBuf[1]):OFS(QBuf[1])], 2048);
  345.          Ok := TRUE;
  346.        END
  347.      ELSE Ok := FALSE;
  348.      SpReg.AH := FCarry;
  349.      SpReg.AL := $05;                                        { Unfreeze Queue }
  350.      INTR($2F, SpReg);
  351.   END;
  352.   { ------------------------------------------------------------------------- }
  353.  
  354.   PROCEDURE ListQue(VAR NumberOfFiles: BYTE);
  355.   VAR
  356.     Y, Entry, Loc : BYTE;
  357.     QList         : SpList;
  358.     SpoolOK       : BOOLEAN;
  359.   BEGIN
  360.     GetSpoolQue(QList, SpoolOK);
  361.     Entry := 1;
  362.     Y := 4;
  363.     IF SpoolOK THEN            { Write memory contents only if queue is there }
  364.       BEGIN
  365.         HIGHVIDEO;
  366.         GotoXY(2, 3);    WRITE('QUEUE');
  367.         LOWVIDEO;
  368.         WHILE (QList[Entry, 1] <> #0) AND (Entry < 33) DO
  369.           BEGIN
  370.             IF ((Entry MOD 17) = 0) THEN
  371.               BEGIN
  372.                 WritePrompt(2, Y, 'More');
  373.                 FOR Y := 4 TO 19 DO ClrLn(1, Y);
  374.                 Y := 4;
  375.               END;
  376.             Loc := 1;
  377.             GotoXY(2, Y);
  378.             WHILE (QList[Entry, Loc] <> CHR(0)) AND (Loc < 65) DO
  379.               BEGIN
  380.                 WRITE(QList[Entry, Loc]);
  381.                 Inc(Loc);
  382.               END;
  383.             Inc(Y);
  384.             Inc(Entry);
  385.           END;
  386.         HIGHVIDEO;
  387.         GotoXY(2, Y);    WRITE('END OF QUEUE');
  388.         LOWVIDEO;
  389.       END
  390.     ELSE WritePrompt(2, 3, 'ERROR Reading Queue');
  391.     NumberOfFiles := PRED(Entry);
  392.   END;
  393.   { ------------------------------------------------------------------------- }
  394.  
  395.   PROCEDURE Help;
  396.   VAR
  397.     Reply : CHAR;
  398.   BEGIN
  399.     WOpen(4);
  400.     ClrScr;
  401.     WRITELN;
  402.     WRITELN(' Print - Enter file to spool.');
  403.     WRITELN;
  404.     WRITELN(' Cancel File - Delete specific files from');
  405.     WRITELN('    spool.  DOS wildcard characters can be');
  406.     WRITELN('    used.');
  407.     WRITELN;
  408.     WRITELN(' Cancel All - Cancel all files from spool.');
  409.     WRITELN('    If printer is not on program may hang');
  410.     WRITELN('    temporarily before displaying status.');
  411.     WRITELN;
  412.     WRITELN(' <Esc> - Exit to File Manager.');
  413.     Reply := GetKey(#27, FALSE);
  414.     WClose;
  415.   END;
  416.   { ------------------------------------------------------------------------- }
  417.  
  418.   PROCEDURE ControlSpool;
  419.   VAR
  420.     Reply    : CHAR;
  421.     FilSpec  : Str80;
  422.     NumFiles : BYTE;
  423.     SpOK     : BOOLEAN;
  424.     NewScr   : BOOLEAN;
  425.   BEGIN
  426.     WOpen(1);
  427.     NewScr := TRUE;
  428.     CursorOn(FALSE);
  429.     REPEAT
  430.       IF NewScr THEN
  431.         BEGIN
  432.           ClrScr;
  433.           ListQue(NumFiles);
  434.           GotoXY(25, 22);
  435.           WRITE('rint   Cancel File   Cancel All');
  436.           HIGHVIDEO;
  437.           GotoXY(24, 22);     WRITE('P');
  438.           GotoXY(39, 22);     WRITE('F');
  439.           GotoXY(53, 22);     WRITE('A');
  440.           LOWVIDEO;
  441.           GotoXY(70, 1);      WRITE(NumFiles:2, ' Files');
  442.         END;
  443.       Reply := GetKey(#0+#27+'PFA', TRUE);
  444.       NewScr := FALSE;
  445.       CASE Reply OF
  446.         'P',
  447.         'F' : BEGIN
  448.                 GotoXY(2, 2);   WRITE('File Spec:');
  449.                 FilSpec := '';
  450.                 ReadStr(13, 2, 64, FilSpec);
  451.                 CursorOn(FALSE);
  452.                 IF (FilSpec <> '') THEN
  453.                   BEGIN
  454.                     IF (POS('\', FilSpec) = 0) THEN             { Add PATH if }
  455.                       FilSpec := CurrDir + FilSpec;             { not entered }
  456.                     IF (Reply = 'P') THEN SpoolFile(FilSpec, SpOK)
  457.                     ELSE DeleteFromSpool(FilSpec, SpOK);
  458.                     IF (NOT SpOK) THEN
  459.                       IF (Reply = 'P') THEN
  460.                         WritePrompt(2, 2, 'ERROR Submitting File to Queue')
  461.                       ELSE
  462.                         WritePrompt(2, 2, 'Error Deleting File(s) From Queue');
  463.                   END;
  464.                 NewScr := TRUE;
  465.               END;
  466.         'A' : BEGIN
  467.                 Cancel(SpOK);
  468.                 IF (NOT SpOK) THEN
  469.                   WritePrompt(2, 2, 'ERROR Clearing Queue');
  470.                 NewScr := TRUE;
  471.               END;
  472.         F1 : Help;
  473.       END;
  474.     UNTIL (Reply = #27);
  475.     WClose;
  476.   END;
  477.   { ------------------------------------------------------------------------- }
  478.  
  479.   PROCEDURE EraseFile;
  480.   VAR
  481.     TempFPtr : FilePtr;
  482.     Reply    : CHAR;
  483.     FilVar   : FILE;
  484.   BEGIN
  485.     TempFPtr := FirstFile;
  486.     HIGHVIDEO;
  487.     ClrLn(2, 4);
  488.     WRITE('Erase Marked File(s) From Disk (Y/N)? Y', ^H);
  489.     LOWVIDEO;
  490.     Reply := GetKey(#13+#27+'YN', TRUE);
  491.     CursorOn(FALSE);
  492.     IF (Reply = #13) THEN Reply := 'Y';
  493.     ClrLn(2, 4);
  494.     IF (Reply = 'Y') THEN
  495.       WHILE (TempFPtr <> NIL) DO
  496.         BEGIN
  497.           IF (TempFPtr^.Mark) THEN
  498.             BEGIN
  499.               ASSIGN(FilVar, TempFPtr^.Key);
  500.               GetFAttr(FilVar, Attribute);
  501.               IF ((Attribute AND ReadOnly) <> 0) THEN
  502.                 WritePrompt(2, 4, TempFPtr^.Key + ' is Read-Only')
  503.               ELSE
  504.                 BEGIN
  505.                   ERASE(FilVar);
  506.                   IF (IOResult <> 0) THEN
  507.                     WritePrompt(2, 4, 'ERROR: Unable to Erase '
  508.                       + TempFPtr^.Key);
  509.                 END;
  510.             END;
  511.           TempFPtr := TempFPtr^.Next;
  512.         END;
  513.   END;
  514.   { ------------------------------------------------------------------------- }
  515.  
  516.   PROCEDURE RenameFile;
  517.   VAR
  518.     OldName, NewName : Str80;
  519.     FilVar           : FILE;
  520.   BEGIN
  521.     OldName := CurrDir + CurrFile^.Key;
  522.     NewName[0] := #0;
  523.     ClrLn(2, 3);      WRITE('Old Spec:  ', OldName);
  524.     GotoXY(2, 4);     WRITE('New Spec:');
  525.     NewName := '';
  526.     ReadStr(13, 4, 64, NewName);
  527.     IF (NewName[0] <> #0) THEN
  528.       BEGIN
  529.         IF Exist(NewName) THEN WritePrompt(2, 4, 'File Already Exists')
  530.         ELSE
  531.           BEGIN
  532.             ASSIGN(FilVar, OldName);
  533.             GetFAttr(FilVar, Attribute);
  534.             SetFAttr(FilVar, Archive);
  535.             RENAME(FilVar, NewName);
  536.             IF (IOResult = 0) THEN SetFAttr(FilVar, Attribute)
  537.             ELSE WritePrompt(2, 4, 'ERROR: Unable to Rename File');
  538.           END;
  539.       END;
  540.   END;
  541.   { ------------------------------------------------------------------------- }
  542.  
  543.   PROCEDURE GetDestPath(VAR DPath : Str80);
  544.   BEGIN
  545.     GotoXY(2, 2);    WRITE('Curr Path:');
  546.     ClrLn(2, 3);     WRITE('Dest Path:');
  547.     DPath[0] := #0;
  548.     ReadStr(13, 3, 52, DPath);
  549.     CursorOn(FALSE);
  550.     IF (DPath[0] <> #0) AND (DPath[LENGTH(DPath)] <> '\') THEN
  551.         DPath := DPath + '\';
  552.   END;
  553.   { ------------------------------------------------------------------------- }
  554.  
  555.   PROCEDURE CopyFile;
  556.   VAR
  557.     TempFRec      : FilePtr;
  558.     Source, Dest  : FILE;
  559.     DestPath      : Str80;
  560.     SourceName    : Str80;
  561.     DestName      : Str80;
  562.     RecsRead      : WORD;
  563.     DestDrive     : WORD;
  564.   BEGIN
  565.     GetDestPath(DestPath);
  566.     IF (DestPath[0] <> #0) THEN
  567.       BEGIN
  568.         IF (LENGTH(DestPath) > 1) AND (DestPath[2] = ':') THEN
  569.           DestDrive := (ORD(UPCASE(DestPath[1])) - 64)
  570.         ELSE DestDrive := 0;
  571.         FileBufSize := SIZEOF(FileBufferType);          { Set Max FileBufSize }
  572.         IF (MaxAvail < FileBufSize) THEN FileBufSize := MaxAvail;
  573.         GETMEM(FileBuffer, FileBufSize);
  574.         TempFRec := FirstFile;
  575.         WHILE (TempFRec <> NIL) DO
  576.           BEGIN
  577.             IF (TempFRec^.Mark) THEN
  578.               BEGIN
  579.                 SourceName := CurrDir + TempFRec^.Key;
  580.                 DestName := DestPath + TempFRec^.Key;
  581.                 IF Exist(DestName) THEN
  582.                   WritePrompt(2, 4, DestName + ' Already Exists')
  583.                 ELSE
  584.                   BEGIN
  585.                     ASSIGN(Source, SourceName);
  586.                     GetFAttr(Source, Attribute);
  587.                     SetFAttr(Source, Archive);
  588.                     IF DiskFull(SourceName, DestDrive) THEN
  589.                       BEGIN
  590.                         WritePrompt(2, 4, 'Disk Full');
  591.                         TempFRec := LastFile;
  592.                       END
  593.                     ELSE
  594.                       BEGIN
  595.                         RESET(Source, 1);
  596.                         ASSIGN(Dest, DestName);
  597.                         REWRITE(Dest, 1);
  598.                         IF (IOResult = 0) THEN
  599.                           BEGIN
  600.                             WHILE NOT EOF(Source) DO
  601.                               BEGIN
  602.                                 BlockRead(Source, FileBuffer^, FileBufSize, RecsRead);
  603.                                 BlockWrite(Dest, FileBuffer^, RecsRead);
  604.                               END;
  605.                           END;
  606.                         CLOSE(Source);
  607.                         IF (IOResult = 0) THEN SetFAttr(Source, Attribute);
  608.                         CLOSE(Dest);
  609.                         IF (IOResult <> 0) THEN ;
  610.                       END;
  611.                   END;
  612.               END;
  613.             TempFRec := TempFRec^.Next;
  614.           END;
  615.         FREEMEM(FileBuffer, FileBufSize);
  616.       END;
  617.   END;
  618.   { ------------------------------------------------------------------------- }
  619.  
  620.   PROCEDURE MoveFile;
  621.   VAR
  622.     TempFRec   : FilePtr;
  623.     Source     : FILE;
  624.     DestPath   : Str80;
  625.     SourceName : Str80;
  626.     DestName   : Str80;
  627.   BEGIN
  628.     GetDestPath(DestPath);
  629.     IF (DestPath[0] <> #0) THEN
  630.       BEGIN
  631.         TempFRec := FirstFile;
  632.         WHILE (TempFRec <> NIL) DO
  633.           BEGIN
  634.             IF (TempFRec^.Mark) THEN
  635.               BEGIN
  636.                 SourceName := CurrDir + TempFRec^.Key;
  637.                 DestName := DestPath + TempFRec^.Key;
  638.                 IF Exist(DestName) THEN
  639.                   WritePrompt(2, 4, DestName + ' Already Exists')
  640.                 ELSE
  641.                   BEGIN
  642.                     ASSIGN(Source, SourceName);
  643.                     GetFAttr(Source, Attribute);
  644.                     SetFAttr(Source, Archive);
  645.                     RENAME(Source, DestName);
  646.                     IF (IOResult <> 0) THEN
  647.                       WritePrompt(2, 4, 'Unable to Move ' + SourceName)
  648.                     ELSE SetFAttr(Source, Attribute);
  649.                   END;
  650.               END;
  651.             TempFRec := TempFRec^.Next;
  652.           END;
  653.       END;
  654.   END;
  655.   { ------------------------------------------------------------------------- }
  656.  
  657.   PROCEDURE GetCurrDir;
  658.   BEGIN
  659.     GetDir(0, CurrDir);
  660.     IF (CurrDir[LENGTH(CurrDir)] <> '\') THEN CurrDir := CurrDir + '\';
  661.   END;
  662.   { ------------------------------------------------------------------------- }
  663.  
  664.   PROCEDURE GetNewDirectory;
  665.   VAR
  666.     NewDir : Str80;
  667.     Err    : BOOLEAN;
  668.   BEGIN
  669.     REPEAT
  670.       Err := FALSE;
  671.       NewDir[0] := #0;
  672.       ReadStr(13, 2, 64, NewDir);
  673.       IF (NewDir[0] <> #0) THEN
  674.         BEGIN
  675.           ChDir(NewDir);
  676.           IF (IOResult = 0) THEN GetCurrDir
  677.           ELSE
  678.             BEGIN
  679.               Err := TRUE;
  680.               WritePrompt(13, 2, 'ERROR: Directory Not Found');
  681.             END;
  682.         END;
  683.     UNTIL (NOT Err);
  684.     GotoXY(13, 2);    WRITE(CurrDir);
  685.   END;
  686.   { ------------------------------------------------------------------------- }
  687.  
  688. BEGIN
  689.   SpoolStat(SpoolOK);
  690.   FirstFile := NIL;
  691.   LastFile := NIL;
  692.   CurrFile := NIL;
  693. END.
  694. 
  695.