uses Crt,Dos;
type Nalogoviyainspekciya=record
Sname_firmi,Name_firmi:string[15];
vidsob:string[20];
viddeyat:string[20];
telephone:string[20];
faks:string[20];
adres:integer;
end;
var f:file of Nalogoviyainspekciya;
zn,filename:string;
k:integer;
label 11;
{-----------------------------------------------------------}
procedure Creatfile;
begin
writeln('ZADAITE IMIA FAILA KOTORIY BUDET SOZDAVATSYA');
readln(filename);
assign(f,filename);
rewrite(f);
end;
{-----------------------------------------------------------}
procedure Addrecord;
var rez:integer; ch:char;
begin
while rez<>1 do
begin
writeln('ZADAITE IMIA FAILA, V KOTORIY BUDET DOBOVLIATSA ZAPIS');
readln(filename);
assign(f,filename);
reset(f);
rez:=IOResult;
if rez<>0 then
begin
writeln('PROVERTE PRAVILNOST IMENI FAILA!');
writeln('BUDET LI POVTORNOE ZADANIE IMENI FAILA?(Y/N)');
readln(ch);
if (ch='n') or (ch='N') then halt (0);
end;
end;
seek(f,filesize(f));
end;
{==========================================================}
procedure Inputfile;
var st:Nalogoviyainspekciya;
k:char;
begin
repeat
writeln('VVEDITE DANIE O NOVOY FIRME : ');
write('NAZVANIE FIRMI : '); readln(st.Sname_firmi);
write('VID SOBSTVENNOSTI:' ); readln(st.vidsob);
write('VID DEYATELNOSTI:'); readln(st.viddeyat);
write('TELEPHONE:'); readln(st.telephone);
write('FAKS:'); readln(st.faks);
write('ADRES: '); readln(st.adres);
write(f,st);
write('NADO LI VVODIT DANNIE O NOVOY FIRME ? (Y/N)>');readln(k);
writeln;
until(k='n') or (k='N');
close(f);
end;
{=========================================================}
procedure redzap;
var
st:Nalogoviyainspekciya;
filename,str:string;
Sname_firmi2,Name_firmi2:string[15];
vidsob2:string[20];
viddeyat2:string[20];
telephone2:string[20];
faks2:string[20];
adres2:integer;
x:integer;
begin
writeln('ZADAITE IMIA FAILA');
readln(filename);
assign(f,filename);
reset(f);
with st do
begin write('VVEDITE NAZVANIE FIRMI: ');readln(str);
x:=0;
while not eof(f) do
begin
read(f,st);
if st.Sname_firmi=str then
begin
writeln('VVEDITE DANIE O NOVOY FIRME : ');
write('NAZVANIE FIRMI : '); readln(st.Sname_firmi);
write('VID SOBSTVENNOSTI:' ); readln(st.vidsob);
write('VID DEYATELNOSTI:'); readln(st.viddeyat);
write('TELEPHONE:'); readln(st.telephone);
write('FAKS:'); readln(st.faks);
write('ADRES: '); readln(st.adres);
Sname_firmi2:=Sname_firmi; viddeyat2:=viddeyat;
vidsob2:=vidsob; telephone2:=telephone;
faks2:=faks; adres2:=adres;
seek(f,filepos(f)-1);
write(f,st); x:=1;
end; end;
close(f);
end;
if x=0 then begin writeln('zapisi s takoy firmoy net!');readln end;
end;
{==============================================================}
function Openfile: Boolean;
var
rez: integer;
ch: char;
begin
Openfile:=False;
repeat
writeln('ZADAITE IMIA FAILA');
readln(filename);
assign(f,filename);
reset(f);
rez:=IOResult;
if rez<>0 then
begin
writeln('PROVERTE PRAVILNOST IMENI FAILA!');
writeln('BUDET LI POVTORNOE ZADANIE IMENI FAILA ? (Y/N)');
readln(ch);
if UpCase(ch)='N' then halt (0);
end
else
Openfile:=True;
until (rez=0) or (UpCase(ch)='N');
end;
{============================================================}
procedure Outputfile;
var st:Nalogoviyainspekciya;k:char;
begin
writeln('HOTITE POSMOTRET DANNIE O FIRMAH? (Y/N)');
readln(k);
if (k='y') or (k='Y') then
while not eof(f) do
begin
read(f,st); clrscr;
writeln('NAZVANIE FIRMI :',st.Sname_firmi);
writeln('VID SOBSTVENNOSTI:',st.vidsob);
writeln('VID DEYATELNOSTI:',st.viddeyat);
writeln('TELEPHONE:',st.telephone);
writeln('FAKS:',st.faks);
writeln('ADRES:',st.adres);
writeln('DLYA PRODOLGENIA NAGMITE (enter)');
readln;
end;
close(f);
end;
{========================================================}
procedure Clearfile;
var st:Nalogoviyainspekciya;
studtoout:string[20];
fo:file of Nalogoviyainspekciya;
begin
writeln('ZADAYTE IMIA FAILA IZ KOTOROGO UDALIUTSA ELEMENTI');
readln(filename);
assign(f,filename);reset(f);
assign(fo,'newfile.dat');rewrite(fo);
writeln('Zadayte nazvanie firmi zapis kotoroy udalietsa');
readln(studtoout);
while not eof(f) do
begin
read(f,st);
if st.Sname_firmi<>studtoout then write(fo,st);
end;
close(f);close(fo);
erase(f);
rename(fo,filename);
end;
{ОСНОВНАЯ ЧАСТЬ ПРОГРАММЫ}
Begin 11:clrscr;
writeln(' MENU:');
writeln('1:SOZDAT FILE');
writeln('2:DOBAVLENIE ZAPISI V FAIL');
writeln('3:KORREKTIROVKA ZAPISI');
writeln('4:PROSMOTR FAILA');
writeln('5:UDALENIE ZAPISI IS FAILA');
writeln('6:VIHOD IZ PROGRAMMI');
readln(k);
case k of
1: begin Creatfile; Inputfile end;
2: begin Addrecord; Inputfile end;
3: redzap;
4: if Openfile then Outputfile;
5: Clearfile;
6: Halt;
else
writeln('OSHIBKA POVTORITE NOMER REGIMA.')
end; goto 11;
End.
[Pascal]_не добавляется запись в создаваемый файл, а так все работает
:rolleyes:
Код:
uses Crt,Dos;
type Nalogoviyainspekciya=record
Sname_firmi,Name_firmi:string[15];
vidsob:string[20];
viddeyat:string[20];
telephone:string[20];
faks:string[20];
adres:integer;
end;
var f:file of Nalogoviyainspekciya;
zn,filename:string;
k:integer;
label 11;
{-----------------------------------------------------------}
procedure Creatfile;
begin
writeln('ZADAITE IMIA FAILA KOTORIY BUDET SOZDAVATSYA');
readln(filename);
assign(f,filename);
rewrite(f);
end;
{-----------------------------------------------------------}
procedure Addrecord;
var rez:integer; ch:char;
begin
{while rez<>1 do
begin }
writeln('ZADAITE IMIA FAILA, V KOTORIY BUDET DOBOVLIATSA ZAPIS');
readln(filename);
assign(f,filename);
reset(f);
rez:=IOResult;
if rez<>0 then
begin
writeln('PROVERTE PRAVILNOST IMENI FAILA!');
writeln('BUDET LI POVTORNOE ZADANIE IMENI FAILA?(Y/N)');
readln(ch);
if (ch='n') or (ch='N') then halt (0);
end;
{end;}
seek(f,filesize(f));
end;
{==========================================================}
procedure Inputfile;
var st:Nalogoviyainspekciya;
k:char;
begin
repeat
writeln('VVEDITE DANIE O NOVOY FIRME : ');
write('NAZVANIE FIRMI : '); readln(st.Sname_firmi);
write('VID SOBSTVENNOSTI:' ); readln(st.vidsob);
write('VID DEYATELNOSTI:'); readln(st.viddeyat);
write('TELEPHONE:'); readln(st.telephone);
write('FAKS:'); readln(st.faks);
write('ADRES: '); readln(st.adres);
write(f,st);
write('NADO LI VVODIT DANNIE O NOVOY FIRME ? (Y/N)>');readln(k);
writeln;
until(k='n') or (k='N');
close(f);
end;
{=========================================================}
procedure redzap;
var
st:Nalogoviyainspekciya;
filename,str:string;
Sname_firmi2,Name_firmi2:string[15];
vidsob2:string[20];
viddeyat2:string[20];
telephone2:string[20];
faks2:string[20];
adres2:integer;
x:integer;
begin
writeln('ZADAITE IMIA FAILA');
readln(filename);
assign(f,filename);
reset(f);
with st do
begin write('VVEDITE NAZVANIE FIRMI: ');readln(str);
x:=0;
while not eof(f) do
begin
read(f,st);
if st.Sname_firmi=str then
begin
writeln('VVEDITE DANIE O NOVOY FIRME : ');
write('NAZVANIE FIRMI : '); readln(st.Sname_firmi);
write('VID SOBSTVENNOSTI:' ); readln(st.vidsob);
write('VID DEYATELNOSTI:'); readln(st.viddeyat);
write('TELEPHONE:'); readln(st.telephone);
write('FAKS:'); readln(st.faks);
write('ADRES: '); readln(st.adres);
Sname_firmi2:=Sname_firmi; viddeyat2:=viddeyat;
vidsob2:=vidsob; telephone2:=telephone;
faks2:=faks; adres2:=adres;
seek(f,filepos(f)-1);
write(f,st); x:=1;
end; end;
close(f);
end;
if x=0 then begin writeln('zapisi s takoy firmoy net!');readln end;
end;
{==============================================================}
function Openfile: Boolean;
var
rez: integer;
ch: char;
begin
Openfile:=False;
repeat
writeln('ZADAITE IMIA FAILA');
readln(filename);
assign(f,filename);
reset(f);
rez:=IOResult;
if rez<>0 then
begin
writeln('PROVERTE PRAVILNOST IMENI FAILA!');
writeln('BUDET LI POVTORNOE ZADANIE IMENI FAILA ? (Y/N)');
readln(ch);
if UpCase(ch)='N' then halt (0);
end
else
Openfile:=True;
until (rez=0) or (UpCase(ch)='N');
end;
{============================================================}
procedure Outputfile;
var st:Nalogoviyainspekciya;k:char;
begin
writeln('HOTITE POSMOTRET DANNIE O FIRMAH? (Y/N)');
readln(k);
if (k='y') or (k='Y') then
while not eof(f) do
begin
read(f,st); clrscr;
writeln('NAZVANIE FIRMI :',st.Sname_firmi);
writeln('VID SOBSTVENNOSTI:',st.vidsob);
writeln('VID DEYATELNOSTI:',st.viddeyat);
writeln('TELEPHONE:',st.telephone);
writeln('FAKS:',st.faks);
writeln('ADRES:',st.adres);
writeln('DLYA PRODOLGENIA NAGMITE (enter)');
readln;
end;
close(f);
end;
{========================================================}
procedure Clearfile;
var st:Nalogoviyainspekciya;
studtoout:string[20];
fo:file of Nalogoviyainspekciya;
begin
writeln('ZADAYTE IMIA FAILA IZ KOTOROGO UDALIUTSA ELEMENTI');
readln(filename);
assign(f,filename);reset(f);
assign(fo,'newfile.dat');rewrite(fo);
writeln('Zadayte nazvanie firmi zapis kotoroy udalietsa');
readln(studtoout);
while not eof(f) do
begin
read(f,st);
if st.Sname_firmi<>studtoout then write(fo,st);
end;
close(f);close(fo);
erase(f);
rename(fo,filename);
end;
{ОСНОВНАЯ ЧАСТЬ ПРОГРАММЫ}
Begin 11:clrscr;
writeln(' MENU:');
writeln('1:SOZDAT FILE');
writeln('2:DOBAVLENIE ZAPISI V FAIL');
writeln('3:KORREKTIROVKA ZAPISI');
writeln('4:PROSMOTR FAILA');
writeln('5:UDALENIE ZAPISI IS FAILA');
writeln('6:VIHOD IZ PROGRAMMI');
readln(k);
case k of
1: begin Creatfile; Inputfile end;
2: begin Addrecord; Inputfile end;
3: redzap;
4: if Openfile then Outputfile;
5: Clearfile;
6: Halt;
else
writeln('OSHIBKA POVTORITE NOMER REGIMA.')
end; goto 11;
End.
type Nalogoviyainspekciya=record
Sname_firmi,Name_firmi:string[15];
vidsob:string[20];
viddeyat:string[20];
telephone:string[20];
faks:string[20];
adres:integer;
end;
var f:file of Nalogoviyainspekciya;
zn,filename:string;
k:integer;
label 11;
{-----------------------------------------------------------}
procedure Creatfile;
begin
writeln('ZADAITE IMIA FAILA KOTORIY BUDET SOZDAVATSYA');
readln(filename);
assign(f,filename);
rewrite(f);
end;
{-----------------------------------------------------------}
procedure Addrecord;
var rez:integer; ch:char;
begin
{while rez<>1 do
begin }
writeln('ZADAITE IMIA FAILA, V KOTORIY BUDET DOBOVLIATSA ZAPIS');
readln(filename);
assign(f,filename);
reset(f);
rez:=IOResult;
if rez<>0 then
begin
writeln('PROVERTE PRAVILNOST IMENI FAILA!');
writeln('BUDET LI POVTORNOE ZADANIE IMENI FAILA?(Y/N)');
readln(ch);
if (ch='n') or (ch='N') then halt (0);
end;
{end;}
seek(f,filesize(f));
end;
{==========================================================}
procedure Inputfile;
var st:Nalogoviyainspekciya;
k:char;
begin
repeat
writeln('VVEDITE DANIE O NOVOY FIRME : ');
write('NAZVANIE FIRMI : '); readln(st.Sname_firmi);
write('VID SOBSTVENNOSTI:' ); readln(st.vidsob);
write('VID DEYATELNOSTI:'); readln(st.viddeyat);
write('TELEPHONE:'); readln(st.telephone);
write('FAKS:'); readln(st.faks);
write('ADRES: '); readln(st.adres);
write(f,st);
write('NADO LI VVODIT DANNIE O NOVOY FIRME ? (Y/N)>');readln(k);
writeln;
until(k='n') or (k='N');
close(f);
end;
{=========================================================}
procedure redzap;
var
st:Nalogoviyainspekciya;
filename,str:string;
Sname_firmi2,Name_firmi2:string[15];
vidsob2:string[20];
viddeyat2:string[20];
telephone2:string[20];
faks2:string[20];
adres2:integer;
x:integer;
begin
writeln('ZADAITE IMIA FAILA');
readln(filename);
assign(f,filename);
reset(f);
with st do
begin write('VVEDITE NAZVANIE FIRMI: ');readln(str);
x:=0;
while not eof(f) do
begin
read(f,st);
if st.Sname_firmi=str then
begin
writeln('VVEDITE DANIE O NOVOY FIRME : ');
write('NAZVANIE FIRMI : '); readln(st.Sname_firmi);
write('VID SOBSTVENNOSTI:' ); readln(st.vidsob);
write('VID DEYATELNOSTI:'); readln(st.viddeyat);
write('TELEPHONE:'); readln(st.telephone);
write('FAKS:'); readln(st.faks);
write('ADRES: '); readln(st.adres);
Sname_firmi2:=Sname_firmi; viddeyat2:=viddeyat;
vidsob2:=vidsob; telephone2:=telephone;
faks2:=faks; adres2:=adres;
seek(f,filepos(f)-1);
write(f,st); x:=1;
end; end;
close(f);
end;
if x=0 then begin writeln('zapisi s takoy firmoy net!');readln end;
end;
{==============================================================}
function Openfile: Boolean;
var
rez: integer;
ch: char;
begin
Openfile:=False;
repeat
writeln('ZADAITE IMIA FAILA');
readln(filename);
assign(f,filename);
reset(f);
rez:=IOResult;
if rez<>0 then
begin
writeln('PROVERTE PRAVILNOST IMENI FAILA!');
writeln('BUDET LI POVTORNOE ZADANIE IMENI FAILA ? (Y/N)');
readln(ch);
if UpCase(ch)='N' then halt (0);
end
else
Openfile:=True;
until (rez=0) or (UpCase(ch)='N');
end;
{============================================================}
procedure Outputfile;
var st:Nalogoviyainspekciya;k:char;
begin
writeln('HOTITE POSMOTRET DANNIE O FIRMAH? (Y/N)');
readln(k);
if (k='y') or (k='Y') then
while not eof(f) do
begin
read(f,st); clrscr;
writeln('NAZVANIE FIRMI :',st.Sname_firmi);
writeln('VID SOBSTVENNOSTI:',st.vidsob);
writeln('VID DEYATELNOSTI:',st.viddeyat);
writeln('TELEPHONE:',st.telephone);
writeln('FAKS:',st.faks);
writeln('ADRES:',st.adres);
writeln('DLYA PRODOLGENIA NAGMITE (enter)');
readln;
end;
close(f);
end;
{========================================================}
procedure Clearfile;
var st:Nalogoviyainspekciya;
studtoout:string[20];
fo:file of Nalogoviyainspekciya;
begin
writeln('ZADAYTE IMIA FAILA IZ KOTOROGO UDALIUTSA ELEMENTI');
readln(filename);
assign(f,filename);reset(f);
assign(fo,'newfile.dat');rewrite(fo);
writeln('Zadayte nazvanie firmi zapis kotoroy udalietsa');
readln(studtoout);
while not eof(f) do
begin
read(f,st);
if st.Sname_firmi<>studtoout then write(fo,st);
end;
close(f);close(fo);
erase(f);
rename(fo,filename);
end;
{ОСНОВНАЯ ЧАСТЬ ПРОГРАММЫ}
Begin 11:clrscr;
writeln(' MENU:');
writeln('1:SOZDAT FILE');
writeln('2:DOBAVLENIE ZAPISI V FAIL');
writeln('3:KORREKTIROVKA ZAPISI');
writeln('4:PROSMOTR FAILA');
writeln('5:UDALENIE ZAPISI IS FAILA');
writeln('6:VIHOD IZ PROGRAMMI');
readln(k);
case k of
1: begin Creatfile; Inputfile end;
2: begin Addrecord; Inputfile end;
3: redzap;
4: if Openfile then Outputfile;
5: Clearfile;
6: Halt;
else
writeln('OSHIBKA POVTORITE NOMER REGIMA.')
end; goto 11;
End.
[COLOR="Red"]Оформляй правильно код,пользуйся тегами
Код:
m_Valery