1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code]. 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.