Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/MURUTIL4.ZIP/DIFF.PAS

Pascal/Delphi Source File | 1988-04-18 | 15.2 KB | 639 lines

PROGRAM DIFF;

{$N-  Don't use the numeric coprocessor.}

{  This Turbo Pascal V4.0 program compares two text files  and  displays
   the differences (if any) and writes an optional difference file.

   DIFF syntax:  DIFF A_file.ext B_file.ext [outfile.ext]

   Version:  21 January 1988.

   Program by:  Harry M. Murphy, Consultant
                3912 Hilton Avenue, NE
                Albuquerque, NM  87110
                Tel:  [phone]


                                NOTICE

                    Copyright 1988, Harry M. Murphy.

       A general license is hereby  granted  for  non-commercial
       use,  copying and free exchange of this  program  without
       payment of any royalties,  provided that  this  copyright
       notice is not altered nor deleted.   All other rights are
       reserved.   This program is supplied as-is and the author
       hereby disclaims all warranties,  expressed  or  implied,
       including any and all warranties of  merchantability  and
       any and all warranties of suitability  for  any  purpose.
       Use of this program in  any  way  whatsoever  constitutes
       acceptance of the terms of this license. }

USES
  CRT,
  DOS;

CONST
  BUFFSIZE = 2048; { I/O file buffer size.                    }
  DELWIND  = 4;    { Display window half-width.               }
  LBUFFMAX = 31;   { Line buffer maximum index.  Must = 2^n-1 }
  RECDLEN  = 133;  { Text record maximum length.              }
  SPECLEN  = 65;   { File specification maximum length.       }
  SYNTAX   = 'DIFF syntax:  DIFF A_file.ext B_file.ext [outfile.ext]';
  WINDOW   = 9;    { The display window size;  2*DELWIND+1.   }

TYPE
  FILESPEC   = STRING[SPECLEN];
  RECD       = STRING[RECDLEN];

VAR
  ABUF : ARRAY[1..BUFFSIZE] OF CHAR;
  AEOF : BOOLEAN;
  AFIL : TEXT;
  AINP : WORD;
  ALNC : INTEGER;
  ALNO : ARRAY[0..LBUFFMAX] OF INTEGER;
  APTR : WORD;
  AREC : ARRAY[0..LBUFFMAX] OF RECD;
  ASPC : FILESPEC;

  BBUF : ARRAY[1..BUFFSIZE] OF CHAR;
  BEOF : BOOLEAN;
  BFIL : TEXT;
  BINP : WORD;
  BLNC : INTEGER;
  BLNO : ARRAY[0..LBUFFMAX] OF INTEGER;
  BPTR : WORD;
  BREC : ARRAY[0..LBUFFMAX] OF RECD;
  BSPC : FILESPEC;

  DFIL : TEXT;
  DOPN : BOOLEAN;
  DSPC : FILESPEC;

  ABRT : BOOLEAN;
  BAR1 : BOOLEAN;
  DIFR : BOOLEAN;
  DONE : BOOLEAN;
  NDIF : WORD;

{ -------------------------------- }

PROCEDURE BEEP(FREQ, DUR: WORD);

{  This Turbo Pascal V4.0 procedure outputs sound of frequency FREQ Hz
   and duration DUR milliseconds,

   where:  20 <= FREQ <= 8192 Hz,
     and:  10 <= DUR  <= 10000 milliseconds.

   Note:  USES CRT;

   Procedure by Harry M. Murphy  --  31 December 1987.  }

CONST
  LOFREQ = 20;
  HIFREQ = 8192;
  MINDUR = 10;
  MAXDUR = 10000;

BEGIN
  IF FREQ < LOFREQ
    THEN
      FREQ := LOFREQ
    ELSE
      IF FREQ > HIFREQ
        THEN
          FREQ := HIFREQ;
  SOUND(FREQ);
  IF DUR < MINDUR
    THEN
      DUR := MINDUR
    ELSE
      IF DUR > MAXDUR
        THEN
          DUR := MAXDUR;
  DELAY(DUR);
  NOSOUND
END { Procedure BEEP };

{ -------------------------------- }

FUNCTION DATTIMST: STRING;

{  This Turbo Pascal function returns the current date/time as an
   seventeen-byte string of the form:  "14:57h, 20 Jun 87".

   Note:  USES DOS;

   Function by Harry M. Murphy,  20 June 1987.
   Updated for Turbo Pascal V4.0 by H.M.M. on 28 November 1987. }

CONST
      MONTHS = ' Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec ';

  VAR
      DA  : WORD;
      DTG : STRING[18];
      HR  : WORD;
      MN  : WORD;
      MO  : WORD;
      REG : REGISTERS;
      SC  : WORD;
      TH  : WORD;
      WK  : WORD;
      YR  : WORD;

 FUNCTION DIGIT(N: INTEGER): CHAR;  { Internal to DATTIMST. }

 BEGIN
   DIGIT := CHR((N MOD 10)+ORD('0'))
 END { Internal Function DIGIT };


BEGIN { DATTIMST }
  GETDATE(YR,MO,DA,WK);
  GETTIME(HR,MN,SC,TH);
  DTG := DIGIT(HR DIV 10)+DIGIT(HR)+':'+
         DIGIT(MN DIV 10)+DIGIT(MN)+'h, '+
         DIGIT(DA DIV 10)+DIGIT(DA)+
         COPY(MONTHS,4*MO-3,5)+
         DIGIT(YR DIV 10)+DIGIT(YR);
  IF DTG[9] = '0' THEN DTG[9] := ' ';
  DATTIMST := DTG
END { Function DATTIMST };

{ -------------------------------- }

PROCEDURE PUTBLANK;

{  This procedure displays a blank line and writes a blank line to the
   output file, DFIL, if that file is open.  }

BEGIN
  WRITELN;
  IF DOPN THEN WRITELN(DFIL)
END { Procedure PUTBLANK };

{ -------------------------------- }

PROCEDURE PUTSTRING(S: STRING);

{  This procedure displays the string, S, and writes the string to the
   output file, DFIL, if that file is open.  }

BEGIN
  WRITELN(S);
  IF DOPN THEN WRITELN(DFIL,S)
END { Procedure PUTSTRING };

{ -------------------------------- }

FUNCTION STRI(N: LONGINT; W: INTEGER): STRING;

{  This Turbo Pascal V4.0 function returns the string representation  of
   its integer argument, N.   If W is greater than zero,  it is used  to
   define the Width of the number.

   Function by Harry M. Murphy  --  17 December 1987.  }

VAR
  S : STRING;

BEGIN
  IF W > 0
    THEN
      STR(N:W,S)
    ELSE
      STR(N,S);
  STRI := S
END { Function STRI };

{ -------------------------------- }

FUNCTION TRIMSTRING(S: STRING): STRING;

{  This function returns the string,  S,  with trailing blanks,  if any,
   removed.  An all-blank string is returned as a null string.

   Function by Harry M. Murphy  --  24 December 1987.  }

VAR
  L : BYTE;

BEGIN
  L := LENGTH(S);
  WHILE (S[L] = ' ') AND (L > 1) DO L := PRED(L);
  IF S[L] = ' '
    THEN
      TRIMSTRING := ''
    ELSE
      TRIMSTRING := COPY(S,1,L)
END { Function TRIMSTRING };

{ -------------------------------- }

FUNCTION UPSTRING(S : STRING): STRING;

{  This Turbo Pascal V4.0 function returns its input string with all
   lower-case alphabetic characters changed to uppercase.

   Function by Harry M. Murphy  --  1 January 1988.  }

VAR
  L : WORD;

BEGIN
  FOR L :=1 TO LENGTH(S) DO S[L] := UPCASE(S[L]);
  UPSTRING := S
END { Function UPSTRING };

{ -------------------------------- }

PROCEDURE CHECKKEYBD;

{  This Turbo Pascal V4.0 procedure  checks  the  keyboard  for  a  user
   interrupt.   If a key was struck,  the procedure pauses and waits for
   the user to hit another key before returning.   If the struck key  is
   a control-C or an Esc, the procedure sets the flag, DONE, to TRUE. }

CONST
   NOTE =
       'Pausing...  Hit Esc or ^C to quit;  any other key to continue.';
   TAB  = '        ';

TYPE
  TEXTLINE = ARRAY[1..80] OF WORD;

VAR
  CH     : CHAR;
  LINE25 : TEXTLINE ABSOLUTE $B800: $0F00;  { Line 25 in video memory. }
  SAVE   : WORD;
  SAVE25 : TEXTLINE;
  XS,YS  : BYTE;

BEGIN
  IF KEYPRESSED
    THEN
      BEGIN
        WHILE KEYPRESSED DO CH := READKEY;
        SAVE25 := LINE25;
        SAVE := TEXTATTR;
        TEXTATTR := (SAVE AND $0080) OR
                   ((SAVE SHR 4) AND $0007) OR
                   ((SAVE SHL 4) AND $0070);
        XS := WHEREX;
        YS := WHEREY;
        GOTOXY(1,25);
        WRITE(TAB,NOTE,TAB);
        TEXTATTR := SAVE;
        GOTOXY(XS,YS);
        BEEP(880,50);
        WHILE NOT KEYPRESSED DO;
        LINE25 := SAVE25;
        CH := READKEY;
        ABRT := CH IN [#3,#27];
        IF ABRT THEN DONE := TRUE;
        WHILE KEYPRESSED DO CH := READKEY
      END
END { Procedure CHECKKEYBD };

{ -------------------------------- }

PROCEDURE COMPARE(VAR DIFR: BOOLEAN);

{  This procedure compares the A- and B-records at the  current  pointer
   positions.  If they do not compare, DIFR, is returned as TRUE and the
   difference counter,  NDIF is incremented,  otherwise DIFR is returned
   FALSE.   If either pointer is at end-of-file,  the global flag, DONE,
   is set to TRUE.  }

BEGIN
  DIFR := AREC[APTR] <> BREC[BPTR];
  IF DIFR THEN NDIF := SUCC(NDIF);
  IF (ALNO[APTR] < 0) OR (BLNO[BPTR] < 0) THEN DONE := TRUE
END { Procedure COMPARE };

{ -------------------------------- }

PROCEDURE FILLBUFF;

CONST
  EOFMARK = '<<<<<   E N D   O F   F I L E   >>>>>';

VAR
  LINE : RECD;
  TOP  : WORD;

BEGIN
  IF NOT AEOF
    THEN
      BEGIN
        TOP := (APTR+LBUFFMAX-DELWIND) AND LBUFFMAX;
        WHILE (AINP <> TOP) AND (NOT EOF(AFIL)) DO
          BEGIN
            READLN(AFIL,LINE);
            ALNC := SUCC(ALNC);
            ALNO[AINP] := ALNC;
            AREC[AINP] := TRIMSTRING(LINE);
            AINP := SUCC(AINP) AND LBUFFMAX
          END;
        IF AINP <> TOP
          THEN
            BEGIN
              ALNO[AINP] := -SUCC(ALNC);
              AREC[AINP] := EOFMARK;
              AEOF := TRUE
            END
      END;

  IF NOT BEOF
    THEN
      BEGIN
        TOP := (BPTR+LBUFFMAX-DELWIND) AND LBUFFMAX;
        WHILE (BINP <> TOP) AND (NOT EOF(BFIL)) DO
          BEGIN
            READLN(BFIL,LINE);
            BLNC := SUCC(BLNC);
            BLNO[BINP] := BLNC;
            BREC[BINP] := TRIMSTRING(LINE);
            BINP := SUCC(BINP) AND LBUFFMAX
          END;
        IF BINP <> TOP
          THEN
            BEGIN
              BLNO[BINP] := -SUCC(BLNC);
              BREC[BINP] := EOFMARK;
              BEOF := TRUE
            END
      END

END { Procedure FILLBUFF };

{ -------------------------------- }

PROCEDURE GETFILES;

  PROCEDURE ABORT(FS: FILESPEC); { Internal to GETFILES }

  BEGIN
    HIGHVIDEO;
    WRITELN('ERROR!  Can''t open file ',FS);
    NORMVIDEO;
    BEEP(220,200);
    HALT
  END  { Internal Procedure ABORT };

BEGIN { Procedure GETFILES }
  IF (PARAMCOUNT < 2) OR (PARAMCOUNT > 3)
    THEN
      BEGIN
        WRITELN(SYNTAX);
        BEEP(880,100);
        HALT
      END
    ELSE
      BEGIN
        ASPC := UPSTRING(PARAMSTR(1));
        ASSIGN(AFIL,ASPC);
        SETTEXTBUF(AFIL,ABUF,BUFFSIZE);
        {$I-} RESET(AFIL) {$I+};
        IF IORESULT <> 0 THEN ABORT(ASPC);

        BSPC := UPSTRING(PARAMSTR(2));
        ASSIGN(BFIL,BSPC);
        SETTEXTBUF(BFIL,BBUF,BUFFSIZE);
        {$I-} RESET(BFIL) {$I+};
        IF IORESULT <> 0 THEN ABORT(BSPC);

        IF PARAMCOUNT = 3
          THEN
            BEGIN
              DSPC := UPSTRING(PARAMSTR(3));
              IF (DSPC = ASPC) OR (DSPC = BSPC) THEN ABORT(DSPC);
              ASSIGN(DFIL,DSPC);
              {$I-} REWRITE(DFIL) {$I+};
              IF IORESULT <> 0 THEN ABORT(DSPC);
              DOPN := TRUE
            END
          ELSE
            DOPN := FALSE
      END
END { Procedure GETFILES };

{ -------------------------------- }

PROCEDURE INCRBUFF;

{  This procedure increments the A- and B-buffer pointers.  }

BEGIN
  IF ALNO[APTR] >= 0 THEN APTR := SUCC(APTR) AND LBUFFMAX;
  IF BLNO[BPTR] >= 0 THEN BPTR := SUCC(BPTR) AND LBUFFMAX
END { Procedure INCRBUFF };

{ -------------------------------- }

PROCEDURE INITBUFF;

{  This procedure initializes the A- and B-buffers, line numbers and
   pointers.  }

BEGIN
  FOR APTR := 0 TO DELWIND DO
    BEGIN
      ALNO[APTR] := 0;
      AREC[APTR] := ''
    END;
  APTR := DELWIND;
  AINP := DELWIND;
  ALNC := 0;
  AEOF := EOF(AFIL);

  FOR BPTR := 0 TO DELWIND DO
    BEGIN
      BLNO[BPTR] := 0;
      BREC[BPTR] := ''
    END;
  BPTR := DELWIND;
  BINP := DELWIND;
  BLNC := 0;
  BEOF := EOF(BFIL)

END { Procedure INITBUFF };

{ -------------------------------- }

PROCEDURE SHOWDIFF;

{  This procedure shows the differences between the "A" and the "B"
   files as two windows separated by a short bar.  }

CONST
  BAR = '-------------------------------------';

VAR
  IEND : WORD;
  IPTR : WORD;
  JPTR : WORD;
  TAG  : STRING[3];

BEGIN
  IF BAR1
    THEN
      BEGIN
        BAR1 := FALSE;
        PUTBLANK;
        PUTSTRING(BAR+BAR)
      END;

  IEND := (APTR+DELWIND) AND LBUFFMAX;
  IPTR := (APTR+LBUFFMAX-DELWIND) AND LBUFFMAX;
  JPTR := (BPTR+LBUFFMAX-DELWIND) AND LBUFFMAX;
  REPEAT
    IPTR := SUCC(IPTR) AND LBUFFMAX;
    JPTR := SUCC(JPTR) AND LBUFFMAX;
    IF ALNO[IPTR] <> 0
      THEN
        BEGIN
          IF AREC[IPTR] = BREC[JPTR]
            THEN
              TAG := ':  '
            ELSE
              TAG := ':> ';
          PUTSTRING('A:'+STRI(ALNO[IPTR],6)+TAG+AREC[IPTR])
        END
  UNTIL (IPTR = IEND) OR (ALNO[IPTR] < 0);

  PUTSTRING(BAR);
  IEND := (BPTR+DELWIND) AND LBUFFMAX;
  IPTR := (BPTR+LBUFFMAX-DELWIND) AND LBUFFMAX;
  JPTR := (APTR+LBUFFMAX-DELWIND) AND LBUFFMAX;
  REPEAT
    IPTR := SUCC(IPTR) AND LBUFFMAX;
    JPTR := SUCC(JPTR) AND LBUFFMAX;
    IF BLNO[IPTR] <> 0
      THEN
        BEGIN
          IF BREC[IPTR] = AREC[JPTR]
            THEN
              TAG := ':  '
            ELSE
              TAG := ':> ';
          PUTSTRING('B:'+STRI(BLNO[IPTR],6)+TAG+BREC[IPTR])
        END
  UNTIL (IPTR = IEND) OR (BLNO[IPTR] < 0);

  PUTSTRING(BAR+BAR)
END { Procedure SHOWDIFF };

{ -------------------------------- }

PROCEDURE SYNCHRONIZE;

{  This procedure attempts to "synchronize" the comparison points of the
   two files so as to avoid a never-ending series of differences  caused
   by the insertion or deletion of a few records in either  one  of  the
   files.  }

VAR
  IAMAX : WORD;
  IAPTR : WORD;
  IBMAX : WORD;
  IBPTR : WORD;
  JAPTR : WORD;
  JBPTR : WORD;
  KAPTR : WORD;
  KBPTR : WORD;
  NCNTR : BYTE;
  SYNC  : BOOLEAN;

BEGIN
  IAMAX := (APTR+WINDOW) AND LBUFFMAX;
  JAPTR := APTR;
  KAPTR := SUCC(APTR) AND LBUFFMAX;
  REPEAT
    IAPTR := JAPTR;
    JAPTR := KAPTR;
    KAPTR := SUCC(KAPTR) AND LBUFFMAX;
    IBMAX := (BPTR+WINDOW) AND LBUFFMAX;
    JBPTR := BPTR;
    KBPTR := SUCC(BPTR) AND LBUFFMAX;
    REPEAT
      IBPTR := JBPTR;
      JBPTR := KBPTR;
      KBPTR := SUCC(KBPTR) AND LBUFFMAX;
      SYNC := (AREC[IAPTR] = BREC[IBPTR]) AND
              (AREC[JAPTR] = BREC[JBPTR]) AND
              (AREC[KAPTR] = BREC[KBPTR])
    UNTIL SYNC OR (IBPTR = IBMAX)
  UNTIL SYNC OR (IAPTR = IAMAX);

  IF SYNC
    THEN
      BEGIN
        APTR := IAPTR;
        BPTR := IBPTR
      END
    ELSE
      FOR NCNTR := 1 TO WINDOW DO INCRBUFF

END { Procedure SYNCHRONIZE };

{ -------------------------------- }

BEGIN  { Program DIFF }
  GETFILES;
  IF DOPN
    THEN
      BEGIN
        WRITE(DFIL,'Difference output file, ',DSPC);
        WRITELN(DFIL,', generated at ',DATTIMST,':');
        WRITELN(DFIL)
      END;
  PUTSTRING('DIFF comparing two ASCII files, File "A" and File "B":');
  PUTSTRING('     File "A" is '+ASPC);
  PUTSTRING('     File "B" is '+BSPC);
  ABRT := FALSE;
  BAR1 := TRUE;
  DONE := FALSE;
  NDIF := 0;
  INITBUFF;
  FILLBUFF;
  REPEAT
    COMPARE(DIFR);
    IF DIFR
      THEN
        BEGIN
          SHOWDIFF;
          SYNCHRONIZE
        END
      ELSE
        INCRBUFF;
     FILLBUFF;
     CHECKKEYBD
  UNTIL DONE;
  CLOSE(AFIL);
  CLOSE(BFIL);
  BEEP(880,100);
  IF ABRT
    THEN
      BEGIN
        PUTBLANK;
        PUTSTRING('This run was aborted by the user.');
      END
    ELSE
      IF NDIF = 0 THEN WRITELN('     No differences found.');
  IF DOPN
    THEN
      BEGIN
        CLOSE(DFIL);
        IF NDIF = 0
          THEN
            ERASE(DFIL)
          ELSE
            WRITELN('The difference output file is ',DSPC)
      END
END.