Phoenix CD 2.0/Phoenix_CD.cdr/15a/murutil.zip/UPDAT.PAS

Pascal/Delphi Source File | 1986-06-09 | 9KB | 318 lines

PROGRAM UPDAT;

{  This Turbo Pascal program generates a BATCH file,  UPD.BAT,  based
   on a SOURCE directory, SRS.DIR,  and a TARGET directory,  TAR.DIR,
   which copies files from the SOURCE directory  (or device)  to  the
   TARGET directory (or device) in alphabetical order and -- if files
   already exist on the target disk  --  so  that  the  most  current
   version of the file is copied to, or remains on, the TARGET disk.

   Note:  Files with blank extensions  (presumably  directory  files)
          and files with extensions  starting  with  "~"  (presumably
          Norton Editor backup files) are not copied to the TARGET.

   Program by:
                Harry M. Murphy, Consultant
                3912 Hilton Avenue, NE
                Albuquerque, NM  87110
                Tel:  [phone]
                2 June 1986.  }

{  NOTICE:

            Copyright 1986, Harry M. Murphy.

            A general license is hereby  granted  for  non-commercial
            use,  copying and free exchange of this  program  without
            payment of any royalties,  provided that  this  copyright
            notice is not altered nor deleted.   All other rights are
            reserved.  Harry M. Murphy  }

CONST
      FILELEN = 12;
      LONGLEN = 127;
      MAXLIST = 1000;

TYPE
     FILENAM = STRING[FILELEN];
     FILEREC = RECORD
                 NAME : FILENAM;
                 DATE : INTEGER;
                 TIME : INTEGER
               END;
     FILELST = ARRAY [1..MAXLIST] OF FILEREC;
     LONGNAM = STRING[LONGLEN];

VAR
    NCPY   : INTEGER;
    NSRS   : INTEGER;
    NTAR   : INTEGER;
    SRSFIL : FILELST;
    SRSNAM : LONGNAM;
    TARFIL : FILELST;
    TARNAM : LONGNAM;


PROCEDURE GETDIRECT(      NAME: FILENAM;
                    VAR DIRFIL: FILELST;
                    VAR   NDIR: INTEGER;
                    VAR DIRNAM: LONGNAM);

{  This procedure reads the SOURCE or TARGET directory file specified
   by NAME and generates a list of file  names,  creation  dates  and
   creation times DIRFIL.NAME, DIRFIL.DATE and DIRFIL.TIME.   On  re-
   turn, NDIR is the number of entries in DIRFIL and DIRNAME  is  the
   directory name (and path).  }

CONST
      LINELEN = 40;

VAR
    INP  : TEXT[512];
    LINE : STRING[LINELEN];
    LL   : 0..LINELEN;


FUNCTION NUM(CH: CHAR): INTEGER;  {Internal to GETDIRECT }

{  This function returns the integer corresponding to  the  digit
   given in CH.  If CH is blank or a non-digit, NUM returns zero.  }

BEGIN  { Function NUM }
  IF CH IN ['0'..'9']
    THEN
      NUM := ORD(CH)-ORD('0')
    ELSE
      NUM := 0
END { Function NUM };


BEGIN  { Procedure GETDIRECT }
  WRITELN;
  ASSIGN(INP,NAME);
  {$I-} RESET(INP) {$I+};
  IF (IORESULT <>0)
    THEN
      BEGIN
        NORMVIDEO;
        WRITELN('  Can''t open file ',NAME,'!');
        LOWVIDEO;
        HALT
      END
    ELSE
      WRITELN('  Reading file ',NAME);
  NDIR := 0;
  WHILE NOT EOF(INP) DO
    BEGIN
      READLN(INP,LINE);
      LL := LENGTH(LINE);
      IF LL>2
        THEN
          BEGIN
            IF COPY(LINE,2,12)='Directory of'
              THEN
                BEGIN
                  DIRNAM := COPY(LINE,16,LL-15);
                  IF DIRNAM[LL-15]<>'\'
                    THEN
                      BEGIN
                        DIRNAM[LL-14] := '\';
                        DIRNAM[0] := CHR(LL-14)
                      END
                END
              ELSE
                IF (LINE[36] = ':')  AND
                   (LINE[1] <> '.')  AND
                   (LINE[10] <> '~') AND
                   (COPY(LINE,10,3) <> '   ')
                  THEN
                    BEGIN
                      NDIR := NDIR+1;
                      LINE[9] := '.';
                      WITH DIRFIL[NDIR] DO
                        BEGIN
                          NAME := COPY(LINE,1,12);
                          DATE := ((NUM(LINE[30])-8)*10+
                                    NUM(LINE[31]))*366+
                                   (NUM(LINE[27])*10+
                                    NUM(LINE[28])-1)*31+
                                    NUM(LINE[24])*10+
                                    NUM(LINE[25]);
                          TIME := ((NUM(LINE[34])*10+
                                    NUM(LINE[35]))*10+
                                    NUM(LINE[37]))*10+
                                    NUM(LINE[38])
                        END { WITH }
                    END
          END
    END;
    CLOSE(INP);
    ERASE(INP);
    WRITELN('  ',NAME,' is a directory of ',DIRNAM);
    WRITELN('  Number of files in ',NAME,': ',NDIR)
