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
auxiliar, arq_out : arqcad;
animal : ficha;
dono : string;
cod,i,posicao:integer;
achou:boolean;
begin
clrscr;
writeln;
WriteLN('----- REMOVENDO ANIMAL -----');
reset(arq_out);
rewrite(auxiliar);
if filesize(arq_out) <> 0 then
begin
write('Digite o nome do dono do animal a ser removido : ');
ReadLN(dono);
achou:=false;
i := 1;
posicao := 0;
repeat
read(arq_out,animal);
if dono = animal.ident_dono.nome then
begin
achou := true;
posicao := i;
end;
i := i+1;
until (eof(arq_out)) or (achou);
close(arq_out);
reset(arq_out);
if (achou) and (posicao<>0) then
begin
i:=1;
repeat
if i <> posicao then
begin
read(arq_out,animal);
write(auxiliar,animal);
end
else
read(arq_out,animal);
i := i + 1;
until i > filesize(arq_out);
close(arq_out);
close(auxiliar);
rewrite(arq_out);
reset(auxiliar);
for i := 1 to filesize(auxiliar) do
begin
read(auxiliar,animal);
write(arq_out,animal);
end;
end
end
else
writeln(' Arquivo nao contem dados ');
close(arq_out);
close(auxiliar);
writeln;
writeln(' Pressione qualquer tecla ');
readkey;
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.