Показать сообщение отдельно
Старый 13.11.2016, 14:45   #4 (permalink)
Vladimir_S
Специалист
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
По умолчанию

Уф, ну - получите.
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.
Vladimir_S вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070