Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 08.05.2011, 12:40   #1
chajka18
 
Регистрация: 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.
chajka18 вне форума Ответить с цитированием
Старый 08.05.2011, 12:41   #2
chajka18
 
Регистрация: 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.
chajka18 вне форума Ответить с цитированием
Старый 08.05.2011, 12:42   #3
chajka18
 
Регистрация: 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.
chajka18 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Не сохраняет файлы (Создает файлы пустышки) 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