Moduļu veidošana un darbs ar tiešās pieejas failu Pascalā

[TinaT]

Man ir gatavs programmas kods, kur prasība ir viena ieraksta izmaiņa failā.

Bet vajadzētu - divu ierakstu apmainīšana failā (pēc uzdotas pazīmes). Īsti nesaprotu kā to realizēt kodā.

 

 

Uzdevums: Izstrādāt galveno programmu un moduli tiešās pieejas failu darbību analīzei. Failam jāsatur fiksēta garuma ieraksti (piem. simbolu rindas). Paredzēt apakšprogrammas sekojošam failu darbībām:

• faila izveidošana
• divu ierakstu apmainīšana failā (uzdotas pazīmes)
• faila satura apskatīšana.

Moduļa  LAB5UN pirmteksts

unit lab5un;

interface

uses LAB5IO;

type MyRec= record

      name1 : STR39;

      name2 : STR39;

      end;

type Myfiletype = file of MyRec;

var MyFileERR :integer;

procedure Fcreate(var fff:Myfiletype; filename:string; var FileOpen: boolean);

procedure Fopenf ( var fff:Myfiletype;filename:string; var FileOpen:boolean);

procedure Fview  ( var fff:Myfiletype; FileOpen: boolean);

procedure FRwRec ( var fff:Myfiletype; FileOpen: boolean);

procedure FClose ( var fff:Myfiletype; var FileOpen: boolean);

 

implementation

uses CRT;

procedure Fcreate(var fff:Myfiletype; filename:string; var FileOpen: boolean);

var RC, n, i: integer;

    answer : string[1];

    rec :MyRec;

label BUILD;

begin

assign(fff, filename);

{$I-}

RC:=13;

reset(fff);

{$I+}

RC:=ioresult;

if (RC=0) then

      if (FileRewr(filename) = FALSE) then

          begin

          close(fff);

          FileOpen:=False;

          MyFileErr:=1;

          exit;

          end;

 

{$I-}

rewrite(fff);

{$I+}

     if(IOResult<>0) then begin

                          MyFileErr:=3;

                          FileOpen:=False;

                          exit;

                          end;

       n:=NumOfRec;

 

       Rec.Name1:='                                              ';

       Rec.Name2:='                                              ';

       for i:=0 to n do

       begin

        Rec.name1:= chr($61 +i);

        Rec.name2:= chr($30 +i);

        write(fff,Rec);

       end;

close(fff);

          FileOpen:=False;

end;

 

procedure FOpenF( var fff:Myfiletype; filename:string; var FileOpen: boolean);

begin

assign(fff, filename);

{$I-}

reset(fff);

{$I+}

if (ioresult=0)

 then FileOpen:=TRUE

 else begin

          FileOpen:=False;

          MyFileErr:=4;

      end;

end;

 

procedure Fview( var fff:Myfiletype; FileOpen: boolean);

var

i :integer; rec:Myrec;

begin

if (FileOpen=False) then

      begin

        WriteLntext(' Fails nav atverts ; Darbibu nevar izpildiit');

        exit;

      end;

i:=0;

seek(fff,i);

while (eof(fff)<> TRUE) do

begin

read(fff,rec);

WriteLnRec('Ieraksts #:', i,'     ',rec.name1, '  ', rec.name2);

i:=i+1;

end;

seek(fff,0);

end;

 

procedure FRwRec( var fff:Myfiletype; FileOpen: boolean);

var Rec:Myrec;

var i: integer;

begin

if (FileOpen=False) then

      begin

        WriteLnText(' Fails nav atverts ; Darbibu nevar izpildiit');

        exit;

      end;

WriteLnTEXT (' Ievadi labojamaa ieraksta numuru ');

{$I-}

readINT(i);

 

seek(fff,i);

{$I+}

if (ioresult=0)

 then FileOpen:=TRUE

 else begin

          MyFileErr:=5;

          exit;

      end;

      READREC(Rec.name1, Rec.name2);

 

write(fff, rec);

end;

 

procedure FClose( var fff:Myfiletype; var FileOpen: boolean);

begin

if (FileOpen=False) then

      begin

        WriteLnText(' Fails nav atverts ; Darbibu nevar izpildiit');

        exit;

      end;

WriteLnText (' Aizveram failu ');

close(fff);

FileOpen:=False;

end;

 

begin

     MyFileErr:=0;

end.

 

Moduļa LAB5IO pirmteksts

unit lab5IO;

interface

  var

  MyFileErr: integer;

  type

  STR39= string[39];

 

  function FileRewr(filename:string): boolean;

  function NumOfRec: integer;

  procedure WriteLnTEXT( OUTTEXT: string);

  procedure readINT(var i: integer);

  procedure READREC(var STR1, STR2 : STR39);

  procedure WriteLnRec(str1: string; i:integer; str2,str3,str4,str5:string);

  procedure FError ;

 

implementation

uses CRT;

 

function FileRewr(filename:string): boolean;

var answer:string;

 begin

      writeln('Fails ',filename,' eksiste vai veidot to no jauna ?');

      writeln(' j/n ');

      read(answer);

      if( (answer='j') or (answer='J')) then

          begin

          writeln(' esoso failu paarrakstam');

          FileRewr:= TRUE;

 

     exit;

          end

      else

          begin

          writeln('tiek saglabaats esosais fails ');

          FileRewr:= FALSE;

          end;

 end;

 

 function NumOfRec: integer;

   label INPNUM;

   var n : integer;

   begin

  INPNUM:         writeln('Cik ierakstus gatavot (skaitam 0, 1, 2, 3,.. n)?');

