home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / visionix / test / tsort.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-12-29  |  2.2 KB  |  154 lines
  1. uses vdatesu, vgenu, vstringu, vsortu, vtypesu;
  2.  
  3. Const
  4.  
  5.   MaxArr : INTEGER = 0;
  6.  
  7. Type
  8.  
  9.   SArray = Array[1..16000] of PString;
  10.  
  11. Var
  12.  
  13.   Sarr  : SArray;
  14.  
  15.   L1 : WORD;
  16.  
  17.   S1 : STRING;
  18.  
  19.   T  : TEXT;
  20.  
  21. {────────────────────────────────────────────────────────────────────────────}
  22.  
  23. Procedure DoString;
  24.  
  25. BEGIN
  26.  
  27.   { Show array }
  28.  
  29.   For L1 := 1 to MaxArr Do
  30.   BEGIN
  31.  
  32.      WriteLn( VStrGet( Sarr[L1] ) );
  33.  
  34.   END;
  35.  
  36.   WriteLn;
  37.   WriteLn;
  38.  
  39. END;
  40.  
  41. {────────────────────────────────────────────────────────────────────────────}
  42.  
  43. Procedure SortFile;
  44.  
  45. BEGIN;
  46.  
  47.   WriteLn('Sorting...');
  48.  
  49.   Sort( Sarr, 1, MaxArr, NIL, 'ElementType=PSTRING' );
  50.  
  51. END;
  52.  
  53. {────────────────────────────────────────────────────────────────────────────}
  54.  
  55. Procedure SaveFile;
  56.  
  57. Var
  58.  
  59.   S1  : STRING;
  60.   L1  : LONGINT;
  61.  
  62. BEGIN
  63.  
  64.   WriteLn('Saving File...');
  65.  
  66.   Assign(T, ParamStr(2));
  67.   Rewrite(T);
  68.   L1 := 1;
  69.  
  70.   While (L1 <= MaxArr) Do
  71.   BEGIN
  72.  
  73.     WriteLn(T, VStrGet(Sarr[L1]));
  74.  
  75.     Inc(L1);
  76.  
  77.   END;
  78.  
  79.   Close(T);
  80.  
  81. END;
  82.  
  83. {────────────────────────────────────────────────────────────────────────────}
  84.  
  85. Procedure ReadFile;
  86.  
  87. Var
  88.  
  89.   S1  : STRING;
  90.  
  91. BEGIN
  92.  
  93.   WriteLn('Loading File...');
  94.  
  95.   Assign(T, ParamStr(1));
  96.   Reset(T);
  97.   MaxArr := 1;
  98.  
  99.   While (NOT Eof(T)) And
  100.         (MaxAvail > 255) Do
  101.   BEGIN
  102.  
  103.     ReadLn(T, S1);
  104.  
  105.     Sarr[MaxArr] := VStrNew( S1 );
  106.  
  107.     Inc(MaxArr);
  108.  
  109.   END;
  110.  
  111.   Dec(MaxArr);
  112.  
  113.   Close(T);
  114.  
  115. END;
  116.  
  117. {────────────────────────────────────────────────────────────────────────────}
  118.  
  119. Procedure DisposeAll;
  120. BEGIN
  121.  
  122.   For L1 :=1 to MaxArr Do
  123.     VStrDispose( Sarr[L1] );
  124.  
  125. END;
  126.  
  127. {────────────────────────────────────────────────────────────────────────────}
  128. {────────────────────────────────────────────────────────────────────────────}
  129. {────────────────────────────────────────────────────────────────────────────}
  130.  
  131. BEGIN
  132.  
  133.   WriteLn;
  134.   WRiteLn('TSort; VisionTools VSORTU tester; Version 0.9');
  135.   WRiteLn;
  136.  
  137.   If ParamCount=2 Then
  138.   BEGIN
  139.  
  140.     ReadFile;
  141.     SortFile;
  142.     SaveFile;
  143.  
  144.   END
  145.   ELSE
  146.   BEGIN
  147.     WriteLn('This program sorts files of ASCII strings.');
  148.     WriteLn;
  149.     WriteLn('Usage: TSORT inputfilename outputfilename');
  150.     WriteLn;
  151.   END;
  152.  
  153. END.
  154.