Работа со структурой и запись её в файл:
program AlphaList;
type
TPair = record
word: string; { слово }
count: integer { счётчик }
end;
TWordList = record
data: array of TPair;
size: integer
end;
var
F: text;
s: string;
L: TWordList;
p: integer;
function Find(L: TWordList;
word: string): integer;
var
i: integer;
begin
Find := -1;
for i := 0 to L.size - 1 do
if L.data[i].word = word then begin
Find := i;
break
end
end;
function FindPlace(L: TWordList;
word: string): integer;
var
i, p: integer;
begin
p := -1;
for i := 0 to L.size - 1 do
if L.data[i].word > word then begin
p := i;
break
end;
if p < 0 then p := L.size;
FindPlace := p
end;
procedure IncSize(var L: TWordList);
begin
Inc(L.size);
if L.size > Length(L.data) then
SetLength(L.data, Length(L.data) + 10)
end;
procedure InsertWord(var L: TWordList;
k: integer;
word: string);
var
i: integer;
begin
IncSize(L);
for i := L.size - 1 downto k + 1 do
L.data[i] := L.data[i - 1];
L.data[k].word := word; { записать слово }
L.data[k].count := 1 { встретилось 1 раз }
end;
begin
SetLength(L.data, 0);
L.size := 0;
Assign(F, 'AlphaList.in');
Reset(F);
{ основной цикл: составление списка слов }
while not Eof(F) { пока не конец файла }
do
begin
readln(F, s); { читаем слово }
p := Find(L, s); { ищем его в словаре}
if p >= 0 then { если нашли... }
Inc(L.data[p].count)
{ ...увеличить счётчик }
else begin{ иначе... }
p := FindPlace(L, s); { найти место }
InsertWord(L, p, s); { вставить в список }
end
end;
Close(F);
{ вывод результата в файл output.dat }
Assign(F, 'output.txt');
Rewrite(F);
for p := 0 to L.size - 1 do
writeln(F, L.data[p].word, ': ',
L.data[p].count);
Close(F);
end.
