[Rosenkrantz]

Код:

program WordFreq;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Classes;

var
  Dictionary: TStringList;

const
  WordDelimiters = ' !?.,;`-+*=/\<>()[]~{}'#39;

function  DictionarySortFunc(List: TStringList; Index1, Index2: Integer): Integer;
begin
  if      Integer(List.Objects[Index1]) > Integer(List.Objects[Index2]) then Result := 1
  else if Integer(List.Objects[Index1]) < Integer(List.Objects[Index2]) then Result := -1
  else
    Result := 0;
end;

procedure AddToDictionary(SWord: String);
var
  i: Integer;
begin
  SWord := AnsiLowerCase(SWord);
  if Dictionary.Find(SWord, i)
    then Dictionary.Objects[i] := Pointer(Integer(Dictionary.Objects[i]) + 1)
    else Dictionary.AddObject(SWord, Pointer(1));
end;

procedure ProcessString(S: String);
var
  SWord: String;
  i    : Integer;
begin
  if (S <> '') and (Pos(S[Length(S)], WordDelimiters) = 0) then
    S := S + WordDelimiters[1];

  i     := 1;
  SWord := '';
  while (i <= Length(S)) do
    if Pos(S[i], WordDelimiters) = 0 then begin
      SWord := SWord + S[i];
      Inc(i);
    end else begin
      if SWord <> '' then
        AddToDictionary(SWord);
      SWord := '';
      while Pos(S[i], WordDelimiters) <> 0 do
        Inc(i);
    end;
end;

var
  F : Text;
  S : String;
  i : Integer;
begin
  try
    if   (ParamCount < 1)
      or (Pos('?', ParamStr(1)) = 1)
      or (not FileExists(ParamStr(1))) then begin

      Writeln('Use: ' + ExtractFileName(ParamStr(0)) + ' <filename>');
      Exit;
    end;

    Dictionary := TStringList.Create;
    Dictionary.Sorted := True;

    AssignFile(F, ParamStr(1));
    Reset(F);
    while not Eof(F) do begin
      Readln(F, S);
      ProcessString(Trim(S));
    end;
    CloseFile(F);

    Dictionary.Sorted := False;
    Dictionary.CustomSort(DictionarySortFunc);

    Assign(F, ChangeFileExt(ParamStr(1), '.result'));
    Rewrite(F);
    for i := 0 to Dictionary.Count - 1 do
      Writeln(F, Integer(Dictionary.Objects[i]), ' - ', Dictionary[i]);
    CloseFile(F);
  except
    on E:Exception do
      Writeln(E.Classname, ': ', E.Message);
  end;
end.