home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ECO30603.ZIP / ECO30603.LZH / ECOLIBCS / DEMOS / DELDUP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-03-09  |  1.2 KB  |  51 lines
  1. {$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
  2. {$M 65520, 0, 655360}
  3.  
  4. uses
  5.   eco_lib, crt, dos    { all tricks :-)     }
  6.  
  7.   ;
  8.  
  9.  
  10. type
  11.   str96 = string[96];
  12.   str96ptr = ^str96;
  13.  
  14. var
  15.   fin         :                       text;
  16.   filenum, i  :                       word;
  17.   bin         :    array[1..16384] of char;
  18.   allstrs     : array[1..4096] of str96ptr;
  19.  
  20.  
  21.   {$F+}
  22.   function order(var data1, data2): boolean; far;
  23.   begin
  24.     order := str96(pointer(data1)^) < str96(pointer(data2)^)
  25.   end;
  26.   {$F-}
  27.  
  28.  
  29. begin
  30.   starttimer(1);
  31.   writeln(
  32.     'Reading up to ', __pntstr(maxavail), ' bytes from ',
  33.     __slashfil(__normfil(paramstr(1)))
  34.   );
  35.   assign(fin, paramstr(1)); settextbuf(fin, bin); reset(fin); filenum := 0;
  36.   while not eof(fin) do begin
  37.     inc(filenum); new(allstrs[filenum]); readln(fin, allstrs[filenum]^);
  38.   end;
  39.   close(fin);
  40.   writeln('Sorting...');
  41.   __qsortsrt(@allstrs, filenum, sizeof(str96ptr), @order);
  42.   writeln('Writing (whils unduping)...');
  43.   assign(fin, paramstr(1)); settextbuf(fin, bin); rewrite(fin);
  44.   writeln(fin, allstrs[1]^);
  45.   for i := 2 to filenum do begin
  46.     if allstrs[i]^ <> allstrs[i-1]^ then writeln(fin, allstrs[i]^);
  47.   end;
  48.   close(fin);
  49.   writeln('Written in ', getlaptime(1));
  50. end.
  51.