home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / OPBONUS.ZIP / DUPFIND.LZH / WORDS.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1990-10-24  |  1.9 KB  |  95 lines
  1. {$S-,R-,V-,I-,B-,F+,O-,A-}
  2.  
  3. program Words;
  4.   {-Writes sorted list of unique words in a file using UniqueStringArray}
  5.  
  6. uses
  7.   OpString, OpRoot, OpTree, OpUnique;
  8.  
  9. const
  10.   WordDelims : CharSet = [#0..',', '.'..'/', ':'..'@', '['..'^', '{'..#127];
  11.  
  12. var
  13.   U : UniqueStringArray;
  14.  
  15. procedure Abort(Msg : string);
  16. begin
  17.   writeln(Msg);
  18.   halt(1);
  19. end;
  20.  
  21. procedure OutOfMemory;
  22. begin
  23.   Abort('Insufficient memory');
  24. end;
  25.  
  26. procedure Help;
  27. begin
  28.   writeln('Usage: WORDS FileName [>OutputRedirection]');
  29.   halt;
  30. end;
  31.  
  32. procedure Scan(FName : String);
  33.   {-Read the text file FName and add its words to the string array}
  34. var
  35.   LPos : Word;
  36.   BPos : Word;
  37.   Index : Word;
  38.   L : String;
  39.   F : Text;
  40. begin
  41.   assign(F, FName);
  42.   reset(F);
  43.   if IoResult <> 0 then
  44.     Abort(FName+' not found');
  45.  
  46.   while not Eof(F) do begin
  47.     {Read next line from file}
  48.     ReadLn(F, L);
  49.     if IoResult <> 0 then
  50.       Abort('Error reading '+FName);
  51.  
  52.     {Parse the string into words}
  53.     LPos := 1;
  54.     while LPos <= Length(L) do begin
  55.       {Find start of word}
  56.       while (LPos <= Length(L)) and (L[LPos] in WordDelims) do
  57.         inc(LPos);
  58.       if LPos <= Length(L) then begin
  59.         {Save beginning position}
  60.         BPos := LPos;
  61.         while (LPos <= Length(L)) and not(L[LPos] in WordDelims) do
  62.           inc(LPos);
  63.  
  64.         {Add word to UniqueStringArray}
  65.         Index := U.AddString(copy(L, BPos, LPos-BPos));
  66.         if Index = 0 then
  67.           OutOfMemory;
  68.       end;
  69.     end;
  70.   end;
  71.  
  72.   close(F);
  73.   if IoResult = 0 then ;
  74. end;
  75.  
  76. procedure DumpAction(N : TreeNodePtr; T : TreePtr);
  77. begin
  78.   writeln(IndexTreePtr(T)^.itSP^.GetString(IndexTreeNodePtr(N)^.itnIndex));
  79. end;
  80.  
  81. procedure Dump;
  82.   {-Dump the UniqueStringArray in alpha order}
  83. begin
  84.   U.GetTreePtr^.VisitNodesUp(DumpAction);
  85. end;
  86.  
  87. begin
  88.   if not U.Init(5000, 65520) then
  89.     OutOfMemory;
  90.   if ParamCount = 0 then
  91.     Help;
  92.   Scan(ParamStr(1));
  93.   Dump;
  94. end.
  95.