[Smile188]

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

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259

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>>>