[Smile188]

Кодировочная книга

Код:

 program Project3;

{$APPTYPE CONSOLE}

uses
    windows, 


  SysUtils;

const filename='key.txt';//название файл¬а
var alllines:integer;//количество стро¬к
maxsymbol:integer;//¬
sameword:array[0..100] of string;
tr:boolean;
wrd:array[0..99]of string;//здесь соде¬ржится разбитая на слова строка
cnt:byte;//количество элементов массив¬а,другими словами сколько слов в wrd 
index:integer;
same:integer;
countwords,len:integer;
type
tbookword=record
w:string;//
wasfound:boolean;
symbolcount:integer;//количество элеме¬нтов в строке,для определения макс числа¬ элементов
end;
tbookdata=array of tbookword;//массив ¬записи
function countelement(input:string):integer;
var divs:set of char;
i:integer;
begin
divs:=[' ',',','?','!',':',';','-','.'];
for i:=1 to length(input)do //цикл по э¬лементам строки
if input[i] in divs then inc(result);//¬если i элемент строки равняется любому и¬з перечисленному значенибю из divs то ув¬еличиваем счетчик элементов на единицу
end;
function loadbook:tbookdata;
var f:text;
z:string;
i:integer;
begin
result:=nil;
alllines:=0;
assignfile(f,filename);//связываем файл с переменной f

reset(f);//открываем файл
while not Eof(f) do //пока не закончится файл
begin
readln(f,z);//считываем строку из файла
trim(z);//убираем пробелы в начале и в конце строки
SetLength(result,Length(result)+1);//устанавливаем размер динамического массив¬а
result[length(result)-1].w:=z;//строка из файла присваивается элементу массива
result[length(result)-1].wasfound:=false;
result[length(result)-1].symbolcount:=countelement(z)+1;//забиваем в массив ко¬личество элементов определенной строки
inc(alllines);//подсчет макс количества строк
end;
closeFile(f);//закрываем файл
end;
procedure DivStrToWrd(s:string);//функция разбиения строки в массив на слова д¬ля определения позиции слова в строке
var i,b:integer;
divs:set of char;
w:boolean;
begin
divs:=[' ',',','.','!','?',':',';']; //¬разделители
w:=false;
s:=s+' ';
cnt:=0;
for i:=1 to length(s) do
begin
if w then
begin
if s[i] in divs then //если равняется то мы не в слове
begin
inc(cnt);//увеличиваем счетчик элеме¬нта в массиве
wrd[cnt]:=copy(s,b,i-b);//копируем с¬лово в массив
w:=false;
end;
end else
begin
if not (s[i] in divs) then //если не ¬равняется ни одному из символов значит м¬ы в начале слова
begin
w:=true;//в начале слова
b:=i;//с какой позиции копировать сл¬ово
end;
end;
end;
end;
Function Encode(input:string;book:tbookdata):string;//функция кодирования
var posline,posofword,c,g:integer;
l1,l2,l3,l4:integer;
enc1,enc2:string;
c1,c2:integer;
i:integer;
index:integer;
m:integer;
countnul:integer;
mas:array[1..100] of string;
poslines:array[1..100] of integer;
poswords:array[1..100] of integer;
massive:array[1..1000] of string;
ind:integer;
k:integer;
num:integer;
mm:integer;
begin
index:=1;
ind:=1;
len:=len*100;
for g:=0 to alllines-1 do //цикл allli¬es-количество строк
if pos(input,book[g].w)<>0 then //если ¬введеное слово найдено в массиве то у на¬с есть номер массива в котором содержитс¬я строка
begin
DivStrToWrd(book[g].w);//разбиваем стро¬ку на слова
posline:=g;//позиция строки искомого сл¬ова
for c:=1 to cnt do//цикл определения по¬зиции слова в строке
if input=wrd[c] then 
begin
posofword:=c;//если введеное слово=слов¬у из разбитой на слова строки(которая в -массиве wrd) то позиция равняется с
poslines[index]:=posline;
poswords[index]:=c;
inc(index);
end;
end;
for m:=1 to same do
begin
posofword:=poswords[m];
posline:=poslines[m];
l1:=length(inttostr(alllines));//length¬ определяет количество символов;узнаем с¬колько символов
l2:=length(inttostr(posline));
l3:=length(inttostr(maxsymbol));//
l4:=length(inttostr(posofword));//
if l1>l2 then 
begin
c1:=l1-l2;//получаем количество нулей к¬оторые мы добавим вначале строки
for i:=1 to c1 do enc1:=enc1+'0';//доба¬вляем
end;
if l3>l4 then 
begin
c2:=l3-l4;//то же самое
for i:=1 to c2 do enc2:=enc2+'0';
end;
mas[ind]:=(enc1+inttostr(posline)+enc2+inttostr(posofword)+' ');//выводим на эк¬ран
inc(ind);
enc1:='';
enc2:='';
if posofword=0 then 
begin
inc(countnul);
dec(same);
end;
end;
i:=1;
k:=1;
while i<=100 do 
begin
while k<=same do
begin 
massive[i]:=mas[k];
inc(k);
inc(i);
end;
k:=1;
inc(i);
end;
if countnul>same then
for i:=1 to same+countnul+same-1 do
write(massive[i])
else
for i:=1 to same+countnul+1 do
write(massive[i])
end;
Function Decode(input:string;book:tbookdata):string;
var
l1,l2:integer;
st1,st2:string;
l3:integer;
i:integer;
st3:string;
yes:integer;
Begin
l1:=length(inttostr(alllines));//определяем кол-во символов 
l3:=length(input);//колво символов стро¬ки
for i:=1 to l1 do st1:=st1+input[i];//т¬ут мы разбиваем строку на две пример 031¬ разбимваем на 03 1 зависит сколько симв¬олов в l1;допустим 00301-всего строк 200¬(в числе 200 три символа значит в первой¬ строке будет три символа от введенной с¬троки а на 2 строку оставшиеся символы)
For i:=l1+1 to l3 do st2:=st2+input[i];
i:=1;
while st1[i]='0' do//избавляемся от нул¬ей до тех пор пока не будет символ нерав¬ный 0
if st1[i]='0' then Delete(st1,i,1) else break;//если символ равен 0 удаляем из ¬строки ноль
while st2[i]='0' do
if st2[i]='0' then Delete(st2,i,1) else break;
//итого в st1 у нас номер строки в st2 номер позиции
st3:=book[strtoint(st1)].w;//strtoint-перевод из строки в число;st3 присваиваем¬ строку из массива
DivStrToWrd(st3);//разбиваем строку на слова чтобы вытянуть по позиции слова ис¬комое слово
write(wrd[strtoint(st2)]+' ');
end;
var str:string;
i:integer;
w:string;
c:integer;
k:integer;
g:integer;
max:integer;
l:integer;
yes:integer;
wordsame:string;
book:tbookdata;
begin
SetConsoleCP(1251); 
SetConsoleOutputCP(1251); 

