home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR13 / 4HIST101.ZIP / 4HIST.PAS < prev    next >
Pascal/Delphi Source File  |  1993-10-12  |  6KB  |  229 lines
  1. program delete_duplicate_4dos_command_history_entries;
  2. {------------------------------------------------------------------------------
  3.  
  4.                                 REVISION HISTORY
  5.  
  6. v1.00  : 1993/09/08.  First public release.  DDA
  7. v1.01  : 1993/10/12.  Fixed bug: would not properly process files in
  8.                             directories other than the current one.  DDA
  9.  
  10. ------------------------------------------------------------------------------}
  11.  
  12. uses dos , crt ;
  13. type
  14.     link = ^node;
  15.     node = record
  16.              cmd  : string ;
  17.              next : link ;
  18.            end;
  19. var
  20.    inbufr,
  21.    inlist,
  22.    ccmd      : string ;
  23.  
  24.    anchor,
  25.    chain,
  26.    temp,
  27.    cnode     : link ;
  28.  
  29.    before,
  30.    after     : text ;
  31.  
  32.    workpath,
  33.    infile,
  34.    outfile,
  35.    tmpfile   : string ;
  36.  
  37.    i_case,
  38.    twirl     : boolean ;
  39.    histnumb  : word ;
  40.    histsize,
  41.    fdt       : longint ;
  42.  
  43. procedure showhelp ( errornum : byte );
  44. const
  45.     progdata = '4HIST- Free 4DOS utility: command history duplicate entry deleter.';
  46.     progdat2 = 'V1.01: October 12, 1993. (c) 1993 by David Daniel Anderson - Reign Ware.';
  47.     usage = 'Usage: 4HIST file [/i (ignore case)]';
  48. var
  49.     message : string [80];
  50. begin
  51.     writeln ( progdata );
  52.     writeln ( progdat2 );
  53.     writeln ;
  54.     writeln ( usage );
  55.     writeln ;
  56.  
  57.     case errornum of
  58.       1 : message := 'you must specify -exactly- one filespec.';
  59.       2 : message := 'cannot find ' + paramstr (1) + '!';
  60.       3 : message := 'unable to open ' + paramstr (1) + '!';
  61.       4 : message := 'file is empty, cannot continue.';
  62.       5 : message := 'undefined error, may not have worked properly.';
  63.     end;
  64.     writeln ( 'ERROR: (#',errornum,') - ', message );
  65.     halt ( errornum );
  66. end;
  67.  
  68. function converttoupper(w : string) : string;
  69. var
  70.    cp  : integer;        {the position of the character to change.}
  71. begin
  72.      for cp := 1 to length(w) do
  73.          w[cp] := upcase(w[cp]);
  74.      converttoupper := w;
  75. end;
  76.  
  77. procedure openfiles(var sfile, dfile : text; name1, name2, wp : string);
  78. var
  79.      dirinfo : searchrec ;
  80.      inname  : string [64] ;
  81.      insize  : longint ;
  82.  
  83. begin       { open the file to process, and another for output }
  84.      findfirst ( (wp+name1), archive, dirinfo );
  85.      if doserror <> 0 then
  86.         showhelp (2);
  87.  
  88.      inname := wp+dirinfo.name ;
  89.      insize := dirinfo.size ;
  90.  
  91.      assign ( sfile, inname );     { we know names of both, }
  92. {$i-} reset ( sfile ); {$i+}     { but if source does not exist, }
  93.      if ( ioresult <> 0 ) then  { show help                     }
  94.          showhelp(3);
  95.  
  96.      if insize = 0 then
  97.          showhelp(4);
  98.  
  99.      assign ( dfile,wp+name2 );     { create output file regardless }
  100.      rewrite ( dfile );
  101. end;
  102.  
  103. procedure getpath ( var wpath, inf : string );
  104. var ps1 : string ;
  105. begin
  106.      wpath := '';
  107.      ps1 := inf;
  108.      while (( pos ( '\',ps1 )) <> 0 ) do begin
  109.         wpath := copy ( ps1,1,( pos ( '\',ps1 )));
  110.         delete ( ps1,1,( pos ( '\',ps1 )));
  111.      end;
  112.  
  113.      if (wpath = '') then begin
  114.         ps1 := inf;
  115.         while (( pos ( ':',ps1 )) <> 0 ) do begin
  116.            wpath := copy ( ps1,1,( pos ( ':',ps1 )));
  117.            delete ( ps1,1,( pos ( ':',ps1 )));
  118.         end;
  119.      end;
  120.  
  121.      inf := copy ( inf, ( length (wpath)+1 ), ( length ( ps1 )) );
  122. end;
  123.  
  124. procedure woops;
  125. begin
  126.   if ( exitcode <> 0) then showhelp (5);
  127.   halt (0);
  128. end;
  129.  
  130.  
  131. begin
  132.      exitproc := @woops;
  133.      outfile := 'dda_4h-!.out';
  134.      tmpfile := 'dda_4h-!.tmp';
  135.      if paramcount >= 1 then
  136.         infile := paramstr (1)
  137.      else showhelp (1) ;
  138.  
  139.      getpath ( workpath, infile );
  140.  
  141.      i_case := false ;
  142.      if ( paramcount = 2 ) then
  143.         if (( converttoupper ( paramstr (2) )) = '/I' )  then
  144.            i_case := true ;
  145.  
  146.      openfiles ( before, after, infile, outfile, workpath );
  147.  
  148.      new ( anchor );
  149.      anchor^.cmd  := '';
  150.      anchor^.next := nil ;
  151.      chain := anchor ;
  152.  
  153.      twirl := true ;
  154.      histsize := 0 ;
  155.      histnumb := 0 ;
  156.  
  157.      while not eof ( before ) do begin
  158.            readln ( before, ccmd );
  159.  
  160.            twirl := not twirl ;
  161.            if twirl then write ('\')
  162.                    else write ('/');
  163.            gotoxy ( wherex - 1, wherey );
  164.  
  165.            histsize := histsize + length ( ccmd ) ;
  166.            histnumb := histnumb + 1 ;
  167.  
  168.            new ( cnode );
  169.            cnode^.cmd  := ccmd ;
  170.            cnode^.next := nil  ;
  171.            chain := anchor ;
  172.  
  173.            inbufr := cnode^.cmd ;
  174.            if i_case then inbufr := converttoupper ( inbufr );
  175.  
  176.            while ( chain^.next <> nil )  do begin
  177.  
  178.                  inlist := chain^.next^.cmd ;
  179.                  if i_case then inlist := converttoupper ( inlist );
  180.  
  181.                  if ( inbufr = inlist ) then
  182.                  begin
  183.                       temp := chain^.next ;
  184.                       chain^.next := chain^.next^.next ;
  185.                       dispose ( temp );
  186.                  end
  187.                  else
  188.                     chain := chain^.next ;
  189.            end;
  190.  
  191.            inlist := chain^.cmd ;
  192.            if i_case then inlist := converttoupper ( inlist );
  193.  
  194.            if ( inbufr <> inlist ) then
  195.            begin
  196.               chain^.next := cnode ;
  197.               chain := cnode ;
  198.            end;
  199.      end;
  200.  
  201.      histsize := histsize + histnumb ;
  202.      write ( 'History was: ', histsize, ' bytes (',
  203.               histnumb, ' commands), and is now: ' );
  204.      histsize := 0 ;
  205.      histnumb := 0 ;
  206.      repeat
  207.            temp := anchor ;
  208.            anchor := anchor^.next;
  209.            dispose ( temp );
  210.            writeln ( after, anchor^.cmd ) ;
  211.            histsize := histsize + length ( anchor^.cmd ) ;
  212.            histnumb := histnumb + 1 ;
  213.      until anchor^.next = nil ;
  214.      dispose ( anchor );
  215.  
  216.      histsize := histsize + histnumb ;
  217.      writeln ( histsize, ' bytes (', histnumb, ' commands).' );
  218.  
  219.      close ( after );
  220.      reset ( after );
  221.      getftime ( before, fdt );
  222.      setftime ( after, fdt );
  223.      close ( before );
  224.      close ( after );
  225.      rename ( before, workpath+tmpfile );
  226.      rename ( after, workpath+infile );
  227.      erase  ( before );
  228. end.
  229.