home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 September / Simtel20_Sept92.cdr / msdos / txtutl / filecmp.arc / FILECOMP.PAS < prev    next >
Pascal/Delphi Source File  |  1988-03-03  |  5KB  |  180 lines
  1. program filecomp;
  2.  
  3. {$I pfilenam}
  4. LABEL FIN2;
  5.  
  6. CONST
  7.   BufSize = 16383;   {buffer size -1}
  8.   NumBlks = 128;     {num 128 byte blocks in buffer}
  9.   Blk2N   = 14;      {buffer size as 2**N}
  10. TYPE
  11.   bigary = Array[0..BufSize] of byte;
  12.   str2   = String[2];
  13. VAR
  14.   file1, file2 : file;
  15.   ary1, ary2   : bigary;
  16.   SizeH1, SizeL1, SizeH2, SizeL2 : Integer;
  17.   ReadCounter  : Integer;
  18.   NumReads, ExtraBytes     : Integer;
  19.   PrintCount   : Byte;
  20.   DifCount     : Integer;
  21.   Quitx        : Boolean;
  22.   Name1        : Str8;
  23.   Vers1        : Str4;
  24.  
  25. FUNCTION OpenFile(var filex:file; var sizeH,sizeL:Integer; N:byte):boolean;
  26. LABEL Ofin;
  27. VAR
  28.    filename : str80;
  29.    DandQ    : str64;
  30.    fname    : str8;
  31.    fvers    : str4;
  32.    filelcl  : file of byte;
  33.    xx, yy   : byte;
  34.  
  35. BEGIN
  36.   OpenFile:=False;
  37.   xx := 33;
  38.   IF ParamCount>=N THEN
  39.      BEGIN
  40.      filename:=ParamStr(N);
  41.      Write  ('NAME OF FILE TO COMPARE IS    : ');
  42.      WriteLN(filename);
  43.      END
  44.   ELSE
  45.      BEGIN
  46.      Write  ('ENTER NAME OF FILE TO COMPARE : ');
  47.      ReadLN (filename);
  48.      END;
  49.   yy := WhereY-1;
  50.   if length(filename)+xx > 80 then YY:=YY-1;
  51.   IF filename='' THEN  GOTO Ofin;
  52.   if not ParseFileName(filename, DandQ, Fname, Fvers) then
  53.      BEGIN
  54.      WriteLn('FILE ', filename, ' INVALID');  GOTO Ofin;
  55.      END;
  56.  
  57.   if (Fname='*') and (Fvers='') then Fvers:=Vers1;
  58.   if Fname='*' then  Fname:=Name1;
  59.   if Fvers='.*' then  Fvers:=Vers1;
  60.   FileName := DandQ + Fname + Fvers;
  61.   Name1:=Fname;
  62.   Vers1:=Fvers;
  63.   GotoXY(XX,YY);  WriteLN(filename);
  64.   Assign(filelcl,Filename);
  65. {$I-}
  66.   Reset(Filelcl);
  67. {$I+}
  68.   IF IOresult<>0 THEN
  69.      BEGIN
  70.      WriteLN('FILE ', filename, ' NOT FOUND');  GOTO Ofin;
  71.      END;
  72.   SizeL:=FileSize(fileLCL) AND $FF;
  73.   Close(filelcl);
  74.   Assign(filex,filename); Reset(filex);
  75.   SizeH:=FileSize(Filex); IF SizeL<>0 THEN SizeH:=SizeH-1;  SizeH:=SizeH div 2;
  76.   OpenFile:=True;
  77. Ofin: END {OpenFile};
  78.  
  79. Procedure GetNumReads;
  80. VAR L,H:Integer;
  81. BEGIN
  82.   {first set L,H to smaller of size of File1 or File2}
  83.       L:=SizeL1;  H:=SizeH1;
  84.       IF (SizeH2<SizeH1) OR
  85.          ((SizeH2=SizeH1) AND (SizeL2<SizeL1)) THEN
  86.               BEGIN L:=SizeL2;  H:=SizeH2;  END;
  87.   {NumReads is number of 2**14 byte reads,
  88.    however in the last read, only ExtraBytes are valid}
  89.       H := H + H;  {num of 128 byte blocks in the file}
  90.       NumReads   := H Div NumBlks;
  91.       ExtraBytes := (H Mod NumBlks)*128 + L;
  92.       IF ExtraBytes > 0 THEN  NumReads:=NumReads+1;
  93. END {GetNumReads};
  94.  
  95. Function HexStr(N:Byte):Str2;
  96. Const Hexary : Array[0..15] of Char = '0123456789ABCDEF';
  97. Var I:Byte;
  98. BEGIN
  99. HexStr:=Hexary[(N shr 4) AND $0F]  +  Hexary[N AND $0F];
  100. END {HexStr};
  101.  
  102. Procedure PrintDifference(CharNum:Integer);
  103. VAR ch   : char;
  104.     Temp : Integer;
  105. BEGIN
  106. {ReadCounter is block number (1..n)
  107.  CharNum is count within block (0..16383)}
  108. IF NOT Quitx THEN
  109.    BEGIN
  110.    Temp:=(ReadCounter-1) shr (16-Blk2N);
  111.    Write( HexStr(Temp shr 8)+Hexstr(Temp AND $FF), ':' );
  112.  
  113.    Temp:=((ReadCounter-1) shl Blk2N) + CharNum;
  114.    Write( HexStr(Temp shr 8)+Hexstr(Temp AND $FF) );
  115.  
  116.    Writeln('  ', HexStr(Ary1[CharNum]),'  ', HexStr(Ary2[CharNum]));
  117.    PrintCount:=PrintCount+1;
  118.    DifCount  :=DifCount  +1;
  119.    IF PrintCount=15 THEN
  120.       BEGIN
  121.       PrintCount:=0;
  122.       repeat
  123.          Write('Continue (Y/N) ? '); Read(kbd,ch);  Writeln(ch);
  124.          ch:=Upcase(ch);
  125.          until ch in ['N','Q','Y'];
  126.       QuitX := ch in ['N','Q'];
  127.       END;
  128.    END;
  129. END {PrintDifference};
  130.  
  131.  
  132. Procedure HandleOneRead;
  133. LABEL HORfin;
  134. VAR I,J,N : Integer;
  135. BEGIN
  136.    N:=NumBlks;  J:=BufSize+1;;
  137.    IF ReadCounter=NumReads THEN IF ExtraBytes<>0 THEN
  138.        BEGIN
  139.        N := (ExtraBytes-1) DIV 128 + 1;
  140.        J:=ExtraBytes;
  141.        END;
  142.    BlockRead(file1,ary1,N);
  143.    BlockRead(file2,ary2,N);
  144.    J:=J-1;
  145.    FOR I:=0 TO J DO
  146.        IF Ary1[I]<>Ary2[I] THEN
  147.           begin
  148.           PrintDifference(I);
  149.           IF Quitx THEN  goto HORfin;
  150.           end;
  151. HORfin: END {HandleOneRead};
  152.  
  153. BEGIN
  154. Name1:='*';  Vers1:='*';
  155. PrintCount:=0;  DifCount:=0;  QuitX:=False;
  156. WriteLn('Fast File Compare, by Richard Marks');
  157. IF OpenFile(file1,SizeH1,SizeL1,1) THEN
  158.    BEGIN
  159.    IF OpenFile(file2,SizeH2,SizeL2,2) THEN
  160.       BEGIN
  161.  
  162.       IF (SizeH1>SizeH2) OR
  163.          ((SizeH1=SizeH2) AND (SizeL1>SizeL2)) THEN
  164.                Writeln('File 1 longer than File 2');
  165.       IF (SizeH2>SizeH1) OR
  166.          ((SizeH2=SizeH1) AND (SizeL2>SizeL1)) THEN
  167.                Writeln('File 2 longer than File 1');
  168.  
  169.       GetNumReads;
  170.       FOR ReadCounter:=1 TO NumReads DO
  171.           BEGIN  HandleOneRead;   IF Quitx THEN GOTO FIN2; END;
  172.  
  173.       Writeln(''); Writeln(DifCount, ' Differences.');
  174. FIN2: Close(File2);
  175.       END;
  176.    Close(File1);
  177.    END;
  178.    {set ErrorLevel to Difcount}
  179.    Halt(DifCount);
  180. END .