maxsymbol:=0;
index:=0;
book:=loadbook;//вызываем функцию 
for i:=0 to length(book)-1 do//с помощю length определяем макс число элементов массива
if book[i].symbolcount>=maxsymbol then maxsymbol:=book[i].symbolcount;//макс число элементов в строке
writeln('Кодируем-1,Декадируем-0: ');
readln(yes);
writeln('Введите текст');
readln(str);
i:=1;
while i<=length(str) do//разбиваем на слова введенную строку,пример Ветер леденит сначала будет идти работа со словом ветер а затем со след словом
begin
while (i<=length(str)) and (str[i]=' ') do i:=i+1;
w:='';
while (i<=length(str)) and (str[i]<>' ') do
begin
w:=w+str[i];//получили слово
i:=i+1;
end;
sameword[index]:=w; 
inc(index);
end;
same:=1;
for i:=0 to index-1 do
begin
if wordsame= sameword[i] then
begin tr:=true; inc(same);
end
else wordsame:=sameword[i]; 
end;
countwords:=index;
len:=index*index;
if yes=1 then
begin
if tr then Encode(sameword[i],book)
else
for l:=0 to index-1 do
begin
Encode(sameword[l],book);
//Decode(sameword[l],book);
end;
end
else
begin
if tr then Encode(sameword[i],book)
else
for l:=0 to index-1 do
begin
Decode(sameword[l],book);
end;
end;
end.

[Alegun]

Неа уважаемый(ая), оно работает, только вот что делает - неведомо, запускать просто надо с админскими правами

Оффтоп:
Нарушение ПФ П.П.2.4 и 2.5 детектед <<<del>>>