home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / sorting.swg / 0047_Sorting a Text File.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-02-03  |  2.6 KB  |  84 lines
  1. {
  2. ---------------------------------------------------------------------------
  3.  >    What I want to do here, is take a textfile with about 1,000-10,000
  4.  > lines in it, go and read a string starting at the XPosition of 13, going
  5.  > until XPosition of 38 on each line of the textfile.  Then, put
  6.  > everything in memory if possible, and then sort all of the strings on
  7.  > the screen by ABC order.  Can somebody help me out with a few hints, or
  8.  > some code?  Either reply here, or send me Netmail @ 1:105/60.77.
  9. This will take some modification by you, but it should not be too much trouble.
  10.  This is a sort based on a file of records, but the necessary modifications
  11. should not be too difficult.}
  12.  
  13. {$N+,E+}
  14. program DiskSort;
  15. uses
  16.     Crt,
  17.     Dos;
  18. type
  19.     String72 = string[72];
  20.     ElementType = String72;
  21.     ElementFile = file of ElementType;
  22. var
  23.     A : ElementFile;
  24.     Temp : String72;
  25.     I : LongInt;
  26. function Precedes (A, B : ElementType) : boolean;
  27.     begin {Precedes}
  28.         if A < B then
  29.             Precedes := True
  30.         else
  31.             Precedes := False;
  32.     end; {Precedes}
  33. procedure Swap (var A : ElementFile; Index1, Index2 : Integer; Temp1, Temp2 :
  34. ElementType);
  35.     begin {Swap}
  36.         Seek (A, Index1);
  37.         Write (A, Temp2);
  38.         Seek (A, Index2);
  39.         Write (A, Temp1);
  40.     end; {Swap}
  41. procedure ShellSortInsertion (var A : ElementFile; NumVals : Integer);
  42. var
  43.     EleDist : Integer;
  44.     Temp1, Temp2 : ElementType;
  45.     procedure SegmentedInsertion (var A : ElementFile; N, K : Integer);
  46.     var
  47.         J, L : Integer;
  48.     begin {SegmentedInsertion}
  49.         for L := K + 1 to N do
  50.             begin
  51.                 J := L - K;
  52.                 while J > 0 do
  53.                     begin
  54.                         Seek (A, J+K-1);
  55.                         Read (A, Temp1);
  56.                         Seek (A, J-1);
  57.                         Read (A, Temp2);
  58.                         if Precedes (Temp1, Temp2) then
  59.                             begin
  60.                                 Swap (A, J+K-1, J-1, Temp1, Temp2);
  61.                                 J := J - K;
  62.                             end
  63.                         else
  64.                             J := 0;
  65.                     end;
  66.             end;
  67.     end; {SegmentedInsertion}
  68. begin {ShellSortInsertion}
  69.     EleDist :=  NumVals div 2;
  70.     while EleDist > 0 do
  71.         begin
  72.             SegmentedInsertion (A, NumVals, EleDist);
  73.             EleDist := EleDist div 2;
  74.         end;
  75. end; {ShellSortInsertion}
  76. begin
  77.     ClrScr;
  78.     Assign (A, 'Strings.dat');
  79.     Reset (A);
  80.  
  81.     ShellSortInsertion (A, FileSize(A));
  82.  
  83. end.
  84.