home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
MBUG
/
MBUG047.ARC
/
COMPDIR.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1979-12-31
|
6KB
|
312 lines
{ This program is a utility to compare the directory entries of two
diskettes and report any differences.
by Tom Onishi
version 1.1
Dec. 8, 1986 }
type
String11 = String[11];
DirecArray = Array[1..128] of String11;
const
FindFirst = $11;
FindNext = $12;
SetDMA = $1A;
ResetD = $25;
var
DMA : Array[0..127] of Byte;
FCB : Array[0..35] of Byte;
Drive : Char;
Count : Integer;
AReg, CReg : Integer;
MaxEnt1,
MaxEnt2 : Integer;
Direc1, Direc2 : DirecArray;
Quit : Boolean;
ChangeDisks : Boolean;
Procedure Initialise;
type
CharSet = Set of Char;
var
LegalDrive : CharSet;
begin
ClrScr;
GotoXY(27,3);
Writeln('COMPARE DIRECTORIES V1.0');
GotoXY(28,5);
Writeln('by Tom Onishi 2/12/86');
LegalDrive := ['A'..'P'];
Repeat
GotoXY(5,10);
Write('Drive of disks to be compared? ');
Read(Drive);
Drive := Upcase(Drive);
If not (Drive in LegalDrive)
then Writeln(' Drivespec Error.', ^G)
else ClrEol
Until Drive in LegalDrive
end; {Initialise}
Procedure ResetDisk;
var
x,n : Integer;
DriveBit : Integer;
begin
x:= 1;
DriveBit := x Shl (Ord(Drive) - Ord('A'));
Bdos(ResetD, DriveBit);
Bdos(SetDMA, Addr(DMA));
FillChar(FCB, Sizeof(FCB), 0);
FCB[0] := 1 + Ord(Drive) - Ord('A');
For n := 1 to 11 do
FCB[n] := Ord('?');
CReg := FindFirst
end; {ResetDisk}
Procedure OneEntry(var D : DirecArray);
var
i, y : Integer;
TempEntry : String11;
begin
AReg := Bdos(CReg, Addr(FCB));
If AReg <> $FF then
begin
y := AReg Shl 5;
TempEntry[0] := Chr(11);
For i := 1 to 11 do
TempEntry[i] := Chr(DMA[y+i]);
D[Count] := TempEntry
end
end; {OneEntry}
Procedure GetDirec( var Dir : DirecArray);
begin
ResetDisk;
Count := 1;
OneEntry(Dir);
If AReg = $FF
then
begin
Writeln('Disk has no entries.');
Halt
end
else
CReg := FindNext;
While AReg <> $FF do
begin
Count := Count + 1;
OneEntry(Dir)
end
end; {GetDirec}
Function Strip(Entry : String11) : String11;
{ This function strips the systems flags in the filetype.}
var
i : Integer;
begin
For i := 1 to 11 do
begin
If Ord(Entry[i]) >= 128
then Entry[i] := Chr(Ord(Entry[i]) - 128)
end; {For}
Strip := Entry
end; {Strip}
Procedure Sort(var Dir : DirecArray; n : Integer);
var
i, j : Integer;
Bottom, Middle, Top : Integer;
Temp : String11;
begin
For i := 2 to n do
begin
Temp := Dir[i];
Bottom := 1;
Top := i - 1;
While Bottom <= Top do
begin
Middle := (Bottom + Top) div 2;
If Strip(Temp) < Strip(Dir[Middle])
then Top := Middle - 1
else Bottom := Middle + 1
end; {while}
For j := i - 1 downto Bottom do
Dir[j+1] := Dir[j];
Dir[Bottom] := Temp
end {for}
end; {Sort}
Function Option : Integer;
var
i, e : Integer;
Temp,
DiskName : String11;
Selection : Char;
begin
ClrScr;
GotoXY(10,3);
Temp := Direc1[1];
If Temp[1] = '-'
then DiskName := Temp
else DiskName := 'first disk';
Writeln('<1> - List of files exclusive to ', DiskName, '.');
GotoXY(10,4);
Temp := Direc2[1];
If Temp[1] = '-'
then DiskName := Temp
else DiskName := 'second disk';
Writeln('<2> - List of files exclusive to ', DiskName, '.');
GotoXY(10,5);
Writeln('<3> - List of files common to both disks.');
GotoXY(10,6);
Writeln('<4> - Compare new disks.');
GotoXY(10,7);
Writeln('<5> - Quit.');
Repeat
GotoXY(5,10);
Write('Enter Selection : ');
Read(Kbd, Selection);
Val(Selection, i, e);
If e = 0
then Option := i
else Write(^G^G)
Until e = 0
end; {Option}
Procedure Exclusive(D1, D2 : DirecArray; Max1, max2 : Integer);
var
i, n, x : Integer;
begin
ClrScr;
x := 0;
i := 1;
n := 1;
While (i <= Max1) and (n <= Max2) do
begin
If D1[i] = D2[n]
then
begin
i := i + 1;
n := n + 1
end
else
begin
If D1[i] > D2[n]
then n := n + 1
else
begin
If x Mod 5 = 0
then Writeln
else Write(' : ');
Write(D1[i]);
x := x + 1;
i := i + 1
end
end
end; {while}
GotoXY(5,24);
Write('Press <RETURN> for Menu.');
Readln
end; {Exclusive}
Procedure Common(D1, D2 : DirecArray; Max1, Max2 : Integer);
var
i, n, x : Integer;
begin
i := 1;
n := 1;
x := 0;
ClrScr;
While (i <= Max1) and (n <= Max2) do
begin
If D1[i] < D2[n]
then
i := i + 1
else
begin
If D1[i] = D2[n]
then
begin
If x Mod 5 = 0
then Writeln
else Write(' : ');
Write(D1[i]);
i := i + 1;
n := n + 1;
x := x + 1
end
else
n := n + 1
end
end;
GotoXY(5,24);
Write('Press <RETURN> for Menu.');
Readln
end; {Common}
Begin
Initialise;
Repeat
ChangeDisks := false;
GotoXY(5,14);
Write('Insert first disk into Drive ', Drive, ' and press <RETURN>:');
Readln;
GetDirec(Direc1);
MaxEnt1 := Count - 1;
Sort(Direc1, MaxEnt1);
GotoXY(5,15);
Write('Insert second disk into Drive ', Drive, ' and press <RETURN>:');
Readln;
GetDirec(Direc2);
MaxEnt2 := Count - 1;
Sort(Direc2, MaxEnt2);
Repeat
Quit := false;
Case Option of
1 : Exclusive(Direc1, Direc2, MaxEnt1, MaxEnt2);
2 : Exclusive(Direc2, Direc1, MaxEnt2, MaxEnt1);
3 : Common(Direc1, Direc2, MaxEnt1, MaxEnt2);
4 : begin
ChangeDisks := true;
Quit := true
end;
5 : Quit := true;
Else Writeln(^G^G)
end {case}
Until Quit
Until not ChangeDisks
End.