Уф, ну - получите.
1. Исправлено довольно много ошибок. Например, объявление в списке параметров функции строку константой - абсурд. Ну и еще по мелочи. Кстати, ну зачем тут функция? По всем статьям подходит процедура.
2. Английские надписи можете обратно заменить русскими: просто мне с кириллицей работать неудобно (у меня DOS-кодировка).
3. Путь к файлу-книге, естественно, исправьте по своему усмотрению.
Код:
const
MaxWord = 200;
delimiter = [' ',',','.','(',')',':','?','!'];
type
TBook = array[1..MaxWord] of string; // type of word output array
Procedure GetWords(line: string; var words: TBook; var count: byte); // Fragmentation of string to words according to delimiter
var
back,pos,m: integer;
begin
pos:=1;
m:=0;
while pos <= length(line) do
begin
while (pos <= length(line)) and (line[pos] in delimiter) do pos:=pos+1;
if pos <= length(line) then
begin
back:=pos;
while (pos <= length(line)) and not(line[pos] in delimiter) do pos:=pos+1;
m:=m+1;
words[m]:=copy(line,back,pos-back);
end;
end;
count:=m;
end;
var
book,txt: TBook;
shifr,posit: array[1..MaxWord] of byte;
i,j,k,n,q: byte;
st: string;
key: byte;
f: text;
b: boolean;
begin
assign(f,'D:\kkk.txt');
reset(f);
while not eof(f) do
begin
readln(f,st);
GetWords(st,book,n);
end;
close(f);
writeln;
writeln('Code book read successfully...');
for i:=1 to n do write(book[i]+' ');
repeat
writeln;
writeln(' < MENU >');
writeln(' 1 - encode text');
writeln(' 2 - decode text');
writeln(' 3 - exit');
writeln;
write('Enter the item number: ');
readln(key);
case key of
1: begin
write('Enter the text: ');
readln(st);
writeln('Encoded text: ');
GetWords(st,txt,k);
for i:=1 to k do posit[i]:=0;
b:=false;
for i:=1 to k do
begin
b:=false;
repeat
j:=1;
repeat
if (txt[i]=book[j]) and (j>posit[i]) then
begin
b:=true;
posit[i]:=j;
shifr[i]:=j;
for q:=i+1 to k do
if txt[q]=txt[i] then posit[q]:=j;
end
else
j:=j+1;
until b or (j=n+1);
if not(b) and (j=n+1) then
for q:=1 to k do
if txt[q]=txt[i] then posit[q]:=0;
until b;
end;
for i:=1 to k do write(shifr[i],' ');
writeln;
end;
2: begin
write('Enter the number of words in text: ');
readln(k);
write('Enter the code: ');
for i:=1 to k do read(shifr[i]);
writeln;
write('Decoded text: ');
for i:=1 to k do write(book[shifr[i]],' ');
writeln;
end;
end;
until key = 3;
end.