uses crt,dos;
TYPE
REG1=RECORD
Autor:STRING[20];
Edito:STRING[30];
Cod_Libro:string[5];
Lugar:string[30];
con:char;
END;
VAR
fichero:file of reg1;
fichcopia:file of reg1;
OPCION,OPCID:char;
OPCI,Z,I:INTEGER;
nf:string[30];
a:reg1;
procedure conum(var nom1:string;h:integer);
var
p:char;
i1,cc:integer;
begin
for i1:=1 to h do begin
gotoxy(20+i1,1);
write(chr(176));
end;
i1:=0;
cc:=1;
repeat
gotoxy(21+i1,1);p:=upcase(readkey);
case p of
#8:begin
i1:=i1-1;
if i1<0 then i1:=0;
gotoxy(21+i1,1);
write(chr(176));
cc:=cc-1;
if cc<1 then cc:=1;
delete(nom1,cc,1);
end;
#48..#57:begin
if cc<=h then begin
write(p);
insert(p,nom1,cc);
i1:=i1+1;
cc:=cc+1;
end;
end;
end;
until(p=#13) and (cc>h);
end;
PROCEDURE mirarepe(nn:string;VAR vis:INTEGER);
var pu:integer;
kk:boolean;
BEGIN
reset(fichero);
pu:=0;
kk:=true;
while(pu<filesize(fichero)) and kk do begin
read(fichero,a);
IF(a.cod_libro=nn) THEN BEGIN
vis:=pu;
kk:=false;
END;
inc(pu);
END;
close(fichero);
END;
procedure entrada;
var
nn:string;
vis:integer;
con:char;
a1:reg1;
begin
CON:='S';
WHILE(CON='S') DO BEGIN
clrscr;
write(' Dar Autor : '); nn:='';
readln(nn);
a1.Autor:=nn;
clrscr;
write('Dar Editorial: '); nn:='';
readln(nn);
a1.Edito:=nn;
clrscr;
write(' Dar Lugar : '); nn:='';
readln(nn);
a1.Lugar:=nn;
clrscr;
writeln(' Dar Codigo Libro : '); nn:='';
conum(nn,5);
a1.Cod_libro:=nn;
a1.con:='a';
vis:=-22;
mirarepe(nn,vis);
if (vis=-22) then begin
reset(fichero);
seek(fichero,filesize(fichero));
write(fichero,a1);
close(fichero);
clrscr;
end
else writeln('No Valido '); writeln;
write('Mas entradas S - N : '); REPEAT
con:=upcase(readkey);
UNTIL UPCASE(CON) IN['N','S'];
END;
end;
procedure listado;
var
zz,h1:integer;
begin
reset(fichero);
zz:=filesize(fichero);
clrscr;
writeln(' LISTADO: '); writeln;
if zz>0 then begin
h1:=2;
while(not(eof(fichero)))do begin
read(fichero,a);
writeln;
gotoxy(15,1);
writeln('Autor:'); gotoxy(15,h1);
writeln(a.Autor);
gotoxy(25,1);
writeln('Editorial:'); gotoxy(25,h1);
writeln(a.Edito);
gotoxy(38,1);
writeln('Lugar:'); gotoxy(38,h1);
writeln(a.Lugar);
gotoxy(48,1);
writeln('CodLibro:'); gotoxy(48,h1);
writeln(a.Cod_libro);
gotoxy(61,1);
writeln('Alta/Baja:'); gotoxy(61,h1);
writeln(a.con);
inc(h1);
end;
end;
writeln;
write('Dar tecla : ');readln; close(fichero);
end;
procedure modifica;
var
x1,x2:integer;
cod2:string[5];
nunom:string[20];
ok:boolean;
begin
reset(fichero);
clrscr;
write('Dar Codigo Libro: '); cod2:='';
conum(cod2,5);
writeln;
x2:=filesize(fichero);
x1:=0;
ok:=true;
while(x1<x2) and ok do begin
seek(fichero,x1);
read(fichero,a);
if (a.Cod_libro=cod2) then begin
writeln;
write('Autor: ',a.Autor); writeln;
write('Dar nuevo Autor:'); readln(nunom);
a.Autor:=nunom;
writeln;
write('Editorial: ',a.Edito); writeln;
write('Dar nueva editorial:'); readln(nunom);
a.Edito:=nunom;
writeln;
write('Lugar:',a.Lugar); writeln;
write('Dar nuevo Lugar:'); readln(nunom);
a.Lugar:=nunom;
seek(fichero,x1);
write(fichero,a);
ok:=false;
end;
inc(x1);
end;
writeln;
write('Dar tecla: '); readln; close(fichero);
end;
procedure busqueda;
var
x1,x2:integer;
editor:string[30];
ok:boolean;
l1:char;
begin
reset(fichero);
clrscr;
write('Dar Editorial: '); editor:='';
readln(editor);
writeln;
x2:=filesize(fichero);
x1:=0;
ok:=true;
while(x1<x2) and ok do begin
seek(fichero,x1);
read(fichero,a);
if (a.Edito=editor) then begin
writeln;
write('Cambiar Control S :');l1:=upcase(readkey); if (l1='S') then begin
l1:=a.con;
case l1 of
'a':a.con:='b'
else a.con:='a';
end;
end;
seek(fichero,x1);
write(fichero,a);
ok:=false;
end
else begin
inc(x1);
end;
end;
writeln;
write('Dar tecla: '); readln; close(fichero);
end;
procedure reorga;
var zz,l1,posi:integer;
begin
reset(fichero);//abrimos fichero con reset
zz:=filesize(fichero);//filesize numero registro de mi fichero
clrscr;
writeln('LISTADO 2'); WRITELN('##########'); writeln;
if zz>0 then begin
assign(fichcopia,'Ficopia.dat');
rewrite(fichcopia);
posi:=0;
for l1:=0 to zz-1 do begin
seek(fichero,l1);
read(fichero,a);
if (a.con='a') then begin
seek(fichcopia,posi);
write(fichcopia,a);
inc(posi);
writeln(a.Autor,a.Edito,a.Lugar,a.Cod_libro,a.con);
end;
end;
close(fichcopia);
end;
writeln;
write('Fin Reorga Dar tecla : ');readln; close(fichero);//siempre cerrar fichero con close
erase(fichero);
rename(fichcopia,nf);
end;
procedure menu;
var
a:array[1..12] of string[20];
begin
a[1]:=' (1) ENTRADA ';
A[2]:=' (2) LISTADO ';
A[3]:=' (3) MODIFICA ';
A[4]:=' (4) BUSQUEDA ';
a[5]:=' (5) REORGA ';
a[6]:=' (6) ESC FICHERO';
a[7]:=' (7) FIN ';
A[8]:=' MENU - GENERAL ';
textbackground(brown);
clrscr;
gotoxy(29,4);
WRITE(A[8]);
textcolor(7);textbackground(0);
gotoxy(55,1);
WRITE('FICHERO -> ',nf);
for i:=1 to 7 do begin
gotoxy(29,5+2*i);
write(a[i]);
end;
OPCION:=' ';
WHILE OPCION<>'S'DO BEGIN
IF OPCI<1 THEN OPCI:=7;
IF OPCI>7 THEN OPCI:=1;
gotoxy(29,5+2*opci);
textcolor(0);textbackground(7);
write(a[opci]);
textcolor(7);textbackground(0);
opcid:=READKEY;
z:=opci;
CASE OPCID OF
#80:OPCI:=OPCI+1;
#72:OPCI:=OPCI-1;
#49:OPCI:=1;
#50:OPCI:=2;
#51:OPCI:=3;
#52:OPCI:=4;
#53:opci:=5;
#54:opci:=6;
#55:opci:=7;
#13:OPCION:='S';
END;
gotoxy(29,5+2*z);
write(a[z]);
END;
end;
procedure controlarch;
var ok:boolean;
begin
gotoxy(35,1);
WRITE('FICHERO -> ',nf); {$I-} assign(fichero,nf);
reset(fichero);
{$I+} ok:=(ioresult=0);
if not ok then begin
clrscr;
writeln(' Fichero No existente ');delay(1000); rewrite(fichero);
end
else begin
writeln(' Fichero existente ');delay(1000); reset(fichero);
end;
close(fichero);
end;
procedure archivo;
var
a:array[1..7] of string[20];
begin
a[1]:='Revistas.dat';
A[2]:='Libros.dat';
A[3]:='CD.dat';
A[4]:='Texto.dat';
a[5]:='Varios.dat';
A[6]:=' MENU - FICHEROS ';
textbackground(brown);
clrscr;
gotoxy(27,4);
WRITE(A[6]);
textcolor(7);textbackground(0);
for i:=1 to 5 do begin
gotoxy(29,5+2*i);
write(a[i]);
end;
OPCION:=' ';
WHILE OPCION<>'S'DO BEGIN
IF OPCI<1 THEN OPCI:=5;
IF OPCI>5 THEN OPCI:=1;
gotoxy(29,5+2*opci);
textcolor(0);textbackground(7);
write(a[opci]);
textcolor(7);textbackground(0);
opcid:=READKEY;
z:=opci;
CASE OPCID OF
#80:OPCI:=OPCI+1;
#72:OPCI:=OPCI-1;
#49:OPCI:=1;
#50:OPCI:=2;
#51:OPCI:=3;
#52:OPCI:=4;
#53:opci:=5;
#13:OPCION:='S';
END;
gotoxy(29,5+2*z);
write(a[z]);
case opci of
1:nf:=a[1];
2:nf:=a[2];
3:nf:=a[3];
4:nf:=a[4];
5:nf:=a[5];
end;
END;
controlarch;
end;
begin
clrscr;
archivo;
repeat
menu;
case opci of
1:entrada;
2:listado;
3:modifica;
4:busqueda;
5:reorga;
6:archivo;
end;
until opci=7;
end.
Crear cuenta