Cadastro de Clientes em Pascal

Um leitor me passou a seguinte dúvida em Pascal:

“Elabore um programa de cadastro de clientes cujos dados devem ser salvos em um arquivo texto.

Exemplo:

assign(arq,’MariaSilva12345.txt’);

ou

assign(arq,’MariaSilva12345_JoaoSouza5…

Deve ser seguida a estrutura de dado conforme ilustra a figura 1:

O programa deve permitir:

1. Incluir novo cliente;

2. Pesquisar por um cliente e mostrar;

3. Alterar dados de determinado cliente;

4. Excluir cliente;

5. Mostrar total de clientes cadastrados.

Para cada opção de operação, faça um subprograma.

As operações definidas nos itens 1, 3 e 4 devem ser gravadas no arquivo.”

Vamos a solução:

 Program Cadastro_de_Clientes;  
 Uses Crt;  
 Var  
  arq : Text;  
  s : String;  
  o : Byte;  
  codigo : String [5];  
  nome : String [50];  
  tname : String [40];  
  logradouro : String [50];  
  numero : String [10];  
  cidade : String [25];  
  email : String [30];  
  telefone : String [15];  
  celular : String [15];  
  quant : Text;  
 Procedure Incluir;  
 var  
  i, j : Integer;  
 Begin  
  WriteLn ('Incluir');  
  WriteLn;  
  WriteLn ('Cliente');  
  WriteLn;  
  Write ('Codigo:'); ReadLn (codigo);  
  Write ('Nome..:'); ReadLn (nome);  
  WriteLn;  
  WriteLn ('Endereco');  
  WriteLn;  
  Write ('Logradouro:'); ReadLn (logradouro);  
  Write ('Numero....:'); ReadLn (numero);  
  Write ('Cidade....:'); ReadLn (cidade);  
  WriteLn;  
  WriteLn ('Contato');  
  WriteLn;  
  Write ('E-mail..............:'); ReadLn (email);  
  Write ('Telefone residencial:'); ReadLn (telefone);  
  Write ('Celular.............:'); ReadLn (celular);  
  // Remove Espacos  
  tname := nome;  
  while pos(' ',tname)<>0 do delete (tname,pos(' ',tname),1);  
  // Grava os dados  
  Assign (arq,tname+codigo);  
  ReWrite (arq);  
  WriteLn (arq,codigo);  
  WriteLn (arq,nome);  
  WriteLn (arq,logradouro);  
  WriteLn (arq,numero);  
  WriteLn (arq,cidade);  
  WriteLn (arq,email);  
  WriteLn (arq,telefone);  
  WriteLn (arq,celular);  
  Close (arq);  
  // Le a quantidade de registros  
  Assign (quant,'quantidade.txt');  
  Reset (quant);  
  ReadLn (quant,s);  
  val (s,i,j);  
  Close (quant);  
  // Soma 1 e grava  
  i := i + 1;  
  Assign (quant,'quantidade.txt');  
  ReWrite(quant);  
  Str(i,s);  
  WriteLn (quant,s);  
  Close (quant);  
 End;  
 Procedure Pesquisar;  
 Begin  
  WriteLn ('Pesquisar');  
  WriteLn;  
  Write ('Codigo:'); ReadLn (codigo);  
  Write ('Nome..:'); ReadLn (nome);  
  // Remove Espacos  
  tname := nome;  
  while pos(' ',tname)<>0 do delete (tname,pos(' ',tname),1);  
  Assign (arq,tname+codigo);  
  {$I-}  
  Reset (arq);  
  if IORESULT()<>0 then  
  Begin  
   WriteLn ('Cliente nao encontrado!');  
   ReadLn;  
  End  
  Else  
  Begin  
   WriteLn ('Cliente');  
   WriteLn;  
   ReadLn (arq,codigo);  
   WriteLn ('Codigo:',codigo);  
   ReadLn (arq,nome);  
   WriteLn ('Nome..:',nome);  
   WriteLn;  
   WriteLn ('Endereco');  
   WriteLn;  
   ReadLn (arq,logradouro);  
   WriteLn ('Logradouro:',logradouro);  
   ReadLn (arq,numero);  
   WriteLn ('Numero....:',numero);  
   ReadLn (arq,cidade);  
   WriteLn ('Cidade....:',cidade);  
   WriteLn;  
   WriteLn ('Contato');  
   WriteLn;  
   ReadLn (arq,email);  
   WriteLn ('E-mail..............:',email);  
   ReadLn (arq,telefone);  
   WriteLn ('Telefone residencial:',telefone);  
   ReadLn (arq,celular);  
   WriteLn ('Celular.............:',celular);  
   Close (arq);  
   ReadLn;  
  End;  
  {$I+}  
 End;  
 Procedure Alterar;  
 Begin  
  WriteLn ('Alterar');  
  WriteLn;  
  Write ('Codigo:'); ReadLn (codigo);  
  Write ('Nome..:'); ReadLn (nome);  
  // Remove Espacos  
  tname := nome;  
  while pos(' ',tname)<>0 do delete (tname,pos(' ',tname),1);  
  Assign (arq,tname+codigo);  
  {$I-}  
  Reset (arq);  
  if IORESULT()<>0 then  
  Begin  
   WriteLn ('Cliente nao encontrado!');  
   ReadLn;  
  End  
  Else  
  Begin  
   WriteLn ('Cliente');  
   WriteLn;  
   ReadLn (arq,codigo);  
   WriteLn ('Codigo:',codigo);  
   ReadLn (arq,nome);  
   WriteLn ('Nome..:',nome);  
   WriteLn;  
   WriteLn ('Endereco');  
   WriteLn;  
   ReadLn (arq,logradouro);  
   WriteLn ('Logradouro:',logradouro);  
   ReadLn (arq,numero);  
   WriteLn ('Numero....:',numero);  
   ReadLn (arq,cidade);  
   WriteLn ('Cidade....:',cidade);  
   WriteLn;  
   WriteLn ('Contato');  
   WriteLn;  
   ReadLn (arq,email);  
   WriteLn ('E-mail..............:',email);  
   ReadLn (arq,telefone);  
   WriteLn ('Telefone residencial:',telefone);  
   ReadLn (arq,celular);  
   WriteLn ('Celular.............:',celular);  
   Close (arq);  
   WriteLn;  
   WriteLn ('Cliente');  
    WriteLn;  
    Write ('Codigo:'); ReadLn (codigo);  
    Write ('Nome..:'); ReadLn (nome);  
    WriteLn;  
    WriteLn ('Endereco');  
    WriteLn;  
    Write ('Logradouro:'); ReadLn (logradouro);  
    Write ('Numero....:'); ReadLn (numero);  
    Write ('Cidade....:'); ReadLn (cidade);  
    WriteLn;  
    WriteLn ('Contato');  
    WriteLn;  
    Write ('E-mail..............:'); ReadLn (email);  
    Write ('Telefone residencial:'); ReadLn (telefone);  
    Write ('Celular.............:'); ReadLn (celular);  
    // Remove Espacos  
    tname := nome;  
    while pos(' ',tname)<>0 do delete (tname,pos(' ',tname),1);  
    // Grava os dados  
    Assign (arq,tname+codigo);  
    ReWrite (arq);  
    WriteLn (arq,codigo);  
    WriteLn (arq,nome);  
    WriteLn (arq,logradouro);  
    WriteLn (arq,numero);  
    WriteLn (arq,cidade);  
    WriteLn (arq,email);  
    WriteLn (arq,telefone);  
    WriteLn (arq,celular);  
    Close (arq);  
  End;  
  {$I+}  
 End;  
 Procedure Excluir;  
 var  
  confirma : String[1];  
  i,j : Integer;  
 Begin  
  WriteLn ('Excluir');  
  WriteLn;  
  Write ('Codigo:'); ReadLn (codigo);  
  Write ('Nome..:'); ReadLn (nome);  
  // Remove Espacos  
  tname := nome;  
  while pos(' ',tname)<>0 do delete (tname,pos(' ',tname),1);  
  Assign (arq,tname+codigo);  
  {$I-}  
  Reset (arq);  
  if IORESULT()<>0 then  
  Begin  
   WriteLn ('Cliente nao encontrado!');  
   ReadLn;  
  End  
  Else  
  Begin  
   WriteLn ('Cliente');  
   WriteLn;  
   ReadLn (arq,codigo);  
   WriteLn ('Codigo:',codigo);  
   ReadLn (arq,nome);  
   WriteLn ('Nome..:',nome);  
   WriteLn;  
   WriteLn ('Endereco');  
   WriteLn;  
   ReadLn (arq,logradouro);  
   WriteLn ('Logradouro:',logradouro);  
   ReadLn (arq,numero);  
   WriteLn ('Numero....:',numero);  
   ReadLn (arq,cidade);  
   WriteLn ('Cidade....:',cidade);  
   WriteLn;  
   WriteLn ('Contato');  
   WriteLn;  
   ReadLn (arq,email);  
   WriteLn ('E-mail..............:',email);  
   ReadLn (arq,telefone);  
   WriteLn ('Telefone residencial:',telefone);  
   ReadLn (arq,celular);  
   WriteLn ('Celular.............:',celular);  
   Close (arq);  
   Repeat  
    Write ('Confirma apagar (S/N)?');  
    ReadLn (confirma);  
   Until (confirma='S') or (confirma='N');  
   if confirma='S' then  
   begin  
    Assign (arq, tname+codigo);  
    Erase (arq);  
    // Le a quantidade de registros  
    Assign (quant,'quantidade.txt');  
    Reset (quant);  
    ReadLn (quant,s);  
    val (s,i,j);  
    Close (quant);  
    // diminui 1 e grava  
    i := i - 1;  
    Assign (quant,'quantidade.txt');  
    ReWrite(quant);  
    Str(i,s);  
    WriteLn (quant,s);  
    Close (quant);  
   end;  
   ReadLn;  
  End;  
  {$I+}  
 End;  
 Procedure Quantidade;  
 Var  
  s : String;  
 Begin  
  Assign (quant,'quantidade.txt');  
  Reset (quant);  
  ReadLn (quant,s);  
  Close (quant);  
  WriteLn ('Ha ',s,' registro(s)!');  
  ReadLn;  
 End;  
 Begin  
  Assign (quant,'quantidade.txt');  
  {$I-}  
  Reset (quant);  
  if IORESULT()<>0 then  
  Begin  
  {$I+}  
   ReWrite (quant);  
   WriteLn (quant,'0');  
  End;  
  Close (quant);  
  o := 0;  
  Repeat  
   ClrScr;  
   WriteLn ('Cadastro de Clientes');  
   WriteLn;  
   WriteLn ('1. Incluir');  
   WriteLn ('2. Pesquisar');  
   WriteLn ('3. Alterar');  
   WriteLn ('4. Excluir');  
   WriteLn ('5. Quantidade de Clientes');  
   WriteLn ('0. Sair');  
   WriteLn;  
   ReadLn (o);  
   Case o of  
    1 : Incluir;  
    2 : Pesquisar;  
    3 : Alterar;  
    4 : Excluir;  
    5 : Quantidade;  
   End;  
  Until o =0;  
 End.  

3 comentários:

  1. http://www.techpsd.com.br

    Aceita Parceria ?

    ResponderExcluir
  2. ERRO SINTATICO NA LINHA 80..

    if IORESULT()<>0 then

    ')' NÃO ESPERADO!

    ResponderExcluir
  3. Apaga o () deve resolver.

    ResponderExcluir