![]() |
|
|
Регистрация Восстановить пароль |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
![]() |
|
Опции темы | Поиск в этой теме |
![]() |
#1 |
Регистрация: 25.04.2011
Сообщений: 3
|
![]()
Подскажите, пжлста, как добавить следующий пункт
-посвторная вставка файла в файл после каждой 3 записи ![]() код: 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. |
![]() |
![]() |
![]() |
#2 |
Регистрация: 25.04.2011
Сообщений: 3
|
![]()
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. |
![]() |
![]() |
![]() |
#3 |
Регистрация: 25.04.2011
Сообщений: 3
|
![]()
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. |
![]() |
![]() |
![]() |
![]() |
||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Не сохраняет файлы (Создает файлы пустышки) | Rock231 | Помощь студентам | 2 | 25.12.2010 12:31 |
Файлы данных.Типизированные файлы. | вылка | Помощь студентам | 6 | 17.05.2010 15:42 |
Типизированные файлы, Модуль Graph | Kate_Fleur | Помощь студентам | 0 | 10.05.2010 12:05 |
Типизированные файлы, модуль Crt, Модуль Graph | Kate_Fleur | Помощь студентам | 1 | 06.05.2010 17:43 |
два вредных вопроса:про асю и прикриплёные файлы файлы | steck | Свободное общение | 3 | 17.06.2007 14:53 |