13.11.2016, 21:57 | #11 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Код:
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: Integer); // 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 Integer; i,j,k,n,q,key: Integer; st: string; 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. |
13.11.2016, 21:57 | |
Helpmaster
Member
Регистрация: 08.03.2016
Сообщений: 0
|
Отсылаю вам ссылки на темы, которые очень схожи с вашей Помогите, пожалуйста, доработать Помогите доработать программу Помогите доработать Доработать программу в ABC Помогите доработать программу на Паскале |
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
|
|