Ir para conteúdo
Fórum Script Brasil
  • 0

(Resolvido) Conexão do VB6 com o Firebird


Marcelo Cavalcanti

Pergunta

11 respostass a esta questão

Posts Recomendados

  • 0

Olá Gabriel.

Gabriel, Eu 1º queria fazer uma conexão bem simples do VB6 com o ACCESS. E depois com o FireBird.

Bem com o ACCESS eu fiz assim:

Uma tela simples com 2 cx de text (codi e nome) e 2s butons NOVO e SAIR

O código assim:

Private Sub CmdNovo_Click()
    TxtCodi = ""
    TxtNome = ""

 'Vai Buscar o Próximo Número para o Codigo Número de Ordens de Entrega
 'If Len(Trim(FrmPrincipal.Tag)) = 0 Then
       
       Set DB = OpenDatabase(App.Path & "\teste.mdb", False, False)
       Set Dst = DB.OpenRecordset("select CODI from CLIENTES order by CODI")
       If Dst.RecordCount <> 0 Then
          Dst.MoveLast
          TxtCodi = Dst("CODI") + 1
      ' End If
          Dst.Close
          TxtCodi.SetFocus
      ' Else
          Cmd_Sair.SetFocus
    End If
End Sub

Private Sub CmdSair_Click()
 Unload Me
End Sub
Fiz um módulo com a conexão para o access:
Public DB As Database

Sub conexao()
  On Error GoTo Main_Error
  'abre o BD de informação de caminho final do BD
  ' O BD onde infrmamos o caminho do DB tem que ficar na pasta sistema do micro local
  Set DB = OpenDatabase("C:\Documents and Settings\user\Desktop\TesteConVB6FB\teste.mdb", False, False)
  Dst.Close
End Sub

E dá esse erro:

Run-Time Error '3343'

Unrecognized DataBase format 'Caminho do banco\teste.mdb'.

Você pode me ajudar?? A onde eu estou errando?? O que está faltando??

Link para o comentário
Compartilhar em outros sites

  • 0
Qual versão do Access está usando ?

Dá uma olhada nesses artigo que fala exatamente sobre esse erro que acontece principalmente quando usa o Access 2000 ou 2002,o erro não é no seu código e sim no proprio vb 6.0.

Link de como resolver esse erro.

Bom dia a todos.

Eu resolvi este problema em parte. Consegui fazer a conexão de uma nova aplicação (exemplo simples, de cadastro de clientes) com butons GRAVAR E EXCLUIR, usando o access como banco local e remotamente. Deu tudo OK.

Mas quando troco o banco para FIREBIRD.

Dim adoCnn As New ADODB.Connection
Public Sub sConexao()
   'abre o BD de informação de caminho final do BD
   ' O BD onde informamos o caminho do DB tem que ficar na pasta sistema do micro local
 '  Set db = OpenDatabase("C:\sistema\teste.mdb")
  adoCnn.Open "Provider=IbOleDb.1;Location=192.168.0.34;Data Source=d:/ttimdb/dados/tti.FDB;User  ID=SYSDBA;Password=masterkey;Extended Properties='sql Dialect=3;Character Set=WIN1252'"
   
   Set Dst = db.OpenRecordset("select * from path_d")
   xdrive = Dst("drive")
   Mydir = Trim(xdrive)
   Dst.Close
   'seta o BD
   'pega o diretório de operação do programa
   Set db = OpenDatabase(Mydir + "\Dados\conexao.fdb")
End Sub
Não sei o que está dando errado. Segue o código com banco access tudo ok. Dim db As Database Dim Mydir As String
Private Sub CmdExcluir_Click()
  If Len(TxtCodigo) = 0 Then
     Exit Sub
  End If
  Call sConexao
  Set Dst = db.OpenRecordset("select * from Clientes where CODI like '" + TxtCodigo + "' order by CODI")
  If Dst.RecordCount <> 0 Then
     Dst.Delete
  End If
     Dst.Close
     TxtCodigo.Text = ""
End Sub

'=========================================================================================

