function compare(d_1, d_2: string): integer;
function strtoint(s: string): integer;
var res, code: integer;
begin
val(s, res, code);
strtoint := res;
end;
function day(s: string): integer;
begin
day := strtoint(copy(s, 1, 2));
end;
function month(s: string): integer;
begin
month := strtoint(copy(s, 4, 2));
end;
function year(s: string): integer;
begin
year := strtoint(copy(s, 7, 2));
end;
var
yr1, yr2,
mt1, mt2,
dy1, dy2: integer;
begin
yr1 := year(d_1); yr2 := year(d_2);
if yr1 <> yr2 then compare := (yr1 - yr2) div abs(yr1 - yr2)
else begin
mt1 := month(d_1); mt2 := month(d_2);
if mt1 <> mt2 then compare := (mt1 - mt2) div abs(mt1 - mt2)
else begin
dy1 := day(d_1); dy2 := day(d_2);
if dy1 <> dy2 then compare := (dy1 - dy2) div abs(dy1 - dy2)
else compare := 0;
end
end
end;
просьба помочь с вызовом функции в основной программе.
Код:
и основная программа:
Код:
program k_2_2;
uses crt;
label 1,4,5,6,8,9,10,12,20,30,40,18,19;
type
tovar=record
naimenovanie:string[30];
strana_exporter:string[30];
data_postavki:string[10];
kolichestvo_tovara:byte;
end;
var
tov:array[1..100] of tovar;
f:file of tovar;
date,str:string;
k,l,n:integer;
i,j:byte;
ch:char;
quit:boolean;
simb:set of char;
smb:set of char;
begin
10:clrscr;
textcolor(white);
writeln(' МЕНЮ ');
writeln(' 1: Создание файла ');
writeln(' 2: Чтение файла ');
writeln(' 3: Добавление записи в файл ');
writeln(' 4: Выборка записей из файла ');
writeln(' 5: Выход ');
{readln(k);}
repeat
ch:=readkey;
until ch in ['1'..'5'];
k:=ord(ch)-ord('0');
{readln(k);}
case k of
1:goto 6;
2:goto 20;
3:goto 30;
4:goto 40;
5:goto 12;
end;
6:clrscr;
writeln('Введите полный адрес и имя типизированного файла');readln(str);
{$I-}
assign(f,str);
rewrite(f);
{$I+}
if IoResult<>0 then begin
writeln('Повтори ввод полного пути и имени типизированного файла');
writeln('');
delay(500);
goto 6;
end
else
{$I-}
8:writeln('Введите количество записей');readln(n);
{$I+}
if (IoResult<>0) or (n<=0) then begin
writeln('Повтори ввод количества записей !!!');
delay(500);
goto 8;
end
else
writeln('Введите наименование товара, страну - экспортер, срок поставки и количество товара');
for i:=1 to n do begin
writeln('Введите данные ',i,' - й записи');
with tov do begin
simb:=['А'..'Я','а'..'я',' ',#8];
write('Введите наименование товара : ');
naimenovanie:='';
repeat
if keypressed then begin
ch:=readkey;
if ch in simb then begin
write(ch);
naimenovanie:=naimenovanie+ch;
end;
end;
until ch=#13;
ch:=#0;
writeln;
write('Введите страну - экспортер : ');
strana_exporter:='';
repeat
if keypressed then begin
ch:=readkey;
if ch in simb then begin
write(ch);
strana_exporter:=strana_exporter+ch;
end;
end;
until ch=#13;
ch:=#0;
writeln;
smb:=['1'..'9','0','.',#8];
write('Введите дату поставки : ');
data_postavki:='';
repeat
if keypressed then begin
ch:=readkey;
if ch in smb then begin
write(ch);
data_postavki:=data_postavki+ch;
end;
end;
until ch=#13;
ch:=#0;
writeln;
{$I-}
9:write('Введите количество товара : '); readln(kolichestvo_tovara);
{$i+}
if (IoResult<>0) or (kolichestvo_tovara<=0) or(kolichestvo_tovara>1000) then begin
writeln('Повтори ввод количества товара !!!');
delay(500);
goto 9;
end
else
writeln;
writeln('Нажмите Enter');readln;
end;
write(f,tov);
end;
close(f);
str:='';
goto 10;
20:clrscr;
writeln('Введите полный адрес и имя типизированного файла');readln(str);
{$I-}
assign(f,str);
reset(f);
{$I+}
if IoResult<>0 then begin
writeln('Повтори ввод полного пути и имени типизированного файла');
writeln('');
delay(5000);
goto 20;
end
else
i:=0;
while not eof(f) do begin
i:=i+1;
read(f,tov);
writeln(tov.naimenovanie);
writeln(tov.strana_exporter);
writeln(tov.data_postavki);
writeln(tov.kolichestvo_tovara);
end;
close(f);
writeln;
writeln('Для выхода в меню нажмите клавишу Enter...');
readln;
goto 10;
30:clrscr;
writeln('Введите полный адрес и имя типизированного файла');readln(str);
{$I-}
assign(f,str);
reset(f);
{$I+}
if IoResult<>0 then begin
writeln('Повтори ввод полного пути и имени типизированного файла');
writeln('');
delay(5000);
goto 30;
end
else
n:=filesize(f);
seek(f,n);
n:=n+1;
18:writeln('Введите количество записей');readln(n);
{$I+}
if (IoResult<>0) or (n<=0) then begin
writeln('Повтори ввод количества записей !!!');
delay(500);
goto 18;
end
else
writeln('Введите наименование товара, страну - экспортер, срок поставки и количество товара');
for i:=1 to n do begin
writeln('Введите данные ',i,' - й записи');
with tov do begin
write('Введите наименование товара : '); readln(naimenovanie);
write('Введите страну - экспортер : '); readln(strana_exporter);
write('Введите дату поставки : '); readln(data_postavki);
{$I-}
19:write('Введите количество товара : '); readln(kolichestvo_tovara);
{$i+}
if (IoResult<>0) or (kolichestvo_tovara<=0) or(kolichestvo_tovara>1000) then begin
writeln('Повтори ввод количества товара !!!');
delay(500);
goto 19;
end
else
writeln;
writeln('Нажмите Enter');readln;
end;
write(f,tov);
end;
close(f);
goto 10;
40:clrscr;
writeln('Введите полный адрес и имя типизированного файла');readln(str);
{$I-}
assign(f,str);
reset(f);
{$I+}
if IoResult<>0 then begin
writeln('Повтори ввод полного пути и имени типизированного файла');
writeln('');
delay(5000);
goto 40;
end
else
writeln('Введите дату'); readln(date);
i:=0;
j:=0;
while not eof(f) do begin
i:=i+1;
read(f,tov);
if tov.data_postavki<date then
begin
j:=1;
writeln(tov.naimenovanie);
writeln(tov.strana_exporter);
writeln(tov.data_postavki);
writeln(tov.kolichestvo_tovara);
end;
end;
if j=0 then writeln('Ни одна запись не удовлетворяет введенному условию');
close(f);
writeln;
writeln('Для выхода в меню нажмите клавишу Enter...');
readln;
goto 10;
12:clrscr;
writeln('Завершить работу программы ? ');
writeln(' "д" -да "н"-нет ');
repeat
if keypressed then
ch:=readkey;
case readkey of
'д':quit:=true;
'н':goto 10;
end;
until quit;
end.
uses crt;
label 1,4,5,6,8,9,10,12,20,30,40,18,19;
type
tovar=record
naimenovanie:string[30];
strana_exporter:string[30];
data_postavki:string[10];
kolichestvo_tovara:byte;
end;
var
tov:array[1..100] of tovar;
f:file of tovar;
date,str:string;
k,l,n:integer;
i,j:byte;
ch:char;
quit:boolean;
simb:set of char;
smb:set of char;
begin
10:clrscr;
textcolor(white);
writeln(' МЕНЮ ');
writeln(' 1: Создание файла ');
writeln(' 2: Чтение файла ');
writeln(' 3: Добавление записи в файл ');
writeln(' 4: Выборка записей из файла ');
writeln(' 5: Выход ');
{readln(k);}
repeat
ch:=readkey;
until ch in ['1'..'5'];
k:=ord(ch)-ord('0');
{readln(k);}
case k of
1:goto 6;
2:goto 20;
3:goto 30;
4:goto 40;
5:goto 12;
end;
6:clrscr;
writeln('Введите полный адрес и имя типизированного файла');readln(str);
{$I-}
assign(f,str);
rewrite(f);
{$I+}
if IoResult<>0 then begin
writeln('Повтори ввод полного пути и имени типизированного файла');
writeln('');
delay(500);
goto 6;
end
else
{$I-}
8:writeln('Введите количество записей');readln(n);
{$I+}
if (IoResult<>0) or (n<=0) then begin
writeln('Повтори ввод количества записей !!!');
delay(500);
goto 8;
end
else
writeln('Введите наименование товара, страну - экспортер, срок поставки и количество товара');
for i:=1 to n do begin
writeln('Введите данные ',i,' - й записи');
with tov do begin
simb:=['А'..'Я','а'..'я',' ',#8];
write('Введите наименование товара : ');
naimenovanie:='';
repeat
if keypressed then begin
ch:=readkey;
if ch in simb then begin
write(ch);
naimenovanie:=naimenovanie+ch;
end;
end;
until ch=#13;
ch:=#0;
writeln;
write('Введите страну - экспортер : ');
strana_exporter:='';
repeat
if keypressed then begin
ch:=readkey;
if ch in simb then begin
write(ch);
strana_exporter:=strana_exporter+ch;
end;
end;
until ch=#13;
ch:=#0;
writeln;
smb:=['1'..'9','0','.',#8];
write('Введите дату поставки : ');
data_postavki:='';
repeat
if keypressed then begin
ch:=readkey;
if ch in smb then begin
write(ch);
data_postavki:=data_postavki+ch;
end;
end;
until ch=#13;
ch:=#0;
writeln;
{$I-}
9:write('Введите количество товара : '); readln(kolichestvo_tovara);
{$i+}
if (IoResult<>0) or (kolichestvo_tovara<=0) or(kolichestvo_tovara>1000) then begin
writeln('Повтори ввод количества товара !!!');
delay(500);
goto 9;
end
else
writeln;
writeln('Нажмите Enter');readln;
end;
write(f,tov);
end;
close(f);
str:='';
goto 10;
20:clrscr;
writeln('Введите полный адрес и имя типизированного файла');readln(str);
{$I-}
assign(f,str);
reset(f);
{$I+}
if IoResult<>0 then begin
writeln('Повтори ввод полного пути и имени типизированного файла');
writeln('');
delay(5000);
goto 20;
end
else
i:=0;
while not eof(f) do begin
i:=i+1;
read(f,tov);
writeln(tov.naimenovanie);
writeln(tov.strana_exporter);
writeln(tov.data_postavki);
writeln(tov.kolichestvo_tovara);
end;
close(f);
writeln;
writeln('Для выхода в меню нажмите клавишу Enter...');
readln;
goto 10;
30:clrscr;
writeln('Введите полный адрес и имя типизированного файла');readln(str);
{$I-}
assign(f,str);
reset(f);
{$I+}
if IoResult<>0 then begin
writeln('Повтори ввод полного пути и имени типизированного файла');
writeln('');
delay(5000);
goto 30;
end
else
n:=filesize(f);
seek(f,n);
n:=n+1;
18:writeln('Введите количество записей');readln(n);
{$I+}
if (IoResult<>0) or (n<=0) then begin
writeln('Повтори ввод количества записей !!!');
delay(500);
goto 18;
end
else
writeln('Введите наименование товара, страну - экспортер, срок поставки и количество товара');
for i:=1 to n do begin
writeln('Введите данные ',i,' - й записи');
with tov do begin
write('Введите наименование товара : '); readln(naimenovanie);
write('Введите страну - экспортер : '); readln(strana_exporter);
write('Введите дату поставки : '); readln(data_postavki);
{$I-}
19:write('Введите количество товара : '); readln(kolichestvo_tovara);
{$i+}
if (IoResult<>0) or (kolichestvo_tovara<=0) or(kolichestvo_tovara>1000) then begin
writeln('Повтори ввод количества товара !!!');
delay(500);
goto 19;
end
else
writeln;
writeln('Нажмите Enter');readln;
end;
write(f,tov);
end;
close(f);
goto 10;
40:clrscr;
writeln('Введите полный адрес и имя типизированного файла');readln(str);
{$I-}
assign(f,str);
reset(f);
{$I+}
if IoResult<>0 then begin
writeln('Повтори ввод полного пути и имени типизированного файла');
writeln('');
delay(5000);
goto 40;
end
else
writeln('Введите дату'); readln(date);
i:=0;
j:=0;
while not eof(f) do begin
i:=i+1;
read(f,tov);
if tov.data_postavki<date then
begin
j:=1;
writeln(tov.naimenovanie);
writeln(tov.strana_exporter);
writeln(tov.data_postavki);
writeln(tov.kolichestvo_tovara);
end;
end;
if j=0 then writeln('Ни одна запись не удовлетворяет введенному условию');
close(f);
writeln;
writeln('Для выхода в меню нажмите клавишу Enter...');
readln;
goto 10;
12:clrscr;
writeln('Завершить работу программы ? ');
writeln(' "д" -да "н"-нет ');
repeat
if keypressed then
ch:=readkey;
case readkey of
'д':quit:=true;
'н':goto 10;
end;
until quit;
end.
Просьба помочь вызвать функцию в основной программе.