Текстовый файл

[0IceCube0]

Здравствуйте помогите исправить одну ошибку

В файле содержатся различные даты. Каждая дата - это число, месяц и год. В новый файл переписать все даты, которые предшествуют заданной. Выдать на печать те даты, которые приходятся на високосные года.

Const month:array[1..12] of integer = (31,28,31,30,31,30,31,31,30,31,30,31);
var f:text ;
    d,m,y:integer;
function is_v(year:integer):boolean;
var r:boolean;
Begin
    if (year mod 4=0) and
       ((year mod 100<>0) or
       (year mod 400 =0)) then
        r:=TRUE
    else
        r:=FALSE;
End;
function compere(d,m,dd,mm:integer):boolean;
var r:boolean;
    val1,val2:integer;
Begin
    val1:=d+d*(month[m]);
    val2:=dd+dd*(month[mm]);
    if val1<val2 then
        r:=TRUE
    else
        r:=FALSE;
End;
procedure make_file(var f:text );
var yyyy,c,
    m,year,
    d:integer;
Begin
  year:=2009;
    ReWrite(f);
    for yyyy:=year to year+5 do
    for m:=1 to 12 do begin
        if is_v(yyyy) and (m=2) then c:=1 else c:=0;
        for d:=1 to month[m]+c do begin
            write(f,d,m,yyyy);
            writeln(f);
        end;
    end;
End;
procedure poisk (var f: text ;dd,mm,yy:integer);
var nf:text;
    d,m,yyyy:integer;
Begin
    ReSet(f);
    Assign(nf,'Vesokos.txt');
    ReWrite(nf);
    while not Eof(f) do begin
        read(f,d,m,yyyy);
        if compere(d,m,dd,mm) and (yyyy<=yy) then begin
            if is_v(yyyy) then writeln(d,',',m,',',yyyy);
            write(nf,d,m,yyyy);
            writeln(nf);
        end;
        readln(f);
    end;
    Close(nf);
End;
BEGIN
    ASSIGN(f,'Dati.txt');
    make_file(f);
    writeln('‚ўҐ¤ЁвҐ §*¤***го ¤*вг (з.¬.Ј.)');
    read(d,m,y);
    poisk(f,d,m,y);
    CLOSE(f);
    readln;
END.

в файле Vesokos выводит вот это
-1371710939-20133
-1334921115-9957
-317331291219
-308533611-27461
-2067713787-17285
-1050123963-7109

[Serge_Bliznykov]

процедура формирования файла с ошибками.
1-я (и самая большая!), когда Вы пишете число месяц и год в файл dati.txt вы забываете их разделять!
Даже человек не сможет понять, что такое 1112009 (где здесь месяц, где дата.. ;( )

2-я БОЛЬШАЯ ошибка. Все функции написаны неверно!
Нужно же результат действия функции возвращать!
а то, что Вы присвоили переменной R - это, извините, никому не поможет!

ну и из-за того, что не работают функции в файл dati.txt попадают несуществующие даты (например, 29 2 2009 )

попробуйте так:

const month: array[1..12] of integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
var f: text;
  d, m, y: integer;

function is_v(year: integer): boolean;
begin
  if (year mod 4 = 0) and
    ((year mod 100 <> 0) or
    (year mod 400 = 0)) then
    is_v := TRUE
  else
    is_v := FALSE;
end;

function CompareDate(d, m, dd, mm: integer): boolean;
var
  val1, val2: integer;
begin
  val1 := d + d * (month[m]);
  val2 := dd + dd * (month[mm]);
  if val1 < val2 then
    CompareDate := TRUE
  else
    CompareDate := FALSE;
end;

procedure make_file(var f: text);
var yyyy, c,
  m, year,
    d: integer;
begin
  year := 2009;
  ReWrite(f);
  for yyyy := year to year + 5 do
    for m := 1 to 12 do begin
      if is_v(yyyy) and (m = 2) then c := 1 else c := 0;
      for d := 1 to month[m] + c do begin
        write(f, d, ' ', m, ' ', yyyy);
        writeln(f);
      end;
    end;
end;

procedure poisk(var f: text; dd, mm, yy: integer);
var nf: text;
  d, m, yyyy: integer;
begin
  ReSet(f);
  Assign(nf, 'Vesokos.txt');
  ReWrite(nf);
  while not Eof(f) do begin
    read(f, d, m, yyyy);
    if CompareDate(d, m, dd, mm) and (yyyy <= yy) then begin
      if is_v(yyyy) then writeln(d, '.', m, '.', yyyy);
      write(nf, d,' ', m,' ', yyyy);
      writeln(nf);
    end;
    readln(f);
  end;
  Close(nf);
end;

begin
  ASSIGN(f, 'Dati.txt');
  make_file(f);
  writeln('Введите заданную дату (ч.м.г.)');
  read(d, m, y);
  poisk(f, d, m, y);
  CLOSE(f);
  readln;
end.

[0IceCube0]

Спасибо вам большое очень выручили