verificar registros iguais no arquivo

Arthur2010 · 19 de junho de 2010

Boa tarde galera, quero fazer uma procedure que quando o usuário digite o código do produto(string) ela(procedure) verifique se ele ja exista no arquivo binário, mas estou na dúvida se minha lógica está correta:

PROCEDURE verifica_codigo;
 var codPesq :string
  BEGIN
  clrscr;
       REPEAT
          writeln('codigo: ' ) ;
          readln(codPesq);
            if codPesq = ficha.rescod then
                   writeln ('codigo existente');
                   readkey;
       UNTIL (codPesq <> ficha.rescod);
END;

Grato!

Wilson Neto · 19 de junho de 2010

E aê Arthur? Brow, na minha opinião sua lógica está errada (a cada iteração do loop ela vai pedir o código ao usuário, e o loop vai terminar quando o código do registro lido do arquivo for diferente do código digitado, na verdade seu código nem está lendo os registros do arquivo...).

Uma lógica que faria isto seria:


algoritmo verifica;
variaveis
	strCod  : String;
	ficha	: "?registro igual aos do arquivo?";
	encontrado:booleano;
começo
	limpa_tela;
	Le(strCod);
	reseta("Arquivo");
	booleano <- FALSE;
	enquanto ((não estiver no fim do "Arquivo") E ("encontrado" <> TRUE)) faça
		leia o próximo registro do "Arquivo" em "ficha";
		se ("ficha.codigo" = "strCod") faça
			"encontrado" <- TRUE;  
	fim do enquanto	 
	se ("encontrado" = TRUE) faça Escreva("Ja existe este código!!!");
fim.

Em pascal ficaria assim:


procedure verifica_cod;
var
	strCodigo	: String;
	blEncontrado	: Boolean;
	regFicha	: "Registro";
begin
	clrscr;
	blEncontrado := FALSE;
	writeln("Entre com o codigo a ser verificado:");
	readln(strCodigo);
	reset(ARQUIVO);
	while((not EoF(ARQUIVO))AND(blEncontrado = FALSE))
	begin
		read("ARQUIVO",regFicha);
		if(regFicha.codigo = strCodigo) then blEncontrado := TRUE;
	end;
	if(blEncontrado = TRUE) writeln("o registro já existe!!!");
end;

descupe aê os erro de sintax, é que faz um tempo que não programo em pascal (e no momento estou sem um compilador para testar...).

Espero que ajude....

Falou.

Arthur2010 · 20 de junho de 2010

W_Neto, muito obrigado pela ajuda cara! na sintax só faltam um do e um then, mas nem esquenta! você resolveu meu problema mas agora apareceu outro.. hehe ..ficou assim a procedure

procedure verifica_cod;
var
	strCodigo	 : String;
	blEncontrado : Boolean;
	ficha	 :cadastro;

BEGIN
	clrscr;
	blEncontrado := FALSE;
	writeln("Entre com o codigo a ser verificado:");
	readln(strCodigo);
	reset(arquivo);
	while((not EoF(arquivo))AND(blEncontrado = FALSE))
	begin
		read(arquivo,ficha);
		if(ficha.rescod = strCodigo) then blEncontrado := TRUE;
	end;
	if(blEncontrado = TRUE) writeln("o registro já existe!!!");
END;

Bom, o programa em si é para cadastrar produtos, os atributos são: código,descrição,quantidade e data de entrada, e todos estes dados são inseridos na procedure de "inserir dados", com esta procedure que tu me ajudou eu queria que quando o usuário fosse digitar o código para inserir no arquivo ele verificasse se existe no mesmo, se existe ele acusa e fica

até o usuário digitar um código diferente, porém agora quando ele acusa que o código ja existe ele vai vai para o próximo dado, "descrição".

TYPE
               cadastro=record
                rescod  :string[3];  {codigo com 3 digitos}
                desc    :string[20]; {descricao com ate 20 letras}
                qtd     :integer;    {quantidade de -32.768 até 32.767 }
                dat_ent :string[10]; {data de entrada dd/mm/aaaa}
               end;

