program clinica;
uses crt;
type
dono = record //Informações do dono
nome : string;
endereco : string;
telefone : integer;
end;
ficha = record //Ficha do animal
tipo_animal : string;
raca : string;
cor : string;
idade : integer;
ident_dono : dono;
end;
arqcad = file of ficha;
var
n : integer;
procedure cadastrar_animal();
var
arq_in, arq_out : arqcad;
animal : ficha;
Begin
assign(arq_out,'clinica.dat'); //associando nome interno com nome externo
reset(arq_out); //abrindo arquivo para gravação
WriteLn('Digite o tipo do animal');
ReadLN(animal.tipo_animal);
clrscr;
WriteLn('Digite a raca do animal');
ReadLN(animal.raca);
clrscr;
WriteLn('Digite a cor do animal');
ReadLN(animal.cor);
clrscr;
WriteLn('Digite a idade do animal');
ReadLN(animal.idade);
clrscr;
WriteLn('Digite o nome do dono');
ReadLN(animal.ident_dono.nome);
clrscr;
WriteLn('Digite o endereco do dono');
ReadLN(animal.ident_dono.endereco);
clrscr;
WriteLn('Digite o telefone do dono');
ReadLN(animal.ident_dono.telefone);
clrscr;
write(arq_out,animal); {grava registro após o último registro do arquivo}
close(arq_out);
clrscr;
WriteLN('Animal cadastrado com sucesso');
readkey;
End;
procedure consultar();
var
arq_out : arqcad;
animal : ficha;
dono : string;
i : integer;
achou : boolean;
Begin
WriteLN('Digite o nome do dono do animal');
ReadLN(dono);
assign(arq_out,'clinica.dat'); //associando nome interno com nome externo
reset(arq_out); //abrindo arquivo para gravação
achou := false;
For i := 0 to filesize(arq_out)-1 do
Begin
Seek(arq_out, i);
read(arq_out, animal);
If (animal.ident_dono.nome = dono)then
Begin
achou := true;
WriteLN('----- ANIMAL ENCONTRADO -----');
WriteLN('INFO:');
WriteLn('(1) Tipo : ', animal.tipo_animal);
WriteLn('(2) Raca : ', animal.raca);
WriteLn('(3) Cor : ', animal.cor);
WriteLn('(4) Idade : ', animal.idade);
WriteLn('(5) Nome do dono : ', animal.ident_dono.nome);
WriteLN('Pressione qualquer tecla...');
readkey;
end;
end;
If not (achou) then
Begin
WriteLn ('Animal nao encontrado!');
WriteLN('Pressione qualquer tecla...');
readkey;
end;
close(arq_out);
end;
procedure remover_animal();
var
arq_out, auxiliar : arqcad;
animal : ficha;
dono, remover : string;
i,j,k : integer;
achou : boolean;
Begin
WriteLN('Digite o nome do dono do animal');
ReadLN(dono);
assign(arq_out,'clinica.dat'); //associando nome interno com nome externo
reset(arq_out); //abrindo arquivo para gravação
achou := false;
For i := 0 to filesize(arq_out)-1 do
Begin
Seek(arq_out, i);
read(arq_out, animal);
If (animal.ident_dono.nome = dono)then
Begin
achou := true;
WriteLN('----- ANIMAL ENCONTRADO -----');
WriteLN('INFO:');
WriteLn('(1) Tipo : ', animal.tipo_animal);
WriteLn('(2) Raca : ', animal.raca);
WriteLn('(3) Cor : ', animal.cor);
WriteLn('(4) Idade : ', animal.idade);
WriteLn('(5) Nome do dono : ', animal.ident_dono.nome);
readkey;
close(arq_out);
If achou = true then
Begin
WriteLn('Deseja remover o cadastro do animal?(s/n)');
ReadLN(remover);
If remover = 's' then //Copia os dados para um arquivo auxiliar menos o que é igual ao nome do respectivo dono
begin
assign(auxiliar,'aux_data.dat');
reset(auxiliar);
reset(arq_out);
if j = 0 then
begin
for k := 1 to filesize(arq_out) -1 do
begin
seek(arq_out,k);
read(arq_out,animal);
seek(auxiliar,k-1);
write(auxiliar,animal);
end;
end
else
if j = filesize(arq_out)-1 then
begin
for k := 0 to filesize(arq_out) -2 do
begin
seek(arq_out,k);
read(arq_out,animal);
seek(auxiliar,k);
write(auxiliar,animal);
end;
//fim do for
end
else
begin
for k := 0 to j - 1 do
begin
seek(arq_out,k);
read(arq_out,animal);
seek(auxiliar,k);
write(auxiliar,animal);
end;
for k := j+1 to filesize(arq_out)-1 do
begin
seek(arq_out,k);
read(arq_out,animal);
seek(auxiliar,k-1);
write(auxiliar,animal);
end;
end;
end;
end;
end;
If achou = false then
Begin
WriteLn ('Animal nao encontrado!');
WriteLN('Pressione qualquer tecla...');
close(arq_out);
readkey;
end;
end;
end;
Begin
Repeat
clrscr;
WriteLN('----- CLINICA DO JAO ------');
WriteLN('(1) Cadastrar novo animal');
WriteLN('(2) Remover animal cadastrado');
WriteLN('(3) Alterar informações de um animal cadastrado');
WriteLN('(4) Consultar informações de um animal cadastrado');
WriteLN('(5) Apagar todos os registros');
WriteLN('(0) Sair');
ReadLN(n);
if n = 1 then
cadastrar_animal();
if n = 2 then
remover_animal();
if n = 4 then
consultar();
until n = 0;
WriteLN('Obrigado por usar o programa da clinica do JAO - Pressione qualquer tecla para sair');
readkey;
end.