home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
lan
/
lan
/
lancomp.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-06-22
|
22KB
|
755 lines
program Compare(input,output);
{
program reads datafile produced by dir and rewrites
appropriate commands into a batch file.
}
const
diagnostic = false;
version = '1.00';
progname = 'LANCOMP';
ctlh = #08;
cret = #13;
linf = #10;
ctrlz= #26;
type
string1=string[1];
string2=string[2];
string30=string[30];
string13=string[13];
data_file =
record
directory:string[30];
filename:string[12];
date_time:string[10];
size:integer;
matched:boolean;
end;
label
notag;
var
infiler: file of char;
outfiler: text;
ch,yesno:char;
xstring:string[30];
xfiles:data_file;
bfiles,cfiles:array [1..200] of data_file;
bchoice,cchoice:integer;
dhard,dsoft:string[1];
len:integer;
labeller:string[10];
drive:string[1];
subdir:string[30];
direc :string[30];
fsize:string[7];
size,result:integer;
text_string:string[80];
time_string:string[80];
yr,mo,da,hr,mn:string[2];
i,j,hour,code:integer;
fname:string[12];
reading,done:boolean;
command_parameter: string[4];
command_length: integer;
command_temp: string[128];
command_line: string[128] absolute cseg:$0080;
procedure make_a_box;
begin
clrscr;
gotoxy(0,0);
writeln ('┌─────────────────────────────────────────────────────────────────────────────┐');
writeln ('│ │');
writeln ('│ │');
writeln ('│ │');
writeln ('│ │');
writeln ('│ │');
writeln ('│ │');
writeln ('│ │');
writeln ('│ │');
writeln ('│ │');
writeln ('│ │');
writeln ('│ │');
writeln ('└─────────────────────────────────────────────────────────────────────────────┘');
gotoxy(29,3);
write ('F L O P P Y - L A N');
gotoxy(52,4);
write ('System (C) by:');
gotoxy(52,6);
write ('Leonard P. Levine');
gotoxy(52,7);
write ('3942 N. Oakland Ave. #241');
gotoxy(52,8);
write ('Shorewood, WI 53211');
gotoxy(52,9);
write ('(414) 962-4719');
gotoxy(52,10);
write ('len@evax.milw.wisc.edu');
gotoxy(3,12);
write ('Program:',progname);
gotoxy(52,12);
write('Version: ',version);
gotoxy(3,5);
write ('Type ^C to ABORT this entire process');
gotoxy(3,10);
write ('Trim option ');
if command_parameter = 'TRIM' then write('ON. ') else write('off.');
gotoxy(52,12);
write('Version: ',version);
gotoxy(3,8);
write('working ... ');
end; {make_a_box}
procedure makeroom;
begin writeln; writeln; writeln; writeln;
writeln; writeln; writeln; writeln;
end;
function fix(str:string2):string2;
begin
if copy(str,1,2) = ' '
then
fix := '00'
else
begin
if copy(str,1,1) = ' '
then
fix := '0' + copy(str,2,1)
else
fix := str;
end;
end; {function fix}
function filefix(filename:string13):string13;
var
filetemp:string13;
i:integer;
begin
filetemp := copy(filename,1,8)+'.'+copy(filename,10,3);
for i := 12 downto 1 do
begin
if copy(filetemp,i,1) = ' ' then filetemp := copy(filetemp,1,i-1)+copy(filetemp,i+1,12);
end;
filefix := filetemp;
end;
function trim(instringer:string30):string30;
var
itrim,counter:integer;
begin
for itrim := length(instringer) downto 1 do
if copy(instringer,itrim,1) = ' ' then counter := itrim-1;
trim := copy(instringer,1,counter);
end;
procedure makesubdir(drivename:string1;dirname:string30);
{
Make a sub-directory when needed.
}
var
dummydir:string[30];
begin
dummydir:=dirname;
if diagnostic then writeln('Make a new directory.');
if diagnostic then writeln('mkdir ',drivename,':',dummydir);
writeln(outfiler,'echo mkdir ',drivename,':',dummydir);
writeln(outfiler,'mkdir ',drivename,':',dummydir);
end; {makesubdir}
procedure makemaindir(drivename:string1;dirlocal:string30);
{
Make a directory when needed.
}
var
loc :integer;
begin
loc := 2;
while (copy(dirlocal,loc-1,1) <> ' ') and (loc < 29) do
begin
if (copy(dirlocal,loc,1) = '\') or (copy(dirlocal,loc,1) = ' ') then
begin
direc := copy(dirlocal,1,loc-1);
makesubdir(drivename,direc);
end;
loc := loc+1;
end;
end; {makemaindir}
procedure toflop;
begin
if diagnostic then
begin
writeln('Hard disk copy of ',cfiles[j].filename,' is newer.');
write ('copy ',dhard,':',trim(cfiles[j].directory),'\');
write (filefix(cfiles[j].filename),' ',dsoft,':');
writeln(trim(cfiles[j].directory),'\',filefix(cfiles[j].filename));
end;
writeln (outfiler,'echo on');
write (outfiler,'copy ',dhard,':',trim(cfiles[j].directory),'\');
write (outfiler,filefix(cfiles[j].filename),' ',dsoft,':');
writeln(outfiler,trim(cfiles[j].directory),'\',filefix(cfiles[j].filename));
writeln (outfiler,'@echo off');
end; {toflop}
procedure tohard;
begin
if diagnostic then writeln('Floppy disk copy of ',bfiles[i].filename,' is newer.');
{ backup the hard file}
if diagnostic then write('copy ',dhard,':',trim(cfiles[j].directory),'\');
if diagnostic then writeln(filefix(cfiles[j].filename),' ',dhard,':\LAN\BAQ >nul:');
write(outfiler,'copy ',dhard,':',trim(cfiles[j].directory),'\');
writeln(outfiler,filefix(cfiles[j].filename),' ',dhard,':\LAN\BAQ >nul:');
{ copy the soft file over to the hard disk}
if diagnostic then write('copy ',dsoft,':',trim(cfiles[j].directory),'\',filefix(cfiles[j].filename));
if diagnostic then writeln(' ',dhard,':',trim(cfiles[j].directory),'\',filefix(cfiles[j].filename));
writeln (outfiler,'echo on');
write(outfiler,'copy ',dsoft,':',trim(cfiles[j].directory),'\',filefix(cfiles[j].filename));
writeln(outfiler,' ',dhard,':',trim(cfiles[j].directory),'\',filefix(cfiles[j].filename));
writeln (outfiler, '@echo off');
{
If command_parameter = 'TRIM',
replace soft file with zero byte file and set its date
}
if command_parameter = 'TRIM' then
begin
if diagnostic then
begin
write ('del ',dsoft,':',trim(cfiles[j].directory));
writeln ('\',filefix(bfiles[i].filename),' >nul:');
write ('touch ',copy(bfiles[i].date_time,3,8)+copy(bfiles[i].date_time,1,2));
writeln (' ',dsoft,':',trim(cfiles[j].directory),'\',filefix(bfiles[i].filename));
end;
write (outfiler,'del ',dsoft,':',trim(cfiles[j].directory));
writeln (outfiler,'\',filefix(bfiles[i].filename),' >nul:');
writeln (outfiler,'touch ',dsoft,':',trim(cfiles[j].directory),'\x_x');
write (outfiler,'ren ',dsoft,':',trim(cfiles[j].directory),'\x_x ');
writeln (outfiler,filefix(bfiles[i].filename));
write (outfiler,'touch ',copy(bfiles[i].date_time,3,8)+copy(bfiles[i].date_time,1,2));
writeln (outfiler,' ',dsoft,':',trim(cfiles[j].directory),'\',filefix(bfiles[i].filename));
end
end; {tohard}
procedure matchup;
begin
for i := 1 to bchoice do
begin
for j := 1 to cchoice do
begin
if (bfiles[i].filename = cfiles[j].filename)
and
(bfiles[i].directory = cfiles[j].directory)
then {a match between two files has been found. }
begin
bfiles[i].matched := true;
cfiles[j].matched := true;
if bfiles[i].date_time < cfiles[j].date_time then
toflop;
if bfiles[i].date_time > cfiles[j].date_time then
if bfiles[i].size > 0 then
tohard
else
begin
makeroom;
writeln('There is a problem with file ',trim(cfiles[j].directory),'\',filefix(cfiles[j].filename));
writeln('(the floppy file is newer, but is of length zero.)');
writeln('(there may be a clock error, no action will be taken.)');
writeln;
write('Strike a key to continue. ');
read(kbd,yesno);
make_a_box;
end;
end;
end;
end;
end;
procedure lastbox;
begin
gotoxy(3,8);
write ('Done. ');
gotoxy(1,13);
writeln ('├─────────────────────────────────────────────────────────────────────────────┤');
writeln ('│ Messages like: "Unable to create directory" are normal when new files │');
writeln ('│ have been added. Messages like "Insufficient disk space" are not. │');
writeln ('└─────────────────────────────────────────────────────────────────────────────┘');
end;
{main Program}
begin
bchoice := 1;
cchoice := 1;
xfiles.matched := false;
command_temp := command_line;
command_length := length(command_temp);
command_parameter := ' ';
if command_length <> 0 then
begin
while copy(command_temp,1,1) = ' ' do
command_temp := copy(command_temp,2,44)+'X'; {clear out blanks}
command_parameter := copy(command_temp,1,4);
end;
if diagnostic then writeln ('The value of the parameter is ',command_parameter);
make_a_box;
assign (infiler,'x1.dat');
assign (outfiler,'x2.bat');
reset (infiler);
rewrite(outfiler);
if not diagnostic then
writeln(outfiler,'@echo off');
writeln(outfiler,'echo --System Messages, if any-----');
while not eof(infiler) do
begin {endfiler}
text_string := 'file: ';
reading := true;
while reading do
begin {reading}
read(infiler,ch);
case ch of
ctrlz: reading := false;
cret: reading := false;
linf: reading := false;
else text_string := text_string + ch;
end;
end; {reading}
if text_string <> 'file: ' then
begin {goodline}
text_string := text_string+' ';
{First establish Volume ID}
if copy(text_string,12,15)='Volume in drive' then
drive:= copy(text_string,28,1);
if copy(text_string,12,12)='Directory of' then
begin
subdir:=copy(text_string,28,30);
xfiles.directory := subdir;
end;
{Then find the files}
if (copy(text_string,11,1) <> ' ')
and
(copy(text_string,11,1) <> '-')
and
(copy(text_string,24,5) <> '<DIR>')
then
begin {foundfile}
if cchoice mod 2 = 1
then
write (' \',ctlh,ctlh,ctlh)
else
write (' /',ctlh,ctlh,ctlh);
if diagnostic then write(drive,':',copy(subdir,1,12));
if diagnostic then writeln(copy(text_string,11,40));
fname := copy(text_string,11,12);
xfiles.filename := fname;
fsize := copy(text_string,25,7);
while copy(fsize,1,1) = ' ' do fsize := copy(fsize,2,30);
if length(fsize) >3 then fsize := '999';
val(fsize,size,result);
xfiles.size := size;
yr := copy(text_string,40,2);
yr := fix(yr);
mo := copy(text_string,34,2);
mo := fix(mo);
da := copy(text_string,37,2);
da := fix(da);
mn := copy(text_string,47,2);
mn := fix(mn);
hr := copy(text_string,44,2);
if hr = '12' then
hr := '00';
if copy(text_string,49,1) = 'p' then
begin
hr := fix(hr);
val(copy(hr,1,2),hour,code);
hour := hour+12;
str(hour:2,hr);
end;
hr := fix(hr);
time_string := yr+mo+da+hr+mn;
xfiles.date_time := time_string;
if (drive = 'A') or (drive = 'B') then
begin
dsoft := drive;
bfiles[bchoice] := xfiles;
bchoice := bchoice + 1;
end;
if (drive = 'C') or (drive = 'D') or (drive = 'E') or (drive = 'F') then
begin
dhard := drive;
cfiles[cchoice] := xfiles;
cchoice := cchoice + 1;
end;
end; {foundfile}
end; {goodline}
end; {endfiler}
bchoice := bchoice - 1;
cchoice := cchoice - 1;
{
Begin the checking Process.
}
if diagnostic then
begin
for i := 1 to bchoice do
begin
writeln(dsoft,':\',trim(bfiles[i].directory),'\',bfiles[i].filename,' ',bfiles[i].date_time,' ',bfiles[i].size);
end;
for i := 1 to cchoice do
begin
writeln(dhard,':\',trim(cfiles[i].directory),'\',cfiles[i].filename,' ',cfiles[i].date_time,' ',bfiles[i].size);
end;
end; {diagnostic print}
matchup;
for j := 1 to cchoice do
begin
if not cfiles[j].matched then
begin
makeroom;
writeln('There is a File On Hard Drive, not on Floppy Drive: ');
writeln;
writeln(dhard,':',trim(cfiles[j].directory),'\',filefix(cfiles[j].filename));
writeln;
write('Should I move it to floppy?(y,n) ');
done := false;
while done <> true do
begin
read(kbd,yesno);
if (upcase(yesno) = 'Y') or (upcase(yesno) = 'N') then done := true;
end;
if upcase(yesno) = 'Y' then
begin
writeln ('Y');
makemaindir(dsoft,cfiles[j].directory);
toflop;
end
else writeln('N');
make_a_box;
end;
end;
for i := 1 to bchoice do
begin
if (not bfiles[i].matched) and (bfiles[i].size > 0) then
begin
makeroom;
writeln('There is a File On Floppy Drive, not on Hard Drive: ');
writeln;
writeln(dsoft,':',trim(bfiles[i].directory),'\',filefix(bfiles[i].filename));
writeln;
write('Should I move it to hard drive?(y,n) ');
done := false;
while done <> true do
begin
read(kbd,yesno);
if (upcase(yesno) = 'Y') or (upcase(yesno) = 'N') then done := true;
end;
if upcase(yesno) = 'Y' then
begin
writeln ('Y');
j := cchoice + 1;
cchoice := cchoice + 1;
cfiles[j] := bfiles[i];
cfiles[j].directory := bfiles[i].directory;
makemaindir(dhard,bfiles[i].directory);
tohard;
end
else writeln('N');
make_a_box;
end;
end;
close(outfiler);
lastbox;
end.
{ Text file looks like the following:
--------------------------------
Volume in drive B has no label
Directory of B:\LAN
LAN FIL 384 6-09-88 1:10p
1 File(s) 40960 bytes free
--------------------------------
Volume in drive C is DRIVE_C
Directory of C:\LAN
LAN FIL 384 6-09-88 1:10p
1 File(s) 5236736 bytes free
--------------------------------
Volume in drive B has no label
Directory of B:\LAN
LAN DOC 7808 6-09-88 11:56a
1 File(s) 40960 bytes free
--------------------------------
Volume in drive C is DRIVE_C
Directory of C:\LAN
LAN DOC 7808 6-09-88 11:56a
1 File(s) 5236736 bytes free
--------------------------------
Volume in drive B has no label
Directory of B:\LAN
LANMKDIR PAS 3090 6-09-88 11:14a
1 File(s) 40960 bytes free
--------------------------------
Volume in drive C is DRIVE_C
Directory of C:\LAN
LANMKDIR PAS 3090 6-09-88 11:14a
1 File(s) 5236736 bytes free
--------------------------------
Volume in drive B has no label
Directory of B:\LAN
LANCOMP PAS 13514 6-09-88 1:17p
1 File(s) 40960 bytes free
--------------------------------
Volume in drive C is DRIVE_C
Directory of C:\LAN
LANCOMP PAS 13514 6-09-88 1:17p
1 File(s) 5236736 bytes free
--------------------------------
Volume in drive B has no label
Directory of B:\LAN
LANMKDIR COM 12799 6-09-88 11:29a
1 File(s) 40960 bytes free
--------------------------------
Volume in drive C is DRIVE_C
Directory of C:\LAN
LANMKDIR COM 12799 6-09-88 11:29a
1 File(s) 5236736 bytes free
--------------------------------
Volume in drive B has no label
Directory of B:\LAN
LANCOMP COM 18929 6-09-88 1:17p
1 File(s) 40960 bytes free
--------------------------------
Volume in drive C is DRIVE_C
Directory of C:\LAN
LANCOMP COM 18929 6-09-88 1:17p
1 File(s) 5234688 bytes free
--------------------------------
Volume in drive B has no label
Directory of B:\AN
NOTES 3141 6-08-88 11:49a
1 File(s) 40960 bytes free
--------------------------------
Volume in drive C is DRIVE_C
Directory of C:\AN
NOTES 3141 6-08-88 11:49a
1 File(s) 5234688 bytes free
--------------------------------
Volume in drive B has no label
Directory of B:\AN
NOTESARC 9024 6-05-88 2:02p
1 File(s) 40960 bytes free
--------------------------------
Volume in drive C is DRIVE_C
Directory of C:\AN
NOTESARC 9024 6-05-88 2:02p
1 File(s) 5234688 bytes free
--------------------------------
Volume in drive B has no label
Directory of B:\AN
WRITINGS 3456 5-18-88 7:09p
1 File(s) 40960 bytes free
--------------------------------
Volume in drive C is DRIVE_C
Directory of C:\AN
WRITINGS 3456 5-18-88 7:09p
1 File(s) 5234688 bytes free
--------------------------------
Volume in drive B has no label
Directory of B:\PHONEDEX
PHONEDEX DBF 34987 6-06-88 2:57p
1 File(s) 40960 bytes free
--------------------------------
Volume in drive C is DRIVE_C
Directory of C:\PHONEDEX
PHONEDEX DBF 34987 6-06-88 2:57p
1 File(s) 5234688 bytes free
--------------------------------
Volume in drive B has no label
Directory of B:\PHONEDEX
PHONEDEX NDX 11776 6-06-88 2:57p
1 File(s) 40960 bytes free
--------------------------------
Volume in drive C is DRIVE_C
Directory of C:\PHONEDEX
PHONEDEX NDX 11776 6-06-88 2:57p
1 File(s) 5234688 bytes free
--------------------------------
Volume in drive B has no label
Directory of B:\LLCLASS
STUDENTS DBF 75894 5-30-88 12:06p
1 File(s) 40960 bytes free
--------------------------------
Volume in drive C is DRIVE_C
Directory of C:\LLCLASS
STUDENTS DBF 75894 5-30-88 12:06p
1 File(s) 5232640 bytes free
--------------------------------
Volume in drive B has no label
Directory of B:\LLCLASS
STUDENTS NDX 63488 5-30-88 11:47a
1 File(s) 40960 bytes free
--------------------------------
Volume in drive C is DRIVE_C
Directory of C:\LLCLASS
STUDENTS NDX 63488 5-30-88 11:47a
1 File(s) 5232640 bytes free
--------------------------------
Volume in drive B has no label
Directory of B:\LLCLASS
E459 DBF 4539 5-18-88 11:37a
1 File(s) 40960 bytes free
--------------------------------
Volume in drive C is DRIVE_C
Directory of C:\LLCLASS
E459 DBF 4539 5-18-88 11:37a
1 File(s) 5232640 bytes free
--------------------------------
Volume in drive B has no label
Directory of B:\LLCLASS
SPECIAL DBF 2048 6-08-88 10:57a
1 File(s) 40960 bytes free
--------------------------------
Volume in drive C is DRIVE_C
Directory of C:\LLCLASS
SPECIAL DBF 2048 6-08-88 10:57a
1 File(s) 5232640 bytes free
--------------------------------
Volume in drive B has no label
Directory of B:\LLCLASS
E459 NTS 4480 3-28-88 9:44a
1 File(s) 40960 bytes free
--------------------------------
Volume in drive C is DRIVE_C
Directory of C:\LLCLASS
E459 NTS 4480 3-28-88 9:44a
1 File(s) 5232640 bytes free
--------------------------------
Volume in drive B has no label
Directory of B:\LLCLASS
E459 EXM 5248 5-08-88 10:52a
1 File(s) 40960 bytes free
--------------------------------
Volume in drive C is DRIVE_C
Directory of C:\LLCLASS
E459 EXM 5248 5-08-88 10:52a
1 File(s) 5232640 bytes free
--------------------------------
Volume in drive B has no label
Directory of B:\LLCLASS
MASTERS DBF 6715 6-08-88 9:19p
1 File(s) 40960 bytes free
--------------------------------
Volume in drive C is DRIVE_C
Directory of C:\LLCLASS
MASTERS DBF 6715 6-08-88 9:19p
1 File(s) 5230592 bytes free
--------------------------------
Volume in drive B has no label
Directory of B:\LLE132
EXAM 132 18432 5-02-88 7:05p
1 File(s) 40960 bytes free
--------------------------------
Volume in drive C is DRIVE_C
Directory of C:\LLE132
EXAM 132 18432 5-02-88 7:05p
1 File(s) 5230592 bytes free
--------------------------------
Volume in drive B has no label
Directory of B:\LLE132
E132 SYL 3456 5-31-88 8:25a
1 File(s) 40960 bytes free
--------------------------------
Volume in drive C is DRIVE_C
Directory of C:\LLE132
E132 SYL 3456 5-31-88 8:25a
1 File(s) 5230592 bytes free
--------------------------------
}