program wordfreq; uses SysUtils, Classes, Windows, simpleHash in 'simpleHash.pas'; const cWhiteSpace = [#0..#255]-['a'..'z','A'..'Z']; BUF_SIZE = 4096; var handle: THandle; buf: array[1..BUF_SIZE+1] of char; s,w: string; words: TStringHash; forSort: TList; numRead,i,wStart: cardinal; p: PHashEntry; procedure addWord(const s: string); var w: string; p: PHashEntry; begin w:=lowercase(s); p:=words.get(w); if p<>nil then inc(p^.Value) else words.add(w,1); end; function sortFunc(Item1, Item2: Pointer): Integer; begin with PHashEntry(Item1)^ do begin if Value<PHashEntry(Item2)^.Value then result:=1 else if Value>PHashEntry(Item2)^.Value then result:=-1 else begin // values equal if Key=PHashEntry(Item2)^.Key then result:=0 else if Key<PHashEntry(Item2)^.Key then result:=1 else result:=-1; end; end; end; begin handle:=GetStdHandle(STD_INPUT_HANDLE); words:=TStringHash.Create; s:=''; buf[BUF_SIZE+1]:=#0; numRead:=fileRead(handle,buf,BUF_SIZE); while numRead>0 do begin i:=1; if (s<>'')and(buf[1] in cWhiteSpace) then begin addWord(s); s:=''; end; repeat while (buf[i] in cWhiteSpace)and(i<=numRead) do inc(i); if i>numRead then break; // repeat wStart:=i; repeat inc(i); until (buf[i] in cWhiteSpace); setString(w,PChar(addr(buf[wStart])),i-wStart); if s<>'' then begin w:=s+w; s:=''; end; if i<=numRead then addWord(w) else // word exceeding buffer s:=w; until (i>numRead); numRead:=fileRead(handle,buf,BUF_SIZE); end; if (s<>'') then addWord(s); forSort:=TList.Create; forSort.Capacity:=words.Count; p:=words.getFirst; while p<>nil do begin forSort.Add(p); p:=words.getNext; end; forSort.Sort(sortFunc); for i:=0 to forSort.Count-1 do begin p:=PHashEntry(forSort.Items[i]); write(format('%7d'#9'%s'#13#10,[p^.Value,p^.Key])); end; words.Free; forSort.Free; end.