Aminet 18/aminetcdnumber181997.iso/Aminet/util/cli/CompareHT.lha/Compare/Compare.mod

Text File | 1997-03-28 | 5.3 KB | 187 lines

|##########|
|#MAGIC   #|ELNAGMHM
|#PROJECT #|"Compare"
|#PATHS   #|"StdProject"
|#FLAGS   #|xx---x--xx--xxx-x---------------
|#USERSW  #|--------------------------------
|#USERMASK#|--------------------------------
|#SWITCHES#|x----x----------
|##########|

MODULE Compare;

FROM T_Dos       AS td IMPORT AllDosErr, NoFreeStore, ArgErr,
                              RequiredArgMissing;
FROM Dos               IMPORT TypeGrp, DosMiscGrp, DosIOGrp, DosArgGrp,
                              IoErr, Examine, ExNext, CurrentDir,
                              Unlock, DupLock, PrintFault,
                              FileLockPtr, FileHandlePtr, FileInfoBlockPtr,
                              OpenFromLock, Lock, VPrintf, AssertDos;
FROM System            IMPORT Regs, SysStringPtr, GuruId;
FROM Exec              IMPORT AllocMem, FreeMem;

TYPE
  MemBlock = POINTER TO ARRAY OF BYTE;

VAR
  tab, n     : INTEGER := 0;
  offsetFail : LONGINT;

CONST
  ErrorStr = "*** Error";

PROCEDURE CompareMem(mem1 IN A0,mem2 IN A1 : MemBlock;
                     len  IN D2            : LONGCARD; ) : LONGINT;

VAR pos IN D3 : LONGCARD

| Lösung mit Array-Pointer geht nur mit Filelängen bis 32767
BEGIN
(*
  pos := 0;
  REPEAT
    IF mem1+^#mem2+^ THEN EXIT END;
    INC (pos);
    DEC (len);
  UNTIL =;
*)
  ASSEMBLE(
    CLR pos
    loop:
      CMP.B (mem1)+,(mem2)+
      BNE exit
      ADD #1,pos
      SUB #1,len
    BNE loop
    exit:
  );

  IF len=0 THEN
    RETURN -1;
  ELSE
    RETURN pos;
  END;
END CompareMem;

PROCEDURE Check (file1, file2 : FileLockPtr);
VAR
  info1, info2 : FileInfoBlockPtr := NIL;
  lock1, lock2 : FileLockPtr      := NIL;

  PROCEDURE CheckDir;
  VAR
    oldLock : FileLockPtr;
  BEGIN
    FORGET VPrintf ("%s, %s <dir>"+&10, info1.fileName'ADR, info2.fileName'ADR);
    INC (tab);
    WHILE ExNext (file1, info1) DO
      TRY
        TRACK
          oldLock := CurrentDir (file1);
          lock1 := Lock (info1.fileName'PTR, sharedLock); AssertDos (#);
          FORGET CurrentDir (file2);
          | gleicher Name im anderen Verzeichnis!
          lock2 := Lock (info1.fileName'PTR, sharedLock); AssertDos (#);
          Check (lock1, lock2);
        CLOSE
          FORGET CurrentDir (oldLock);
          IF lock1#NIL THEN Unlock(lock1) END;
          IF lock2#NIL THEN Unlock(lock2) END;
        END;
      EXCEPT OF AllDosErr THEN FORGET PrintFault (IoErrors(GuruId), ErrorStr) END;
      END;
    END;
    DEC (tab);
  END CheckDir;

  PROCEDURE CheckFile;
  VAR
    fh1,   fh2   : FileHandlePtr := NIL;
    mem1,  mem2  : MemBlock      := NIL;
  BEGIN
    IF info1.size > info2.size THEN
      FORGET VPrintf ("*** Error: %s > %s", info1.fileName'ADR, info2.fileName'ADR);
    OR_IF < THEN
      FORGET VPrintf ("*** Error: %s < %s", info1.fileName'ADR, info2.fileName'ADR);
    ELSE
      FORGET VPrintf ("%s = %s", info1.fileName'ADR, info2.fileName'ADR);   | WriteBuffer;
      offsetFail := -1;
      IF (info1.size>0) AND (info2.size>0) THEN
        TRACK
          mem1 := AllocMem (info1.size, {}); ASSERT (#, NoFreeStore);
          mem2 := AllocMem (info2.size, {}); ASSERT (#, NoFreeStore);
          lock1 := DupLock (file1);    AssertDos (#);
          lock2 := DupLock (file2);    AssertDos (#);
          | DupLock muß sein, weil OpenFromLock den Lock unlockt
          fh1 := OpenFromLock (lock1); AssertDos (#);
          fh2 := OpenFromLock (lock2); AssertDos (#);
          FORGET Read (fh1, mem1, info1.size);
          FORGET Read (fh2, mem2, info2.size);

          offsetFail := CompareMem (mem1, mem2, info1.size);
        CLOSE
          IF mem1#NIL THEN FreeMem (mem1, info1.size) END;
          IF mem2#NIL THEN FreeMem (mem2, info2.size) END;
          IF fh1#NIL  THEN FORGET Close (fh1) END;
          IF fh2#NIL  THEN FORGET Close (fh2) END;
        END;
      END;
      IF offsetFail # -1 THEN
        FORGET VPrintf (", *** Difference in Byte $%lx", offsetFail);
      ELSE
        FORGET VPrintf (" Ok");
      END;
    END;
    FORGET PutStr (&10*);
  END CheckFile;

BEGIN
  TRY
    TRACK
      FOR n:=tab-1 TO 0 BY -1 DO FORGET PutStr ("  ") END;
      info1 := AllocDosObject (FIB, DONE); AssertDos (#);
      FORGET Examine (file1, info1);
      info2 := AllocDosObject (FIB, DONE); AssertDos (#);
      FORGET Examine (file2, info2);
      IF (info1.dirEntryType<root) AND (info2.dirEntryType<root) THEN
        CheckFile;
      OR_IF (info1.dirEntryType>=root) AND (info2.dirEntryType>=root) THEN
        CheckDir;
      ELSE
        FORGET VPrintf ("%s - can't compare dir and file", info1.fileName'ADR);
      END;
    CLOSE
      IF info1#NIL THEN FreeDosObject (FIB, info1) END;
      IF info2#NIL THEN FreeDosObject (FIB, info2) END;
    END;
  EXCEPT
    OF AllDosErr THEN FORGET PrintFault (IoErrors(GuruId), ErrorStr) END;
  END;
END Check;

CONST
  Template = "SRC/A,DST/A";

TYPE
  ArgRec   = RECORD src, dst : SysStringPtr END;

VAR
  RD       : RDArgsPtr := NIL;
  args     := ArgRec : ("", "");
  lock1, lock2 : FileLockPtr := NIL;

BEGIN
  TRY
    RD := ReadArgs (Template, args'PTR, NIL); AssertDos (#);
    lock1 := Lock (args.src, sharedLock); AssertDos (#);
    lock2 := Lock (args.dst, sharedLock); AssertDos (#);
    Check (lock1, lock2);
  EXCEPT
    OF AllDosErr, ArgErr THEN FORGET PrintFault (IoErrors(GuruId), ErrorStr) END;
  END;
CLOSE
  IF lock1#NIL THEN Unlock(lock1) END;
  IF lock2#NIL THEN Unlock(lock2) END;
  IF RD   #NIL THEN FreeArgs (RD) END;
END Compare.