All pastes #183659 Raw Edit

Untitled

public text v1 · immutable
#183659 ·published 2006-09-27 02:49 UTC
rendered paste body
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 remover_animal();
    var
        arq_out, auxiliar : arqcad;
        animal : ficha;
        dono, remover : 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
        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);
                end;
            end;
					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,'clinica_aux.dat');
                        reset(auxiliar);
                        while not eof(arq_out) do
                        Begin
                            read(arq_out,animal);
                            if (animal.ident_dono.nome <> dono) then
                            write(auxiliar,animal);
                        end;
                        rewrite(arq_out);
                        while not eof(auxiliar) do
                        Begin
                            read(auxiliar,animal);
                            write(arq_out,animal);
                        end;
                        erase(auxiliar);
                        clrscr;
                        WriteLN('Animal removido com sucesso.');
                        WriteLN('Pressione qualquer tecla...');
                        readkey;
                    end;
                    If not (achou) then
                    Begin
				        WriteLn ('Animal não encontrado!');
				        WriteLN('Pressione qualquer tecla...');
				        readkey
                    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();
    until n = 0;
    WriteLN('Obrigado por usar o programa da clinica do JAO - Pressione qualquer tecla para sair');
    readkey;
end.