{A ver si esto te encamina }
program miajenda;
uses
crt, dos;
type
string10 = string[10];
string5 = string[5];
ajenda = record
hoja : longint;
fecha : string10;
acont1 : string;
hora : string5;
acont2 : string;
end;
const
archivo = 'Ajendas.dat';
var
f : file of ajenda;
dato : ajenda;
procedure tomadatos(d : ajenda);
var
hoj : longint;
begin
assign(f,archivo);
{$I-} reset(f); {$I+} if ioresult <> 0 then
begin
hoj := 1;
d.hoja := hoj;
rewrite(f);
seek(f,0);
write(f,d);
close(f);
end
else
begin
hoj := filesize(f);
d.hoja := hoj;
seek(f,filesize(f));
write(f,d);
close(f);
end;
end;
procedure entradatos;
begin
clrscr;
writeln(' /// Entrada Datos Ajenda \\\'); writeln;
with dato do
begin
write(' Entre Fecha dia/mes/a¤o : '); readln(fecha);
write(' Entre Datos 1§ : '); readln(acont1);
write(' Entre Hora hora:min : '); readln(hora);
write(' Entre datos 2§ : '); readln(acont2);
end;
tomadatos(dato);
end;
procedure muestradatos;
var
ar : longint;
tt : integer;
begin
tt := 1;
assign(f,archivo);
{$I-} reset(f); {$I+} if ioresult <> 0 then
begin
writeln(' Error De Archivo O No Existe Pulse Una Tecla'); readkey;
end
else
begin
for ar := 0 to filesize(f) - 1 do
begin
seek(f,ar);
read(f,dato);
writeln(' ',dato.fecha,'-',dato.acont1,'-',dato.hora,'-', dato.acont2);
tt := tt + 1;
if tt > 20 then
begin
writeln;
writeln(' Pulse Una Tecla Para Segir'); readkey;
tt := 1;
clrscr;
end;
end;
close(f);
writeln;
writeln(' Pulse Una Tecla'); readkey;
end;
end;
procedure alarma(fec : string10; hor : string5);
var
ar : longint;
encont : boolean;
begin
assign(f,archivo);
{$I-} reset(f); {$I+} if ioresult <> 0 then
begin
writeln(' Error De Archivo O No Existe Pulse Una Tecla'); readkey;
end
else
begin
encont := false;
for ar := 0 to filesize(f) - 1 do
begin
seek(f,ar);
read(f,dato);
if (dato.fecha = fec) and (dato.hora = hor) then
begin
writeln;
writeln(' ',dato.fecha,'-',dato.acont1,'-',dato.hora,'-', dato.acont2);
close(f);
encont := true;
writeln;
writeln(' Pulse Una Tecla'); readkey;
end;
end;
if encont = false then
begin
close(f);
writeln;
writeln(' Datos No Encontrados'); writeln(' Fercha Y Hora = ',fec,' ',hor); writeln;
writeln(' Pulse Una Tecla'); readkey;
end;
end;
end;
procedure menu;
var
te, tecla : char;
sal : boolean;
yo, me, di, dis : word;
ho, mi, se, ds : word;
ado : string[4];
mes, dia : string[2];
hor, min : string[2];
fe : string10;
horas : string5;
begin
sal := false;
repeat
clrscr;
writeln(' ***** Menu Jeneral *****'); writeln;
writeln(' 1 = Entrada Datos'); writeln(' 2 = Mostrar Datos'); writeln(' 3 = Alarma informacion'); writeln(' 4 = Salir'); writeln;
writeln(' Elija Una Opcion'); repeat
tecla := readkey;
until tecla in['1','2','3','4'];
clrscr;
case tecla of
'1' : entradatos;
'2' : muestradatos;
'3' : begin
getdate(yo, me, di, dis);
gettime(ho, mi, se, ds);
str(yo,ado);
str(me,mes);
str(di,dia);
str(ho,hor);
str(mi,min);
fe := dia + '/' + mes + '/' + ado;
horas := hor + ':' + min;
writeln(' Busqueda Manual=[M] Automatica=[A]'); writeln;
repeat
te := upcase(readkey);
until te in['A','M'];
clrscr;
if te = 'A' then
alarma(fe,horas)
else
begin
write(' Entre Fecha dia/mes/a¤o : '); readln(fe);
write(' Entre Hora hora:min : '); readln(horas);
alarma(fe,horas);
end;
end;
'4' : sal := true;
end;
until sal = true;
end;
begin
menu;
end.
Crear cuenta
