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 alterar; {alteração do arquivo}
var
dono: string;
arq_in, arq_out : arqcad;
animal : ficha;
Begin
clrscr;
assign (arq_out,'clinica.dat');
reset (arq_out); {abre para leitura}
writeln (' Informe o nome do dono: ');
readln (dono);
while (animal.ident_dono.nome <> dono) and (not(eof(arq_out))) do {loop de checagem de cadastro válido}
begin
read (arq_out,animal);
if (animal.ident_dono.nome = dono) then
begin
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('+-----------------------------------+');
writeln (' Informe o novo tipo do animal: ');
readln (animal.tipo_animal);
writeln('+-----------------------------------+');
writeln (' Informe a nova raca: ');
readln (animal.raca);
writeln('+-----------------------------------+');
writeln (' Informe a nova cor: ');
readln (animal.cor);
writeln('+-----------------------------------+');
writeln (' Informe a nova idade: ');
readln (animal.idade);
writeln (' Informe o novo nome do dono: ');
readln (animal.ident_dono.nome);
seek(arq_out,(filepos(arq_out)-1)); end;
write(arq_out,animal);
end;
close (arq_out); {fecha o arquivo após alterar registro}
clrscr;
end;
procedure remover_animal();
var
arq_out, auxiliar : arqcad;
animal : ficha;
dono, remover : string;
i,j : 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 i = 0 then
Begin
For j := 1 to filesize(arq_out) -1 do
Begin
Seek(arq_out,j);
Read(arq_out,animal);
Seek(auxiliar,j-1);
Write(auxiliar,animal);
end;
end
else
If i = filesize(arq_out)-1 then
Begin
for j := 0 to filesize(arq_out) -2 do
Begin
Seek(arq_out,j);
Read(arq_out,animal);
Seek(auxiliar,j);
write(auxiliar,animal);
end;
//fim do for
end
else
Begin
for j := 0 to i - 1 do
Begin
seek(arq_out,j);
read(arq_out,animal);
seek(auxiliar,j);
write(auxiliar,animal);
end;
For j := i + 1 to filesize(arq_out)-1 do
Begin
seek(arq_out,j);
read(arq_out,animal);
seek(auxiliar,j-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
textcolor(14);
Repeat
clrscr;
window(2,2,80,80);
writeln('+-------------------------+');
WriteLN('----- CLINICA DO JAO ------');
writeln('+-------------------------+');
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('(0) Sair');
ReadLN(n);
if n = 1 then
cadastrar_animal();
if n = 2 then
remover_animal();
if n = 3 then
alterar();
if n = 4 then
consultar();
until n = 0;
textcolor(10);
WriteLN('Obrigado por usar o programa da clinica do JAO - Pressione enter...');
readkey;
end.