{$I-}

       read(n);

{$I+}

           if(IOResult<>0) then

     begin

          writeln(' Nepareizi ievadiits ierakstu skaits');

          writeln(' Ievadiit vajag no jauna');

          goto INPNUM;

     end;

     NumOfRec:=n;

  end;

 

  procedure WriteLnTEXT( OUTTEXT: string);

    begin

      writeln( OUTTEXT);

    end;

 

  procedure readINT(var i: integer);

  begin

  read(i);

  end;

 

  procedure READREC(var STR1, STR2 : STR39);

  begin

  writeln(' Ievadi labojamaa ieraksta pirmo lauku');

    readln;

   readln(STR1);

   writeln(' Ievadi labojamaa ieraksta otro lauku');

   read;

   readln(STR2);

   end;

 

     procedure WriteLnRec(str1: string; i:integer; str2,str3,str4,str5:string);

    begin

            writeln(str1, i:3,str2,str3,str4, str5);

    end;

 

 

procedure FError ;

begin

   case (MyFileErr) of

1: writeln( ' ######01 lietotaajs neatlauj paarrakstit esoso failu ');

2: writeln( ' ######02 Kluuda ievadotierakstu skaitu veidojamaa failaa');

3: writeln( ' ######03 Neizdodas radiit failu');

4: writeln( ' ######01 Nevar atveert pieprasiito failu');

5: writeln( ' ######04 Nepielaujams labojamaa ieraksta numurs');

   else writeln(' ######55 Faila apstraades kluuda  Nr:', MyFileErr);

   end;

   MyFileErr:=0;

   writeln(' ###### nospied taustinu ');

   readkey;

end;

 

 begin

 MyFileErr:=0;

 end.

 

Vadības programmas pirmteksts

program lab5;

uses lab5un, lab5IO;

var Mydata: Myfiletype;

    Myrecc : Myrec;

    MydataOpen : boolean ;

var    RC:integer;

    filename: string;

    Oper: integer;

label CASEPOINT;

    begin

    MyDataOpen:=False;

CASEPOINT:

    if (MyFileErr<>0) then FError;

 

    writeln(' Ko darisim ?');

    writeln('1 - veidosim jaunu failu');

    writeln('2 - atversim esosu failu');

    writeln('3 - apskatisim faila saturu');

    writeln('4 - mainisim failaa viena ieraksta saturu');

    writeln('5 - aizvert failu ');

    writeln('6 - beigt darbu ');

    readln (Oper);

    case (Oper) of

  1: begin

       write('Ievadi faila vaardu ');

       read;

       readln(filename);

       FCreate(MyData, filename,MyDataOpen);

     end;

 

  2: begin

       write('Ievadi faila vaardu ');

       read;

       readln(filename);

       FOpenf(MyData, filename, MyDataOpen );

       if(MyDataOpen=true) then writeln('Fails ',filename,' atverts sekmigi')

         else writeln('Failu ',filename,' atvert neizdevaas');

     end;

 

  3: begin

       Fview(MyData, MydataOpen);

     end;

 

  4: begin

       FRwRec(MyData, MyDataOpen);

     end;

 

  5: begin

       FClose(MyData, MyDataOpen);

     end;

  6: begin

       exit;

     end;

 end;

 

  goto CASEPOINT;

end.

 

 

 

[gathis]

1) izveidojam jaunu tmp failu

2) lasam datus un rakstam jaunajā (vajadzīgā brīdī samainot ierakstus) tmp faila

3) kad dati ierakstīti aiztaisam abus failus, veco izdzēšam un jauno pārsaucam.

[TinaT]

Ja es mainu procedure FRwRec uz

 

procedure FExchange( var fff:Myfiletype; FileOpen: boolean);

var rec1,rec2:Myrec;

var i,j: integer;

begin

 

  if (FileOpen=False) then begin

    writeln(' Fails nav atverts ; Darbibu nevar izpildiit'); readln; exit;

  end;

 

  {$I-}

    writeln ('Ievadi pirmaa ieraksta nummuru '); readln(i);

    writeln ('Ievadi otraa ieraksta nummuru '); readln(j);

    seek(fff,i); read(fff,rec1);

    seek(fff,j); read(fff,rec2);

    seek(fff,i); write(fff,rec2);

    seek(fff,j); write(fff,rec1);

  {$I+}

 

  if (ioresult=0) then FileOpen:=TRUE

  else begin

    MyFileErr:=5; exit;

  end;

 

Man programma neiet. Un kā definēt Pascal kodā tās pazīmes?

[Svekris]

 

 

Latvijas augstskolās

 

Nav jau nekur rakstīts, ka augstskola.
Atminos, vidusskolas laikā pasniedzēja, lai sagatavotu programmēšanas olimpiādei lika censoņiem priekšā līdzīgus kalambūrus. *tai pašā laikā ar čomiem blakus HoMM3 rāvām hotsītā.    

[TinaT]

Nu es arī nezinu un neizprotu ko tas pasniedzējs grib, domāju, ka varbūt kāds ir saskāries un ir kāda ideja.
Vai arī ir kāds RTU students, kam tāds darbs bijis.