Private Sub CmdNovo_Click()
   TxtCodigo = ""
   TxtNome = ""
   TxtEndereco = ""
   TxtTelefone = ""
   'Vai Buscar o Próximo Número para o Codigo de Clientes
   If Len(Trim(FrmClientes.Tag)) = 0 Then
      Call sConexao
      Set Dst = db.OpenRecordset("select CODI from CLIENTES order by CODI")
      If Dst.RecordCount <> 0 Then
         Dst.MoveLast
         TxtCodigo = Dst("CODI") + 1
      End If
      Dst.Close
   Else
         CmdSair.SetFocus
   End If
End Sub

'=========================================================================================

Private Sub CmdGravar_Click()
  'VERIFICA OS CAMPOS OBRIGATÓRIOS
  If Len(Trim(TxtCodigo)) = 0 Then
     MsgBox "Código fo Cliente não foi Preenchido. Click no Botão NOVO!", 64, "Teste Conexão"
     TxtCodigo.SetFocus
     Exit Sub
  End If
  If Len(Trim(TxtNome)) = 0 Then
     MsgBox "Nome do Cliente não foi Preenchido !", 64, "Teste Conexão"
     TxtNome.SetFocus
     Exit Sub
  End If
  If Len(Trim(TxtEndereco)) = 0 Then
     MsgBox "Endereço do Cliente não foi Preenchido !", 64, "Teste Conexão"
     TxtEndereco.SetFocus
     Exit Sub
  End If
  If Len(Trim(TxtTelefone)) = 0 Then
     MsgBox "Telefone do Cliente não foi Preenchido !", 64, "Teste Conexão"
     TxtTelefone.SetFocus
     Exit Sub
  End If

'GRAVA OS REGISTROS
    Set Dst = db.OpenRecordset("select * from Clientes")
    Dst.AddNew
    Dst("CODI") = TxtCodigo
    Dst("NOME") = Trim(TxtNome)
    Dst("ENDE") = Trim(TxtEndereco)
    Dst("FONE") = Trim(TxtTelefone)
    Dst.Update
    Dst.Close
'LIMPA AS CAIXAS DE TEXTO
    TxtCodigo = ""
    TxtNome = ""
    TxtEndereco = ""
    TxtTelefone = ""
End Sub

'=========================================================================================

Public Sub sConexao()
   'abre o BD de informação de caminho final do BD
   ' O BD onde infrmamos o caminho do DB tem que ficar na pasta sistema do micro local
   Set db = OpenDatabase("C:\sistema\ttipt1.mdb")
   Set Dst = db.OpenRecordset("select * from path_d")
   xdrive = Dst("drive")
   Mydir = Trim(xdrive)
   Dst.Close
   'seta o BD
   'pega o diretório de operação do programa
   Set db = OpenDatabase(Mydir + "\Dados\conexao.mdb")
End Sub

'=========================================================================================

Private Sub CmdSair_Click()
  Unload Me
  Close All
End Sub

Link para o comentário
Compartilhar em outros sites

  • 0
marcelo, qual a mensagem de erro q da com o firebird e em q linha??

olha sua connection string, ela ta com dois espacos entre User e Id, sera q não é isso??

fora isso, os caminhos tão td certo, o password é mesmo masterkey??

Olá KUROI. Tudo em paz.

Vou te mandar a conexao de duas formas:

1ª - Dá esse erro na linha do SET DB

Run-time Error 3045

"NÃO FOI POSSÍVEL USAR C:\...\TESTEBANCO.FDB" O ARQUIVO JÁ ESTÁ EM USO

Public Sub sConexao()