VAR
  arquivo,temp  :File of cadastro;
  arquivo_texto :text;
  ficha         :cadastro; {ficha tem os campos de cadastro, é uma referencia para acessar o cadastro}
  opcao         :char;

procedure inserir

PROCEDURE inserir_dados;
{procedimento para inserir dados}
VAR i  :integer;
    op :char;

BEGIN
clrscr; 

i:= 0;
IF not existe('G:\Arquivo.dat') then
  BEGIN
  writeln('Arquivo nao existente. Deseja criar o Arquivo agora? (s/n) ?');
  op:= readkey;
  if upcase(op) = 'S' then
    BEGIN
    ASSIGN(arquivo,'G:\Arquivo.dat'); {abre o arquivo}
    REWRITE(arquivo); {cria um novo arquivo e substitui o original}
    CLOSE(arquivo); {fecha o arquivo}
    END;
  END;
  ASSIGN(arquivo,'G:\Arquivo.dat'); {abre o arquivo}
  reset(arquivo);  {abre o arquivo e fica no primeiro registo}
  i:= filesize(arquivo);  {determina o tamanho do arquivo}
  repeat
      write('Codigo:          '); verifica_cod; //readln(ficha.rescod);
      write('Descricao:       ');  readln(ficha.desc);
      verifica_quantidade;
      write('Data de Entrada: ');  readln(ficha.dat_ent);
      writeln('Confirmar dados? s/n '); op:= readkey;
      if upcase(op)='S' then
      BEGIN
        seek(arquivo, i);
        write(arquivo, ficha);  {escreve no arquivo}
        i:= i+1;
      END;
      writeln('Voltar ao menu de opções? s/n ');
      op:= readkey;
  until upcase(op)='S';
  CLOSE(arquivo); {fecha o arquivo}
end;

Grato!

Wilson Neto · 20 de junho de 2010

Brow , na minha opinião uma boa ideia seria você criar uma função que analizasse se o código é valido (se não existe no arquivo ainda...), retornasse TRUE se o código fosse valido e FALSE caso contrario (se ele já existir no arquivo...). Depois é só criar um loop que repete o pedido do código até que que seja inserido um código valido...

Exemplo:


program exemplo;
uses crt;
type
	cadastro = record
		rescod	: String[3];
		desc	: String[20];
	end;
var
	arquivo	: File of cadastro;
	opcao	: integer;
[b]function verifica(strCod	: String):Boolean;
var 
	FichaLida	: Cadastro;
begin
	verifica := TRUE;
	assign(arquivo,'Arquivo.dat');
	reset(Arquivo);
	while((not EoF(Arquivo)) AND (verifica = TRUE)) do begin
		read(Arquivo,FichaLida);
		if(strCod = FichaLida.rescod) then verifica := FALSE;
	end;
	close(Arquivo);
end;[/b]
function menu()	: integer;
var 
	OpcaoValida	: Boolean;
   	Opcao		: char;
