[ Foro de Pascal ]
Necesito poner un control para que solo me deje escribir en entrada 10 caracteres como mucho. Os paso el programa.
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[5];
vis:integer;
con:char;
a1:reg1;
begin
CON:='S';
WHILE(CON='S') DO BEGIN
clrscr;
repeat
write(' Dar Autor : ');
nn:='';
readln(nn);
clrscr;
a1.Autor:=nn;
until nn <>'';
clrscr;
repeat
write('Dar Editorial: ');
nn:='';
readln(nn);
clrscr;
a1.Edito:=nn;
until nn <>'';
clrscr;
repeat
write(' Dar Lugar : ');
nn:='';
readln(nn);
clrscr;
a1.Lugar:=nn;
until 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 max2:integer);
var
i,z,jj,f:integer;
a1:reg1;
begin
clrscr;
i:=0;
reset(fichero);
i:=filesize(fichero);
if i>0 then begin
jj:=0;
z:=0;
repeat
f:=0;
gotoxy(1,1);
gotoxy(1,2);write('Numero de registros:',i);
writeln;
writeln;
writeln('Autor Editorial Cod_Libro Info A-B');
while not eof(fichero) and (z<=6+jj) do begin
read(fichero,a1);
gotoxy(1,5+f);write(a1.autor);
gotoxy(22,5+f);write(a1.edito);
gotoxy(46,5+f);write(a1.cod_libro);
gotoxy(54,5+f);write(a1.lugar);
gotoxy(77,5+f);write(a1.con);
writeln;
inc(z);
inc(f);
end;
jj:=z;
readkey;
clrscr;
until eof(fichero);
end else begin
writeln('NO HAY DATOS');
delay(500);
end;
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;
repeat
write('Dar nuevo Autor:');
readln(nunom);
clrscr;
a.Autor:=nunom;
until nunom <> '';
writeln;
write('Editorial: ',a.Edito);
writeln;
repeat
write('Dar nueva editorial:');
readln(nunom);
clrscr;
a.Edito:=nunom;
until nunom <> '';
writeln;
write('Lugar:',a.Lugar);
writeln;
repeat
write('Dar nuevo Lugar:');
readln(nunom);
clrscr;
a.Lugar:=nunom;
until 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('REORGANIZANDO...');
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);
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;
var
max2:integer;
begin
clrscr;
archivo;
repeat
menu;
case opci of
1:entrada;
2:listado(max2);
3:modifica;
4:busqueda;
5:reorga;
6:archivo;
end;
until opci=7;
writeln;
writeln;
end.
El fuente resulta muy difícil de leer con tantas tabulaciones tan grandes. Yo te recomendaría usar un editor que te tabule con espacios y poner un tamaño de tabulación de 4 espacios.
El título de tu pregunta habla de ficheros, pero la pregunta en sí parece referirse a entrada por teclado... si quieres que se introduzca por teclado no más de 10 letras para una cadena de texto, tendrás que hacerte una función a propósito, que use ReadKey para leer letra a letra y añadirle tú las condiciones necesarias para que no exceda esa longitud.
(No se puede continuar esta discusión porque tiene más de dos meses de antigüedad. Si tienes dudas parecidas, abre un nuevo hilo.)