Код:
Program курсовая;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils;
//односвязный список
Type
p=^elem;
elem = record
data:string;
sled:p;
end;
Var ykaz:p;
c:char;
r,k:string;
//процедура чтения файла в динамический список
Procedure read;
var next:p;
F:textfile;
flag:boolean;
begin
Assign(F,'text.txt');
Reset(F);
next:=ykaz; //делаем временный указатель, для прохождения по списку
while not EoF(F) do //пока, не конец файла
begin
readln(F,next^.data); //читаем строку в поле data
if next^.data=' ' then flag:=true; //если файл не пустой, то запоминаем это
if (next^.data=' ') and flag then //если файл пустой, то...
begin
dispose(next);
next:=nil;
flag:=true; //...запоминает это, и..
exit; //...выходим из подпрограммы.
end;
new(next^.sled); //если всё хорошо, выделяем память под следущий элемент списка
next:=next^.sled; //переходим на него (присваиваем его основному указателю)
end;
close(F); //прекращаем работу с файлом
end;
//процедура записи в файл из динамического массива
Procedure write;
var F:textfile;
ykz,l:p;
begin
Assign(F,'text.txt');
Rewrite(F);
ykz:=ykaz;
while (ykz<>nil) do //если текущий указатель имеет непустое значение, то..
begin
Writeln(F,ykz^.data); //записываем в файл строку, и ..
l:=ykz^.sled;
dispose(ykz); //уничтожаем текущий элемент списка
ykz:=l; //переходим на следущий указатель
end;
close(F); //закрываем файл.
end;
//процедура удаления лишних знаков
Procedure prob (var s:string);
var i:integer;
begin
i:=1;
while i<length(s) do
begin
if (s[i]=' ') or (s[i]='.') or (s[i]='?') or (s[i]='!') or (s[i]=',') then
begin
case s[i+1] of
' ', '?', '.', '!':
begin
Delete(s,i,1);
{if not (s[i+2]=' ') then
begin
insert(' ',s,i+2);
dec(i);
end; }
end; //удаляем пробел перед перчисленными знаками
else inc(i); // передвигаемся если не было удаления (единственный пробел)
end;
end
else inc(i); //или вообще не пробел
end;
end;
//замена числа на словесный строковый эквивалент
Procedure zamena (m:integer; var l:string);
const a:array [1..4,1..10] of string = (('', 'один ', 'два ', 'три ', 'четыре ', 'пять ', 'шесть ', 'семь ', 'восемь ', 'девять '),
('', 'одиннадцать ', 'двенадцать ', 'тринадцать ', 'четырнадцать ', 'пятнадцать ', 'шестнадцать ', 'семнадцать ', 'восемнадцать ', 'девятнадцать '),
('', 'десять ', 'двадцать ', 'тридцать ', 'сорок ', 'пятьдесят ', 'шестьдесят ', 'семьдесят ', 'восемьдесят ', 'девяносто '),
('', 'сто ', 'двести ', 'триста ', 'четыреста ', 'пятьсот ', 'шестьсот ', 'семьсот ', 'восемьсот ', 'девятьсот '));
var b,c,d:integer;
begin
l:='';
l:=l+a[4][m div 100+1];
If ((m div 10) mod 10=1)then l:=l+a[2][(m div 10) mod 10+1] else
begin
l:=l+a[3][(m div 10) mod 10+1];
l:=l+a[1][m mod 10+1];
end;
end;
//процедура поиска и замены слов
Procedure change (var s:string; r,k:string);
var flag:boolean;
i,m,err,del:integer;
t:string;
begin
flag:=false;
i:=1;
Repeat
If ((s[i]=r[1]) and (s[i+1]=r[2]) and (s[i+2]=r[3]) and (s[i+3]=r[4])) or ((s[i]=k[1]) and (s[i+1]=k[2])) and ((s[i+2]=k[3]) and (s[i+3]=k[4])) then flag:=true;
if flag then
begin
if i=3 then t:=copy(s,1,1)
else if i=4 then t:=copy(s,1,2)
else t:=copy(s,i-4,3);
val(t,m,err);
del:=3;
While err<>0 do
begin
delete(t,1,1);
if t='' then break;
val(t,m,err);
del:=del-1;
end;
if t='' then break;
zamena(m,t);
delete(s,i-del-1,del);
insert(t,s,i-del);
i:=i+length(t);
end;
flag:=false;
i:=i+1;
Until i>=(length(s)-3);
end;