begin
	OpcaoValida := FALSE;
	clrscr();
	while(OpcaoValida = FALSE) do begin
		writeln('#-Menu-#',#13,#10,' 1.Inserir',#13,#10,' 2.Registros',#13,#10,' 3.Sair');
		Opcao := readKey();
		if(Opcao = '1') then menu := 1
		else if (Opcao = '2') then menu := 2
		else if (Opcao = '3') then menu := 3;
		if((menu <= 3)AND(menu >=1)) then OpcaoValida := TRUE;
	end;
end;
procedure InserirDados;
var 
	Fichasalvar	: Cadastro;
	blOk		:Boolean;
begin
	blOk := FALSE;
	clrscr();
	Write('#-Inserir Dados-#',#13,#10,' *Insira a descricao do produto:',#13,#10,'   >>');
	readln(FichaSalvar.desc);
	[b]while(blOk = FALSE) do begin
		write(' *Insira codigo:',#13,#10,'   >>');
		readln(FichaSalvar.resCod);
		blOk := verifica(FichaSalvar.rescod);
		if(blOk = FALSE) then writeln('#codigo ja existe...'); 
	end;[/b]
	assign(Arquivo,'Arquivo.dat');
	reset(Arquivo);
	seek(Arquivo,FileSize(Arquivo));
	write(Arquivo,FichaSalvar);
	close(Arquivo);
	writeln(#13,#10'Registro Salvo...');
	readkey();
end;
procedure Registros;
var 
	FichaLida	: Cadastro;
	iCont		: Integer;
begin
	iCont := 0;
	ClrScr();
	WriteLn('#-Registros Salvos no Arquivo-#');
	assign(Arquivo,'Arquivo.dat');
	reset(Arquivo);
	while(Not EoF(Arquivo)) do begin
		iCont := iCont + 1;
		read(Arquivo,FichaLida);
		writeln('-->Registro ',iCont,#13,#10,'   .Descricao:  ',FichaLida.Desc,#13,#10,'   .Codigo:     ',FichaLida.rescod,#13,#10);
	end;
	close(Arquivo);
	Writeln('#Existem ',iCont,' registros no arquivo...');
	readKey();
end;
begin
	assign(arquivo,'Arquivo.dat');
	{$i-}
        	reset (Arquivo);
        {$i+}
	opcao := 1;
        if (IOResult <> 0) then rewrite (Arquivo);
	close(Arquivo);
	while(Opcao <> 3) do begin
		opcao := menu();
		if (Opcao = 1) then InserirDados
		else if(Opcao = 2) then Registros;
	end;
end.

Da uma olhada aê , acredito que irá te ajudar...

Falou.

Arthur2010 · 20 de junho de 2010

aee de novo! Obrigado fiz seguindo o exemplo, ele acha o codigo igual e o acusa, não deixando o usuário prosseguir com o cadastro e se não tem o código ele faz o cadastro, mas agora depois que o usuário digita a data o programa aborta(fecha sozinho) ..

function verifica(strCod	: String):Boolean;
var 
	ficha	: Cadastro;
begin
	verifica := TRUE;
	assign(arquivo,'G:\Arquivo.dat');
	reset(arquivo);
	while((not EoF(Arquivo)) AND (verifica = TRUE)) do begin
		read(arquivo,ficha);
		if(strCod = ficha.rescod) then verifica := FALSE;
	end;
	close(Arquivo);
end;

VAR i  :integer;
    op :char;
    ficha :cadastro;
    blOk:Boolean;


BEGIN

blOk := FALSE;
i:= 0;
IF not existe('G:\Arquivo.dat') then
  BEGIN
  writeln('Arquivo nao existente. Deseja criar o Arquivo agora? (s/n) ?');
  op:= readkey;
  if upcase(op) = 'S' then
    BEGIN
    ASSIGN(arquivo,'G:\Arquivo.dat'); {abre o arquivo}
    REWRITE(arquivo); {cria um novo arquivo e substitui o original}
    CLOSE(arquivo); {fecha o arquivo}
    END;
  END;
  ASSIGN(arquivo,'G:\Arquivo.dat'); {abre o arquivo}
  reset(arquivo);  {abre o arquivo e fica no primeiro registo}
  i:= filesize(arquivo);  {determina o tamanho do arquivo}
  //repeat
        while(blOk = FALSE) do begin
		write(' *Insira codigo:',#13,#10,'   >>');
		readln(ficha.rescod);
		blOk := verifica(ficha.rescod);
		if(blOk = FALSE) then writeln('#codigo ja existe...'); 
	end;

      //('Codigo:          '); verifica_cod;
      //readln(ficha.rescod);
      write('Descricao:       ');  readln(ficha.desc);
      verifica_quantidade;
      write('Data de Entrada: ');  readln(ficha.dat_ent);
      writeln('Confirmar dados? s/n '); op:= readkey;
      if upcase(op)='S' then
      BEGIN
        seek(arquivo, i);
        write(arquivo, ficha);  {escreve no arquivo}
        i:= i+1;
      END;
      writeln('Voltar ao menu de opções? s/n ');
      op:= readkey;
  //until upcase(op)='S';
  CLOSE(arquivo); {fecha o arquivo}
end;

Obrigado de novo!

Wilson Neto · 20 de junho de 2010

Aê brow,acredito que o erro foi causado por você não estar tomando o devido cuidado com o acesso ao arquivo, teste assim:


...
  if upcase(op) = 'S' then
    BEGIN
    ASSIGN(arquivo,'G:\Arquivo.dat'); {abre o arquivo}
    REWRITE(arquivo); {cria um novo arquivo e substitui o original}
    CLOSE(arquivo); {fecha o arquivo}
    END;
  END;
  //repeat
        while(blOk = FALSE) do begin
...		if(blOk = FALSE) then writeln('#codigo ja existe...'); 
	end;
...
      if upcase(op)='S' then
      BEGIN
	[b]ASSIGN(arquivo,'G:\Arquivo.dat'); {abre o arquivo}
  	reset(arquivo);  {abre o arquivo e fica no primeiro registo}
  	i:= filesize(arquivo);  {determina o tamanho do arquivo}[/b]
        seek(arquivo, i);
        write(arquivo, ficha);  {escreve no arquivo}
	[b]CLOSE(arquivo)[/b]; {fecha o arquivo}
        i:= i+1;
      END;
...

Acredito que o erro ocorra porque logo após você verificar se o arquivo existe, você usa o comando assign(), porém dentro da função verifica() esta função é chamada novamente, porém por se tratar da mesma variavel (já que é variavel global), não há problemas (ainda...), mas dentro da função há a chamda da função close() (close(Arquivo)), o que encerra a conexão da variavel 'Arquivo' com o arquivo "real", este é o erro, mas ele só aparece quando você tenta salvar algo no Arquivo...

Bom, acredito que é só isto, mas se surgirem novas dúvidas...

Cara é só uma dica, apesar de eu gostar muito de programas em modo texto, uma boa para este tipo de programa é o Delphi, já que você já está familiarizado com pascal, a trasição é muito fácil...

Espero que ajude...

Fallou.

Arthur2010 · 21 de junho de 2010

Obrigado! funcionou W_Neto

obs: ja comecei a fuçar no delphi

Simon Viegas · 21 de junho de 2010

Obrigado! funcionou W_Neto
obs: ja comecei a fuçar no delphi

Olá,

Arthur2010, só dois comentários:

1) Comando ASSIGN()

O comando ASSING() não abre o arquivo...

ASSIGN(arquivo,'G:\Arquivo.dat'); {abre o arquivo}

na verdade ele "associa o caminho externo do arquivo variável no pascal". Nada mais que isso... Ou seja quando a variável "arquivo" é chamada, o Pascal saberá que está se referindo ao caminho "G:\Arquivo.dat".

2) Abertura e fechamento do arquivo

Arthur2010, eu sugiro que você abra e feche o arquivo somente uma vez...

É bem simples, abre quando o programa inicia e fecha quando o programa termina.

OBS.: Só como curiosidade... Isso é meio que usar um conceito de ARD (Armazenamento e Recuperação de Dados), que fala sobre "prioridade" e "direito de acesso", ou seja, ao abrir o arquivo você passará a "ter direitos" sobre ele e impedindo que outros programas tentem acessá-los ao mesmo tempo que você (integridade de dados). E no caso, ao fechá-lo, você estaria "entregando" novamente o arquivo ao Windows...

PS: Eu tinha feito uns código ontem, mas não deu tempo para terminar (me chamaram pra comer água, ai já viu, rs)

Eu não testei, mas de qualquer forma já serve como uma ideia..

(são autoexplicativos, então não vou entra em detalhes)



TYPE
  cadastro = record
               rescod  :string[3];  {codigo com 3 digitos}
               desc    :string[20]; {descricao com ate 20 letras}
               qtd     :word;       {quantidade de 0 até 65535}
               dat_ent :string[10]; {data de entrada dd/mm/aaaa}
             end;

[COLOR="Red"]  tipoArquivo = File of cadastro;[/COLOR]

PROCEDURE AbrirArquivo(arq:tipoArquivo);
  begin
  ASSIGN(arquivo,'G:\Arquivo.dat'); {Associa o caminho externo do arquivo a 
                                                           variável "arquivo"}
  {$I-}        {desativa o fechamento caso o comando abaixo der erro}
  Reset(Arq);  {caso o arquivo não exista, o SO enviar* uma mensagem de erro
que pose ser obtida atraves do "IOresult}
  {$I+}        {reativa o fechamento caso der erro}
  if IOResult <> 0 then  {se o "IOresult for "0" o arquivo existe (logo Reset
abriu o arquivo normalmente, não precisando o "rewrite"). Caso não, (O "$I-"
evita que o SO encerre o programa) vai* usado o "ReWrite"}
    begin
    writeln('Arquivo não existente. Um novo arquivo será criado!');
    REWRITE(arquivo); {cria e abre um novo arquivo que substitui o original}
    {OBS.: Aqui também é possível que ocorra algum erro, por exemplo se o
    arquivo estiver como somente leitura, ou o disco estiver protegido
    contra gravação, etc, mas no caso não serão tratados (se der erro o
    programa fechará)}
    end;
  end;

FUNCTION verifica_cod (codigo:string[3]):boolean;
  var
    blEncontrado :boolean;
    ficha	       :cadastro;
  begin
  AbrirArquivo(arquivo); {abri o arquivo no início (ou recria)}
	blEncontrado := FALSE; {inicializa a variável}
  while ((not EoF(arquivo)) AND (not blEncontrado)) do
       {não fim do arquivo}        {não encontrado}
    begin
    read(arquivo,ficha); {ler a próxima linha no arquivo}
    if (ficha.rescod = codigo) then {se igual}
      blEncontrado := TRUE; {marca como já existente}
    end;
  verifica_cod := blEncontrado; {retorna através do function}
END;

PROCEDURE lerCodigo (var codigo:string[3]);
  var
    COL :byte; {coordenada da coluna (para releitura do dado)}
  begin
  {LEITURA E VALIDAÇÃO DO CÓDIGO}
  repeat {repetir até que código esteja OK}
    COL:=WhereX; {copia a posição da coluna atual}
    readln(codigo); {ler o código do novo produto}
    COD_OK := verifica_cod(codigo); {retorna se o código é válido (não repetido)}
    if NOT COD_OK then {se código inválido}
      begin
      writeln('Código já cadastrado');
      ReadKey; {pause}
      GotoXY(1,WhereY-1); {linha anterior (a da mensagem)}
      ClrEol; {apaga a linha da mensagem}
      GotoXY(COL,WhereY-1); {posiciona para reler o código no lugar certo}
      end;
  until COK_OK;
  end;

Talvez precisem de algum ajuste... mas qualquer coisa é só postar!

Abraços

Arthur2010 · 22 de junho de 2010

Obrigado EstilingueAtomico, eu realmente estava na dúvida quanto ao uso do assign, agora apareceu outro probleminha () fiz uma procedure que verificava a quantidade digitada(ver se era numero mesmo) mas não funciona mais, ela

ta copiando um numero com bem mais digitos que eu coloco e sempre mostra o mesmo

PROCEDURE verifica_quantidade;
  var erro :integer;
      x      :string;
BEGIN
 erro:= -1; ficha.qtd := 0;
     BEGIN
         while (erro <> 0) or (ficha.qtd = 0) do
           BEGIN
            gotoxy(1,6);  writeln('Quantidade:  ') ; {coluna linha}
            gotoxy(18,6); clreol; readln(x); {apaga a qtd errada e deixa vazio o local}
            val(x, ficha.qtd, erro); {faz a conversão de string para integer}
             if (erro > 0) or (ficha.qtd = 0) then
                   BEGIN
                    gotoxy(8,8); writeln('somente numeros sao aceitos');
                   END;
           END;
     END;
END;

Grato!

EDITADO: eu conseguir arrumar de outro jeito, eu tirei a procedure e mudei a lógica do código e coloquei na propria leitura e funcionou.. mas não endendo o porque, vou ter que acabar fazendo isso na procedure de "alterar dados"

repeat
      write('quantidade');
    readln(p);
        val(p,ficha.qtd,erro); {converte em integer}
        if (erro <> 0) then
          mensagem_erro('Somente é aceito numeros inteiros')
        else
          if (p<'0') or (p >'32767') then
            mensagem_erro('O numero deve esta na faixa de 0 a 65535');
      until (erro=0) and (p >'0') and (p <'32767');