conexao.Open ("DSN=FireBird;Driver=Firebird/InterBase® driver;Dbname=C:\Documents and

Settings\user\Desktop\ConexaoDominio\TIRAR DUVIDA CONEXAO FIREBIRD\CONEXAO FIREBIRD

LOCAL\bancoteste.FDB;CHARSET=WIN1252;USER ID=SYSDBA;PWD=masterkey;Client=C:\Arquivos de

programas\Firebird\Firebird_2_1\bin\fbclient.dll;") Mydir = App.Path

Set db = OpenDatabase(Mydir + "\bancoteste.fdb")

Dst.Close

End Sub

2ª - Dá o mesmo erro da conexão de cima (existe apenas 01(um) espaço entre "user e ID", mas se eu der 2 espacos o erro muda para esse e na linha de conexao:

Run-time Error 2147467259(80004005)

"Your user name and password are not difined. Ask your database administrator to set up a firebird login.

Public Sub sConexao()

conexao.Open ("Provider=IbOleDb.1;Location=127.0.0.1;Data Source=C:\Documents and S

Settings\user\Desktop\ConexaoDominio\TIRAR DUVIDA CONEXAO FIREBIRD\CONEXAO FIREBIRD

LOCAL\BANCOTESTE.FDB;User ID=SYSDBA;Password=masterkey;Extended Properties='sql Dialect=3;Character

Set=ISO8859_1;Collate = PT_BR'")

Mydir = App.Path Set db = OpenDatabase(Mydir + "\bancoteste.fdb")

Dst.Close

End Sub

Mais um vez obrigado pela atenção.

Marcelo

Editado por Marcelo Cavalcanti
Link para o comentário
Compartilhar em outros sites

  • 0

marcelo, o q é conexao?? é um objeto ADODB.Connection, certo??

porque você ta fazendo a conexao por ADO e tb por DAO??

faca so por ADO. tire a linha do set db e use o objeto conexao como sua conexao ativa e já era, aparentemente, essa primera conexao ta funcionando (e a segunda, possivelmente não funciona exatamente por conta da primeira).

Link para o comentário
Compartilhar em outros sites

  • 0
marcelo, o q é conexao?? é um objeto ADODB.Connection, certo??

porque você ta fazendo a conexao por ADO e tb por DAO??

faca so por ADO. tire a linha do set db e use o objeto conexao como sua conexao ativa e já era, aparentemente, essa primera conexao ta funcionando (e a segunda, possivelmente não funciona exatamente por conta da primeira).

Bom dia Kuroi. você poderia ver esse erro e se possível me orientar.

Obrigado e um grande abraço

Marcelo

'BOTAO NOVO

Private Sub CmdNovo_Click()

TxtCodigo = ""

TxtNome = ""

TxtEndereco = ""

TxtTelefone = ""

'Vai Buscar o Próximo Número para o Codigo de Clientes

If Len(Trim(ConexFireBird.Tag)) = 0 Then

' conexao.Open

cn.ConnectionString = "Provider=ZStyle IBOLE Provider;Data Source=C:\Documents and Settings\user\Desktop\CONEXAO FireBird TESTANDO\CONEXAO.FDB;UID=sysdba;password=masterkey"

sql = "select CODI from CLIENTES order by CODI"

cn.Open

Set rs = cn.Execute(sql)

If rs.RecordCount <> 0 Then

rs.MoveLast

TxtCodigo = rs("CODI") + 1

rs.Close

End If

Else

CmdSair.SetFocus

End If

End Sub

'GRAVA OS REGISTROS

Private Sub CmdGravar_Click()

cn.ConnectionString = "Provider=ZStyle IBOLE Provider;Data Source=C:\Documents and

Settings\user\Desktop\CONEXAO FireBird TESTANDO\CONEXAO.FDB;UID=sysdba;password=masterkey"

sql = "select * from CLIENTES"

Set rs = cn.Execute(sql)

rs.AddNew

rs("CODI") = TxtCodigo

rs("NOME") = Trim(TxtNome)

rs("ENDE") = Trim(TxtEndereco)

rs("FONE") = Trim(TxtTelefone)

rs.Update

rs.Close

'LIMPA AS CAIXAS DE TEXTO

TxtCodigo = ""

TxtNome = ""

TxtEndereco = ""

TxtTelefone = ""

End Sub

ACIONO O BOTAO NOVO E LEGAL VAI BUSCAR O ULTIMO CODIGO DO CLIENTE + 1, INSIRO REGISTROS E CLICO NO BOTAO GRAVAR E DAR ERRO DA LINHA DE CONEXAO DA PROCEDURE GRAVAR, O ERRO É O SEGUINTE:

Run-Time error '3705' OPERAÇÃO NÃO PERMITIDA QUANDO O OBJETO ESTÁ ABERTO.

Editado por Marcelo Cavalcanti
Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152,1k
    • Posts
      651,8k
×
×
  • Criar Novo...