Помогите решить задачку на типизированные файлы в Паскале. Спасибо)

[ЮляшА]

Tupe gama = record
Месяц : 1..12 ;
Число : 1..31 ;
End.
FD = file of gama ;
Описать процедуру, которая из файла D переписывает в файл S все летние даты, а в файл W все зимние даты.

procedure proc;
var TempGama:gama;
begin
 while not eof(FD) do
  begin
   read(FD,TempGama);
   if (TempGama.month=12) or (TempGama.month<3) then write(FW,TempGama);
   if (TempGama.month>5) and (TempGama.month<9) then write(FS,TempGama);
  end;
end;

вот там если сама процедура то как-то так
а вот как создавать файлы я совсем не понимаю
и оформить задачу вообщем не могу(((

[Arkuz]

Как долго я вспоминал... Но всё-таки сделал...

Делал на Delphi - консольное приложение. На Turbo Pascal 7.0 проверил, сразу ругаться начал на параметры функции. Да и по-моему в турбе нет функции FileExists. Так что компилите в Delphi

Получилось примерно вот так:

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils;
type
  date = record
           month:1..12;
           day:1..31;
         end;
  fd = file of date;
var
  dates1,summer1,winter1: fd;
  a:date;
  i,m,d:integer;

procedure sort(var dates:fd; var summer:fd; var winter:fd);
begin
    while not Eof(dates) do
            begin
                BlockRead(dates,a,sizeof(a));
                writeln('month: ',a.month,'     day: ',a.day);
                if (a.month>=6) and (a.month<=8)
                   then BlockWrite(summer,a,sizeof(a));
                if (a.month=1) or (a.month=2) or (a.month=12)
                   then BlockWrite(winter,a,sizeof(a));
            end;
end;

begin
 randomize;
 writeln('!!!START!!!');
 if FileExists('summer.txt')
   then
     begin
       Assign(summer1,'summer.txt');
       Erase(summer1);
       Assign(summer1,'summer.txt');
       Rewrite(summer1);
     end
   else
     begin
       Assign(summer1,'summer.txt');
       Rewrite(summer1);
     end;
 if FileExists('winter.txt')
   then
     begin
       Assign(winter1,'winter.txt');
       Erase(winter1);
       Assign(winter1,'winter.txt');
       Rewrite(winter1);
     end
   else
     begin
       Assign(winter1,'winter.txt');
       Rewrite(winter1);
     end;
 writeln('Files summer.txt and winter.txt is remake!');

 if not FileExists('dates.txt')
     then
        begin
           writeln('File dates.txt is not exist!');
           Assign(dates1,'dates.txt');
           Rewrite(dates1);
           for i:=1 to 12 do
              begin
                 m:=random(12);
                 if m=0 then m:=1;
                 d:=random(31);
                 if d=0 then d:=1;
                 a.month:=m;
                 a.day:=d;
                 BlockWrite(dates1,a,sizeof(a));
              end;
           writeln('File is create!');
           Close(dates1);
           Assign(dates1,'dates.txt');
           Reset(dates1);
           sort(dates1,summer1,winter1);
        end
          else
            begin
              Assign(dates1,'dates.txt');
              Reset(dates1);
              sort(dates1,summer1,winter1);
            end;
  writeln;
  writeln('summer.txt content: ');
  Seek(summer1,0);
  while not Eof(summer1) do
    begin
      BlockRead(summer1,a,sizeof(a));
      writeln('month: ',a.month,'     day: ',a.day);
    end;
  writeln;
  writeln('winter.txt content: ');
  Seek(winter1,0);
  while not Eof(winter1) do
    begin
      BlockRead(winter1,a,sizeof(a));
      writeln('month: ',a.month,'     day: ',a.day);
    end;
  Close(summer1);
  Close(winter1);
  Close(dates1);
  readln;
end.

[ЮляшА]

Сообщение от Arkuz

К Да и по-моему в турбе нет функции FileExists.

Угук, там такого нету)

Ток вот оч надо на паскале...
Не подскажите, что надо исправить?
И можно ли вообще как-нибудь аккуратненько её под паскаль приспособить?))

[Serge_Bliznykov]

скопипастено из библиотеки TurboPorfessional:

uses Dos;

  function ExistFile(FName : string) : Boolean;
    {-Return true if file is found}
  var
    FLen : Byte absolute FName;
    Regs : Registers;

  begin
    {check for empty string}
    if Length(FName) = 0 then
      ExistFile := False
    else with Regs do begin
      Inc(FLen);
      FName[FLen] := #0;
      AX := $4300;           {get file attribute}
      DS := Seg(FName);
      DX := Ofs(FName[1]);
      MsDos(Regs);
      ExistFile := (not Odd(Flags)) {and (IoResult = 0)} and {!!.10}
                   (CX and (VolumeID+Directory) = 0);
    end;
  end;


begin
  if ExistFile('c:\tp\bin\turbo2.exe') 
    then WriteLn('File exists!')
    else WriteLn('Oh. NO! File not found!')
end.

p.s. или у себя в программе везде, где вызывается поменяйте на ExistFile или исправьте имя функции поменяйте на FileExists

[Arkuz]

Serge_Bliznykov, мне кажется будет сильно сложно для обычной лабораторной работы, если использовать предложенный Вами код из библиотеки TurboPorfessional.

И можно ли вообще как-нибудь аккуратненько её под паскаль приспособить?))

Pascal ещё помимо проверки существования файла ругается на параметры функции.
Можно исправить, но либо без функции, а в теле программы все сделать, или с функцией, но функция будет оперировать глобальными переменными.