END { Procedure GETDIRECT };

PROCEDURE FILEPACK(VAR TMPNAM: FILENAM);

{  This routine packs the non-blank characters in the string variable,
   TMPNAM,  and sets the length of TMPNAM to the number  of  non-blank
   characters.  }

VAR
    I : 1..FILELEN;
    J : 0..FILELEN;

BEGIN  { Procedure FILEPACK }
  J := 0;
  FOR I:=1 TO FILELEN DO
    IF TMPNAM[I] <> ' '
      THEN
        BEGIN
          J := J+1;
          TMPNAM[J] := TMPNAM[I]
        END;
  TMPNAM[0] := CHR(J)
END { Procedure FILEPACK };


PROCEDURE FILESORT(VAR DIRFIL: FILELST; NDIR: INTEGER);

{  This routine sorts the directory array, DIRFIL, in ascending order,
   using a modified Shell sort algorithm.   NDIR is the length of  the
   array.  }

VAR
    I:    INTEGER;
    IM:   INTEGER;
    J:    INTEGER;
    M:    INTEGER;
    SWAP: BOOLEAN;
    TEMP: FILEREC;

BEGIN  { Procedure FILESORT }
  IF NDIR > 1
    THEN
      BEGIN
        M := 1;
        WHILE M < NDIR DO M := 2*M;
        M := M-1;
        WHILE M > 1 DO
          BEGIN
            M := M DIV 2;
            FOR J:=1 TO NDIR-M DO
              BEGIN
                I := J;
                REPEAT
                  IM := I+M;
                  SWAP := DIRFIL[I].NAME > DIRFIL[IM].NAME;
                  IF SWAP
                    THEN
                      BEGIN
                        TEMP := DIRFIL[I];
                        DIRFIL[I] := DIRFIL[IM];
                        DIRFIL[IM] := TEMP;
                        I := I-M
                      END
                UNTIL (I <1 ) OR (NOT SWAP)
              END
          END
      END
END { Procedure FILESORT };


PROCEDURE GENUPDFILE;

{  This routine generates the update file, UPD.BAT, which copies the
   selected files from the SOURCE to the TARGET.  }

VAR
  I: INTEGER;
  J: INTEGER;
  LINE: LONGNAM;
  TMPDAT: INTEGER;
  TMPNAM: FILENAM;
  TMPTIM: INTEGER;
  UPD:    TEXT[512];

BEGIN  { Procedure GENUPDFILE }
  WRITELN;
  ASSIGN(UPD,'UPD.BAT');
  {$I-} REWRITE(UPD) {$I+};
  IF (IORESULT <> 0)
    THEN
      BEGIN
        NORMVIDEO;
        WRITELN('  Can''t open file UPD.BAT!');
        LOWVIDEO;
        HALT
      END
    ELSE
      WRITELN('  Writing file UPD.BAT.');
  NCPY := 0;
  J := 1;
  FOR I:=1 TO NSRS DO
    BEGIN
      WITH SRSFIL[I] DO
        BEGIN
          TMPNAM := NAME;
          TMPDAT := DATE;
          TMPTIM := TIME
        END { WITH };
      IF (TMPNAM <> 'SRS     .DIR') AND
         (TMPNAM <> 'TAR     .DIR') AND
         (TMPNAM <> 'UPD     .DIR')
        THEN
          BEGIN
            WHILE (TARFIL[J].NAME < TMPNAM) AND (J<NTAR)
              DO J := J+1;
            IF  (TARFIL[J].NAME <> TMPNAM) OR
               ((TARFIL[J].NAME =  TMPNAM) AND
               ((TARFIL[J].DATE <  TMPDAT) OR
               ((TARFIL[J].DATE =  TMPDAT) AND
                (TARFIL[J].TIME <  TMPTIM))))
              THEN
                BEGIN
                  FILEPACK(TMPNAM);
                  LINE := 'COPY '+SRSNAM+TMPNAM+' '+
                                  TARNAM+TMPNAM+'/V';
                  WRITELN(UPD,LINE);
                  NCPY := NCPY+1
                END
          END
    END;
  WRITELN(UPD,'UPDKILL');
  CLOSE(UPD);
  WRITELN('  File UPD.BAT written.');
  WRITELN('  Number of files to copy:',NCPY:5,'.');
  WRITELN
END { Procedure GENUPDFILE };


BEGIN  { Program UPDAT }
  LOWVIDEO;
  WRITELN('Program UPDAT running . . .');
  GETDIRECT('SRS.DIR',SRSFIL,NSRS,SRSNAM);
  IF NSRS > 0
    THEN
      BEGIN
        IF NSRS > 1 THEN FILESORT(SRSFIL,NSRS);
        GETDIRECT('TAR.DIR',TARFIL,NTAR,TARNAM);
        IF NTAR = 0
          THEN
            BEGIN
              WITH TARFIL[1] DO
                BEGIN
                  NAME := 'ZZZZZZZZ.ZZZ';
                  DATE := 0;
                  TIME := 0
                END;
              NTAR := 1
            END
          ELSE
            IF NTAR > 1 THEN FILESORT(TARFIL,NTAR);
        GENUPDFILE;
      END
    ELSE
      WRITELN('  No files to be copied.')
END.