Rotina que verifica se um produto já está cadastrado no Banco de Dados
30/03/2020
0
No projeto estou utilizando:
Delphi 10.3
FireBird 3.0
Banco de dados feito no IBExpert
Utilizando a Palheta InterBase
Dando continuidade no meu projeto me deparei com a seguinte situação. Gostaria de criar uma rotina pra verificar se a informação existe ou não no meu banco de dados em uma determinada coluna (coluna essa chamada CODIGO), então assim que eu digitar no DBEdite e teclar a tecla ENTER ou TAB (creio que deva ter algum evento para isso), e se por ventura tiver o que digitei no banco de dados ele me retorno uma mensagem e que jogue o focus pra o campo novamente, e se não tiver nada ele passe para o próximo DBEdite.
Que Deus abençoe a todos nesse período difícil que estamos passando mundialmente.
Rubens Pena
Posts
30/03/2020
Emerson Nascimento
Para controlar no sistema você deverá criar duas formas de verificação: uma antes de iniciar a gravação (porque foi assim que você solicitou) e uma outra ao tentar gravar o registro.
E porque avaliar ao gravar o registro?
Porque, se o teu sistema puder ser utilizado simultaneamente, você poderá ter mais de uma instância tentando gravar um mesmo código. Assim: eu iniciei a digitação e coloquei o código 001. O sistema consulta e não encontra o registro, logo vai permitir que eu continue com o cadastro. Enquanto estou digitando os dados, outra instância/sessão/estação também inicia a inclusão e informa o código 001. Como eu ainda não efetivei a gravação do registro, o sistema aceitará que essa outra instância inicie a digitação dos dados para o código 001. O problema será na hora da gravação: o último a gravar receberá um aviso de duplicidade.
Isto só ocorrerá se o código for manual. No caso de ser automático (utilizando GENERATOR/SEQUENCE) o problema não ocorre, mas você poderá ter "furos" na sequência se cancelar a inclusão.
Bom, respondendo a tua questão:
Crie uma função genérica que receba a tabela e/ou o campo que deve ser consultado, e também o valor que deve ser pesquisado. Algo assim:
function ExisteReg(Tabela, Campo, Chave: string): boolean; var qryConsulta: TIBQuery; // altere para a classe correta (não tenho os componentes Interbase) strSQL: string; begin strSQL := 'SELECT '+Campo+' FROM '+Tabela+' WHERE '+Campo+' = '+Chave; qryConsulta := TIBQuery.Create(nil); qryConsulta.Connectiom := DM.ConexaoDB; // altere para propriedade e objetos corretos (não tenho os componentes Interbase) qryConsulta.SQL.Text := strSQL; // altere para propriedade correta (não tenho os componentes Interbase) qryConsulta.Open; Result := not qryConsulta.IsEmpty; qryConsulta.Close; FreeAndNil(qryConsulta); end;
Com isto você pode implementar o evento OnExit dos campos de controle:
procedure TForm3.dbEdit1Exit(Sender: TObject); var codigo: string; begin codigo := TDBEdit(Sender).Text; if ExisteReg('CLIENTE', TDBEdit(Sender).Field.Name, codigo) then begin ShowMessage('O cliente '+codigo+' já está cadastrado no sistema. Tente com um conteúdo diferente'); TWinControl(Sender).SetFocus; end; end;
E também pode implementar o evento BeforePost dos datasets:
procedure TForm3.IBQueryCLIENTEBeforePost(DataSet: TDataSet); var codigo: string; begin codigo := Dataset.FieldByName('CODCLI').AsString; if ExisteReg('CLIENTE', 'CODCLI', codigo) then begin ShowMessage('O cliente '+codigo+' já está cadastrado no sistema. Tente com um conteúdo diferente'); Abort; // suspende a gravação do registro end; end; procedure TForm3.IBQueryPRODUTOBeforePost(DataSet: TDataSet); var codigo: string; begin codigo := Dataset.FieldByName('CODPRO').AsString; if ExisteReg('PRODUTO', 'CODPRO', codigo) then begin ShowMessage('O produto '+codigo+' já está cadastrado no sistema. Tente com um conteúdo diferente'); Abort; // suspende a gravação do registro end; end;
01/04/2020
Rubens Pena
Para controlar no sistema você deverá criar duas formas de verificação: uma antes de iniciar a gravação (porque foi assim que você solicitou) e uma outra ao tentar gravar o registro.
E porque avaliar ao gravar o registro?
Porque, se o teu sistema puder ser utilizado simultaneamente, você poderá ter mais de uma instância tentando gravar um mesmo código. Assim: eu iniciei a digitação e coloquei o código 001. O sistema consulta e não encontra o registro, logo vai permitir que eu continue com o cadastro. Enquanto estou digitando os dados, outra instância/sessão/estação também inicia a inclusão e informa o código 001. Como eu ainda não efetivei a gravação do registro, o sistema aceitará que essa outra instância inicie a digitação dos dados para o código 001. O problema será na hora da gravação: o último a gravar receberá um aviso de duplicidade.
Isto só ocorrerá se o código for manual. No caso de ser automático (utilizando GENERATOR/SEQUENCE) o problema não ocorre, mas você poderá ter "furos" na sequência se cancelar a inclusão.
Bom, respondendo a tua questão:
Crie uma função genérica que receba a tabela e/ou o campo que deve ser consultado, e também o valor que deve ser pesquisado. Algo assim:
function ExisteReg(Tabela, Campo, Chave: string): boolean; var qryConsulta: TIBQuery; // altere para a classe correta (não tenho os componentes Interbase) strSQL: string; begin strSQL := 'SELECT '+Campo+' FROM '+Tabela+' WHERE '+Campo+' = '+Chave; qryConsulta := TIBQuery.Create(nil); qryConsulta.Connectiom := DM.ConexaoDB; // altere para propriedade e objetos corretos (não tenho os componentes Interbase) qryConsulta.SQL.Text := strSQL; // altere para propriedade correta (não tenho os componentes Interbase) qryConsulta.Open; Result := not qryConsulta.IsEmpty; qryConsulta.Close; FreeAndNil(qryConsulta); end;
Com isto você pode implementar o evento OnExit dos campos de controle:
procedure TForm3.dbEdit1Exit(Sender: TObject); var codigo: string; begin codigo := TDBEdit(Sender).Text; if ExisteReg('CLIENTE', TDBEdit(Sender).Field.Name, codigo) then begin ShowMessage('O cliente '+codigo+' já está cadastrado no sistema. Tente com um conteúdo diferente'); TWinControl(Sender).SetFocus; end; end;
E também pode implementar o evento BeforePost dos datasets:
procedure TForm3.IBQueryCLIENTEBeforePost(DataSet: TDataSet); var codigo: string; begin codigo := Dataset.FieldByName('CODCLI').AsString; if ExisteReg('CLIENTE', 'CODCLI', codigo) then begin ShowMessage('O cliente '+codigo+' já está cadastrado no sistema. Tente com um conteúdo diferente'); Abort; // suspende a gravação do registro end; end; procedure TForm3.IBQueryPRODUTOBeforePost(DataSet: TDataSet); var codigo: string; begin codigo := Dataset.FieldByName('CODPRO').AsString; if ExisteReg('PRODUTO', 'CODPRO', codigo) then begin ShowMessage('O produto '+codigo+' já está cadastrado no sistema. Tente com um conteúdo diferente'); Abort; // suspende a gravação do registro end; end;
Boa noite. (O que estou fazendo de errado no meu código)?
Li a respeito das uniques e achei interessante, então dei uma mexida no meu banco de dados (deixando PK no automático e deixei o campo que eu queria como unique). Esta rodando perfeitamente. Se na tabela tem uma PK 1 e uma UNIK 2, nao está permitindo eu fazer PK 2 UNIK 2, porque o 2 a esta amarrado na PK 1. (interessante)
Então para que comentar o campo que contem a UNIK segui suas orientações, mais nao rodou.
Na aba dmDados do meu projeto eu utilizo os componentes da aba InterBase do Delphi 10.3 como mencionado antes, abaixo vou citar abaixo os componentes que estou utilizando no meu dmDados:
IBDatabase1: DataBaseName: E:\\Projeto Cadastros Rubens\\Banco de Dados\\DADOS.FDB
IBTransaction1: DefaultDatabase: BaseDadosRubensProduto
IBTable1: DataBase: BaseDadosRubesProduto // TableName: ARTIGOS // Transaction: IBTransaction1
>>>> CAMPOS DO BANCO DE DADOS (NOME DA TABELA: ARTIGOS)
IDARTIGOS INTEGER NOT NULL, --PK--
ARTIGOS_CODIGO INTEGER, --UNIK-- esse é o campo DBEditCOD
ARTIGOS_DESCRICAO VARCHAR(400),
ARTIGOS_VALOR DECIMAL(15,4),
ARTIGOS_RENDIMENTO NUMERIC(4,2),
ARTIGOS_GRAMATURA NUMERIC(4,2),
IDMEDIDAS INTEGER,
IDCOMPOSICAO INTEGER,
IDFORNECEDORES INTEGER,
DataSource1: DataSet: IBTable1
IBQuery1: DataBase: BaseDadosRubesProduto // DataSource: DataSource1 // SQL (TStrings) ... : select * from ARTIGOS
>>>> Crie a Function
function TfrmArtigos.ExisteReg(Tabela, Campo, Chave: string): boolean; var ibConsultaCodigo : TIBQuery; strSQL: string; begin strSQL:= 'select' +artigos_codigo+ 'from' +ARTIGOS+ 'where' +artigos_codigo+ '=' +Chave ibConsultaCodigo := TIBQuery.Create(nil); ibConsultaCodigo.Database := dmDados.BaseDadosRubensProduto; ibConsultaCodigo.SQL.Text := strSQL; ibConsultaCodigo.Open; Result := not ibConsultaCodigo.IsEmpty; ibConsultaCodigo.Close; FreeAndNil(ibConsultaCodigo); end;
>>>> Evento sair do campo DBEditCOD (OnExit)
procedure TfrmArtigos.DBEditCODExit(Sender: TObject); var Codigo: string; begin Codigo := DBEditCOD(Sender).Text; if ('artigos_codigo', DBEditCOD(sender).Field.Name, codigo) then //Field.Name não aparece apos DBEditCOD(sender). begin ShowMessage('O Artigo' +codigo+ 'já esta cadastrado.');; TWinControl(Sender).SetFocus; end; end;
Observação: O ibConsultaCodigo : TIBQuery eu coloquei ele dentro do formulário ARTIGOS, preenchi o mesmo campos do IBQuery1 e mesmo SQL (TStrings) ... .
Ao clicar pra compilar (Shift+F9) da a seguinte mensagem de erro (Link da Imagem Abaixo - Não sei colocar imagem aqui no fórum, por isso o link):
O que estou fazendo de errado?
01/04/2020
Emerson Nascimento
function TfrmArtigos.ExisteReg(Tabela, Campo, Chave: string): boolean; var qryConsulta: TIBQuery; // altere para a classe correta (não tenho os componentes Interbase) strSQL: string; begin strSQL := 'SELECT '+Campo+' FROM '+Tabela+' WHERE '+Campo+' = '+Chave; qryConsulta := TIBQuery.Create(nil); qryConsulta.Connectiom := DM.ConexaoDB; qryConsulta.Database := dmDados.BaseDadosRubensProduto; // propriedade e objetos corretos qryConsulta.SQL.Text := strSQL; // altere para propriedade correta (não tenho os componentes Interbase) qryConsulta.Open; Result := not qryConsulta.IsEmpty; qryConsulta.Close; FreeAndNil(qryConsulta); end;
segundo: o evento não está chamando a função. corrija. e mantenha o uso da classe para o typecast. não troque a classe pelo componente.
procedure TfrmArtigos.DBEditCODExit(Sender: TObject); var Codigo: string; begin Codigo := TDBEdit(Sender).Text; if ExisteReg('artigos_codigo', TDBEdit(Sender).Field.Name, Codigo) then // corrigido begin ShowMessage('O Artigo ' +codigo+ ' já esta cadastrado.'); TWinControl(Sender).SetFocus; end; end;
01/04/2020
Emerson Nascimento
vou criar variáveis para melhor entendimento.
procedure TfrmArtigos.DBEditCODExit(Sender: TObject); var TabelaPesquisada, CampoPesquisado, ConteudoPesquisado: string; begin TabelaPesquisada := 'ARTIGOS'; CampoPesquisado := TDBEdit(Sender).Field.Name; // aqui provavelmente irá retornar 'artigos_codigo', que deve ser o campo ligado ao componente ConteudoPesquisado := TDBEdit(Sender).Text; // conteúdo digitado no componente if ExisteReg(TabelaPesquisada, CampoPesquisado, ConteudoPesquisado) then // corrigido begin ShowMessage('O Artigo ' +ConteudoPesquisado+ ' já esta cadastrado.'); TWinControl(Sender).SetFocus; end; end;
pra reforçar: onde está TDBEdit é pra ficar TDBEdit.
*******************************************************
02/04/2020
Rubens Pena
vou criar variáveis para melhor entendimento.
procedure TfrmArtigos.DBEditCODExit(Sender: TObject); var TabelaPesquisada, CampoPesquisado, ConteudoPesquisado: string; begin TabelaPesquisada := 'ARTIGOS'; CampoPesquisado := TDBEdit(Sender).Field.Name; // aqui provavelmente irá retornar 'artigos_codigo', que deve ser o campo ligado ao componente ConteudoPesquisado := TDBEdit(Sender).Text; // conteúdo digitado no componente if ExisteReg(TabelaPesquisada, CampoPesquisado, ConteudoPesquisado) then // corrigido begin ShowMessage('O Artigo ' +ConteudoPesquisado+ ' já esta cadastrado.'); TWinControl(Sender).SetFocus; end; end;
pra reforçar: onde está TDBEdit é pra ficar TDBEdit.
*******************************************************
Bom dia.
Refiz os códigos exatamente como me orientou (O campos TDBEdit - entendi, ele já puxa as funções do Sender, por isso tem que ser TDBEdit(Sender).
Mas quando vou compilar o código (Shift+F9) continua dando outro erro:
function TfrmArtigos.ExisteReg(Tabela, Campo, Chave: string): boolean; var ibConsultaCodigo : TIBQuery; // altere para a classe correta (não tenho os componentes Interbase) >> Mais lá em acima passei os //componentes que estou utilizando. strSQL: string; begin //strSQL:= 'select' +artigos_codigo+ 'from' +ARTIGOS+ 'where' +artigos_codigo+ '=' +Chave; strSQL:= 'select' ARTIGOS_CODIGO 'from' ARTIGOS 'where' ARTIGOS_CODIGO '=' +Chave; // tirei os sinais de + ibConsultaCodigo := TIBQuery.Create(nil); // ibConsultaCodigo.Connectiom := DM.ConexaoDB; // Não deu certo. Não apareceu nada nesse TIBQuery quando clico (ctrl+barra espaço) ibConsultaCodigo.Database := dmDados.BaseDadosRubensProduto; ibConsultaCodigo.SQL.Text := strSQL; // altere para propriedade correta (não tenho os componentes Interbase) >> Não estou entendendo qual //seria essa propriedade. ibConsultaCodigo.Open; Result := not ibConsultaCodigo.IsEmpty; ibConsultaCodigo.Close; FreeAndNil(ibConsultaCodigo); end;
O erro que esta dando é o seguinte, segue prints:
1ª: http://prntscr.com/rrm5vz
2ª http://prntscr.com/rrm6k2
3ª http://prntscr.com/rrm7cj
Obs.: No IBExpert quando utilizo o mesmo SQL (exemplo: select artigos_codigo from ARTIGOS where artigos_codigo = 6) ele me da o resultado. esperado.
Onde continuo errando?
02/04/2020
Emerson Nascimento
onde você encontrou isso na função que eu te passei????
deixe do jeito que eu te passei. não troque nada.
function TfrmArtigos.ExisteReg(Tabela, Campo, Chave: string): boolean; var qryConsulta: TIBQuery; // classe corrigida strSQL: string; begin strSQL := 'SELECT '+Campo+' FROM '+Tabela+' WHERE '+Campo+' = '+Chave; // é assim mesmo! não altere NADA aqui! qryConsulta := TIBQuery.Create(nil); qryConsulta.Database := dmDados.BaseDadosRubensProduto; // propriedade e objetos corretos qryConsulta.SQL.Text := strSQL; // propriedade corrigida qryConsulta.Open; Result := not qryConsulta.IsEmpty; qryConsulta.Close; FreeAndNil(qryConsulta); end;
02/04/2020
Rubens Pena
onde você encontrou isso na função que eu te passei????
deixe do jeito que eu te passei. não troque nada.
function TfrmArtigos.ExisteReg(Tabela, Campo, Chave: string): boolean; var qryConsulta: TIBQuery; // classe corrigida strSQL: string; begin strSQL := ''SELECT ''+Campo+'' FROM ''+Tabela+'' WHERE ''+Campo+'' = ''+Chave; // é assim mesmo! não altere NADA aqui! qryConsulta := TIBQuery.Create(nil); qryConsulta.Database := dmDados.BaseDadosRubensProduto; // propriedade e objetos corretos qryConsulta.SQL.Text := strSQL; // propriedade corrigida qryConsulta.Open; Result := not qryConsulta.IsEmpty; qryConsulta.Close; FreeAndNil(qryConsulta); end;
Deu certo. Observei que o select esta ligando as informações automaticamente dentro do banco.
Agora aconteceu outra coisa. Dentro do projeto ao clicar em Novo ele esta ogando o curso diretamente pro segundo campo (ate ai tudo bem) ao fazer o teste repetindo o Cod. 5514 (que conta no banco de dados na PK 1) ele me retornou o erro da imagem abaixo:
http://prntscr.com/rrq2jl
O que pode ser agora se o código ficou igual ao que me passou.
02/04/2020
Rubens Pena
onde você encontrou isso na função que eu te passei????
deixe do jeito que eu te passei. não troque nada.
function TfrmArtigos.ExisteReg(Tabela, Campo, Chave: string): boolean; var qryConsulta: TIBQuery; // classe corrigida strSQL: string; begin strSQL := ''SELECT ''+Campo+'' FROM ''+Tabela+'' WHERE ''+Campo+'' = ''+Chave; // é assim mesmo! não altere NADA aqui! qryConsulta := TIBQuery.Create(nil); qryConsulta.Database := dmDados.BaseDadosRubensProduto; // propriedade e objetos corretos qryConsulta.SQL.Text := strSQL; // propriedade corrigida qryConsulta.Open; Result := not qryConsulta.IsEmpty; qryConsulta.Close; FreeAndNil(qryConsulta); end;
Deu certo. Observei que o select esta ligando as informações automaticamente dentro do banco.
Agora aconteceu outra coisa. Dentro do projeto ao clicar em Novo ele esta ogando o curso diretamente pro segundo campo (ate ai tudo bem) ao fazer o teste repetindo o Cod. 5514 (que conta no banco de dados na PK 1) ele me retornou o erro da imagem abaixo:
http://prntscr.com/rrq2jl
O que pode ser agora se o código ficou igual ao que me passou.
fiz uma pequena alteracao no codigo e deu certo
procedure TfrmArtigos.DBEditCODExit(Sender: TObject); var TabelaPesquisada, CampoPesquisado, ConteudoPesquisado: string; begin TabelaPesquisada := 'ARTIGOS'; CampoPesquisado := TDBEdit(Sender).Field.FieldName; // TDBEdit(Sender).Field.Name troquei o Name por FieldName (deu certo) ConteudoPesquisado := TDBEdit(Sender).Text; if ExisteReg(TabelaPesquisada, CampoPesquisado, ConteudoPesquisado) then begin ShowMessage('O Artigo ' +ConteudoPesquisado+ ' já esta cadastrado.'); TWinControl(Sender).SetFocus; end; end;
Obrigado por sua ajuda. Saúde e paz a você, sua família e familiares.