home *** CD-ROM | disk | FTP | other *** search
/ Tools en Utilities / CDASS_5.ISO / shell / file / fduplins.arj / FDUPLINS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-07-14  |  4.0 KB  |  144 lines
  1. PROGRAM FindDupLines;
  2. CONST
  3.      ProgData = 'FDUPLINS- Free DOS utility: text file duplicate line deleter.';
  4.      ProgDat2 = 'V1.00: July 14, 1993. (c) 1993 by David Daniel Anderson - Reign Ware.';
  5.  
  6.       Usage1 = 'Usage:  FDUPLINS source_file new_destination_file [/c[y|N]] [/d#]';
  7.       Usage2 = ' where "/cy" is case sensitive, "/cn" is case insensitive, and';
  8.       Usage3 = ' where "d#" is the number of characters at the beginning of the';
  9.       Usage4 = ' line to disregard, e.g. - "/d5" ignores the first 5 characters.';
  10. VAR
  11.    PS1, PS2,
  12.    Line_CA, Line_NA,
  13.    ULine_Current, ULine_Next,
  14.    Line_Current,Line_Next    : String;
  15.    Source_File,Dest_File     : Text;
  16.    CaseSens                  : Boolean;
  17.    CParm                     : String;
  18.    NumbDisChars, i           : Byte;
  19.  
  20. FUNCTION ConvertToUpper(w : String) : String;
  21. VAR
  22.    cp  : Integer;        {The position of the character to change.}
  23. BEGIN
  24.      FOR cp := 1 TO Length(w) DO
  25.          w[cp] := UpCase(w[cp]);
  26.      ConvertToUpper := w;
  27. END;
  28.  
  29. PROCEDURE CaseSensitive;
  30. BEGIN
  31.      ReadLn(Source_File,Line_Next);
  32.  
  33.      Line_NA := Line_Next;
  34.      Delete(Line_NA,1,NumbDisChars);
  35.  
  36.      WHILE NOT Eof(Source_File) DO
  37.      BEGIN
  38.            Line_Current  := Line_Next;
  39.            Line_CA       := Line_NA;
  40.  
  41.            ReadLn(Source_File,Line_Next);
  42.  
  43.            Line_NA       := Line_Next;
  44.            Delete(Line_NA,1,NumbDisChars);
  45.  
  46.            IF Line_CA <> Line_NA THEN
  47.               WriteLn(Dest_File,Line_Current);
  48.      END;
  49.      WriteLn(Dest_File,Line_Next);
  50. END;
  51.  
  52. PROCEDURE CaseInSensitive;
  53. BEGIN
  54.      ReadLn(Source_File,Line_Next);
  55.      ULine_Next := ConvertToUpper(Line_Next);
  56.      Line_NA := ULine_Next;
  57.      Delete(Line_NA,1,NumbDisChars);
  58.  
  59.      WHILE NOT Eof(Source_File) DO
  60.      BEGIN
  61.            Line_Current  := Line_Next;
  62.            Line_CA       := Line_NA;
  63.  
  64.            ReadLn(Source_File,Line_Next);
  65.            ULine_Next    := ConvertToUpper(Line_Next);
  66.            Line_NA       := ULine_Next;
  67.            Delete(Line_NA,1,NumbDisChars);
  68.  
  69.            IF Line_CA <> Line_NA THEN
  70.               WriteLn(Dest_File,Line_Current);
  71.      END;
  72.      WriteLn(Dest_File,Line_Next);
  73. END;
  74.  
  75. FUNCTION StrToByte(s : String) : Byte;
  76. VAR code : integer;
  77.     mid  : byte;
  78. BEGIN
  79.      Val(s, mid, code);
  80.      StrToByte := mid;
  81. END;
  82.  
  83. BEGIN
  84.      Writeln;
  85.      Writeln(ProgData);
  86.      Writeln(ProgDat2);
  87.      Writeln;
  88.  
  89.      If (ParamCount < 2) THEN Begin
  90.         Writeln(Usage1);
  91.         Writeln(Usage2);
  92.         Writeln(Usage3);
  93.         Writeln(Usage4);
  94.  
  95.         Halt;
  96.      End;
  97.      PS1 := ParamStr(1);
  98.      PS2 := ParamStr(2);
  99.  
  100.      Assign(Source_File,PS1);
  101. {$I-} Reset(Source_File); {$I+}                    { Check if file exists.}
  102.      IF (IOResult <> 0) THEN                       { If it                }
  103.      BEGIN                                         {    doesn't, then     }
  104.          Writeln('Unable to open "', PS1, '".');   {  quit with message.  }
  105.          Halt;
  106.      END;
  107.  
  108.      Assign(Dest_File,PS2);
  109. {$I-} Reset(Dest_File);  {$I+}
  110.       IF (IOResult <> 0) Then Begin
  111.          Rewrite(Dest_File);
  112.       End
  113.       Else Begin
  114. Writeln('Destination "',PS2,'" exists!  Rename, delete, or specify alternate.');
  115.          Halt;
  116.       End;
  117.  
  118.      CaseSens     := False;
  119.      NumbDisChars := 0;
  120.  
  121.      For i := 3 to ParamCount DO
  122.      Begin
  123.       CParm := ParamStr(i);
  124.       Case CParm[2] of
  125.       'c' :   CaseSens     := ((CParm[3] = 'y') OR (CParm[3] = 'Y'));
  126.       'C' :   CaseSens     := ((CParm[3] = 'y') OR (CParm[3] = 'Y'));
  127.       'd' :   NumbDisChars := StrToByte(Copy(ParamStr(i),3,3));
  128.       'D' :   NumbDisChars := StrToByte(Copy(ParamStr(i),3,3));
  129.       End;
  130.      End;
  131.  
  132.      Writeln('Source: ',Ps1,'; Destination: ',Ps2,'.');
  133.      Writeln('Case Sensitive: ',CaseSens,'; Disregarded Chars: ',NumbdisChars,'.');
  134.  
  135.      If CaseSens Then
  136.         CaseSensitive
  137.      Else
  138.         CaseInSensitive;
  139.  
  140.      Close(Source_File);
  141.      Close(Dest_File);
  142.      Writeln('Done!');
  143. END.
  144.