CP/M/CPM_CDROM.iso/mbug/mbug047.arc/COMPDIR.PAS

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.