1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
type DataArray=array[1..5000] of string; DataK=array[1..5000] of integer; var item: DataArray;{массив для сортировки} k: DataK; s:string; {временная переменная, предназначена для передачи в массив, или ссчитывания из него} ch,ch2:char; count,i,j,m:integer; fout:text;{файл для вывода объявляем текстовым, так как заносим в него строки} fin:file of char;{файл для ввода с типом char, чтобы процедура чтения read() получала по одному символу}
procedure Inser(var item: DataArray; var k: DataK; count:integer); {сортировка} var i, j, h: integer; x: string; begin for i := 2 to count do begin x := item[i]; h := k[i]; j := i-1; while (x<item[j]) and (j>0) do begin item[j+1] := item[j]; k[j+1] := k[j]; j := j-1; end; item[j+1] := x; k[j+1]:= h; end; end;
procedure Convert(var s:string); {ANSI -> ASCII} var i:integer; begin for i:=1 to length(s) do if ord(s[i]) in [192..207] then s[i]:=chr(ord(s[i])-32) {Буквы: А..П переводим в ASCII-код меняя на: а..п} else if ord(s[i]) in [208..223] then s[i]:=chr(ord(s[i])+16) {Буквы: Р..Я переводим в ASCII-код меняя на: р..я} else if ord(s[i]) in [224..239] then s[i]:=chr(ord(s[i])-64) {Буквы: а..п переводим в ASCII-код } else if ord(s[i]) in [240..255] then s[i]:=chr(ord(s[i])-16) {Буквы: р..я переводим в ASCII-код } else if ord(s[i])=168 then s[i]:=chr(ord(241)) {Букву Ё переводим в ASCII-код и меняем на: ё} else if ord(s[i])=184 then s[i]:=chr(ord(241)); {Букву ё переводим в ASCII-код} end;
procedure UnConvert(var a:string);{ASCII->ANSI} var i:integer; begin for i:=1 to length(a) do if ord(a[i]) in [128..175] then a[i]:=chr(ord(a[i])+64) else if ord(a[i]) in [224..239] then a[i]:=chr(ord(a[i])+16) else if ord(a[i])=240 then a[i]:=chr(ord(168)) else if ord(a[i])=241 then a[i]:=chr(ord(184)); end;
{начало основной программы} begin Assign(fin,'1.txt'); {ставим в соответствие файловым переменным имена файлов} Assign(fout,'2.txt'); Reset(fin); {открываем fin для чтения, а fout для записи} Rewrite(fout); i:=1; repeat {общий цикл, работает пока не дойдем до конца файла}
s:='';{очищаем переменную строки, для записи нового слова} repeat read(fin,ch);{cчитываем символ из файла} if ord(ch)=45 then begin if s<>'' then s:=s+ch; end; if (ch<>'.') and (ord(ch)<>32) and (ch<>',') and (ch<>'"') and (ord(ch)<>45) and (ch<>'?') and (ch<>'!') and (ch<>':') and (ord(ch)<>10) and (ord(ch)<>13) then s:=s+ch; until (ord(ch)=32) or (ord(ch)=10) or (EOF(fin)); if s<>'' then begin Convert(s); item[i]:=s; k[i]:=i; count:=i; i:=i+1; end; until EOF(fin);{если достигнут конец файла - выходим}
Inser(item,k,count); for i:=1 to count do begin s:=item[i]; m:=k[i]; UnConvert(s); write(fout, m,' '+s+chr(10)); end;
Close(fout);{закрываем оба файла} Close(fin); end.