home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Phoenix CD 2.0
/
Phoenix_CD.cdr
/
15a
/
murutil.zip
/
UPDAT.PAS
< prev
next >
Wrap
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: (505) 881-0519
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.