ODBC AUTOMATICO - DUVIDAS

USUARIO.EXCLUIDOS 24/05/2007 11:37:11
#218067

TURMA! meu projeto ta caminhando..mas esbarrei no ODBC. Para evitar q, toda vez quando se faz a instalação do sistema em uma maquina diferente, tenha que se criar uma fonte de dados no painel de controle, tentei o seguinte num módulo:

Sub CriaODBC()
  Dim Attrib, DBDriver As String
  Attrib = "DBQ=C:\Adolescentes\Banco\Cadastro.mdb"
  DBDriver = "Microsoft Access Driver (*.mdb)"
  DBEngine.RegisterDatabase "Cadastro", DBDriver, True, Attrib
End Sub

mas simplesmente... não funciona!!! preciso muito descobrir como fazer (via cód) a criação do ODBC.. grato galera!

RODRIGOMARCHESE 24/05/2007 11:45:23
#218071

'Utilizado em CriarDSN e RemoverDSN
Private Const ODBC_ADD_DSN = 1
Private Const ODBC_CONFIG_DSN = 2
Private Const ODBC_REMOVE_DSN = 3
Private Const ODBC_ADD_SYS_DSN = 4
Private Const ODBC_CONFIG_SYS_DSN = 5
Private Const ODBC_REMOVE_SYS_DSN = 6
Private Const ODBC_REMOVE_DEFAULT_DSN = 7

Private Const vbAPINull As Long = 0&
Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" (ByVal hwndParent As Long, ByVal fRequest As Long, ByVal lpszDriver As String, ByVal lpszAttributes As String) As Long

Public Function CriarDSN(strDriver, strNomeDSN, strDscDSN, strDatabase, strUsuario, strSenha) As Boolean

  Dim intRet As Long
  Dim strAtributos As String

  strAtributos = strAtributos & "DESCRIPTION=" & strDscDSN & Chr$(0)
  strAtributos = strAtributos & "DSN=" & strNomeDSN & Chr$(0)
  strAtributos = strAtributos & "DBQ=" & strDatabase & Chr$(0)
  strAtributos = strAtributos & "UID=" & strUsuario & Chr$(0)
  strAtributos = strAtributos & "PWD=" & strSenha & Chr$(0)
  
  intRet = SQLConfigDataSource(vbAPINull, ODBC_ADD_SYS_DSN, strDriver, strAtributos)
  
  If intRet Then
     CriarDSN = True
  Else
     CriarDSN = False
  End If

End Function

Public Function RemoverDSN(strDriver, strNomeDSN) As Boolean

  Dim intRet As Long
  Dim strAtributos As String

  strAtributos = "DSN=" & strNomeDSN & Chr$(0)
  
  intRet = SQLConfigDataSource(vbAPINull, ODBC_REMOVE_SYS_DSN, _
  strDriver, strAtributos)
  If intRet Then
    RemoverDSN = True
  Else
    RemoverDSN = False
  End If

End Function

USUARIO.EXCLUIDOS 24/05/2007 12:49:20
#218086

amigo! testei o q vc pos, mas não deu certo... as linhas de SQL reclamam por não achar o banco... mas mesmo assim obrigado!

RODRIGOMARCHESE 24/05/2007 14:05:09
#218102

passa mais do seu código, para podermos lhe ajudar mais...

USUARIO.EXCLUIDOS 24/05/2007 14:20:52
#218107

meu global.bas:

Option Explicit
Global Area As Workspace
Global Cadastro As Database
Global TabClientes As Recordset
Global Caminho As String
Global Extensao As String
Global TabNomeFoto As Recordset
Global TabSetor As Recordset
Global TabCliNomeResumo As Recordset
Global TabUsuario As Recordset
Global TabCliSetor As Recordset
Global TabGerador As Recordset
Global glbUsuario As String

Public Sub Rotina_AbrirBanco()
  
 Set Area = DBEngine.Workspaces(0)
  
 Set Cadastro = Area.OpenDatabase(App.Path & "\Banco\Cadastro.mdb")
  
 Set TabClientes = Cadastro.OpenRecordset("Clientes")
     TabClientes.Index = "IndClientes"
     
 Set TabCliNomeResumo = Cadastro.OpenRecordset("Clientes")
     TabCliNomeResumo.Index = "IndNomeResumido"
  
 Set TabCliSetor = Cadastro.OpenRecordset("Clientes")
     TabCliSetor.Index = "IndSetor"
     
 Set TabNomeFoto = Cadastro.OpenRecordset("NomeFoto")
     TabNomeFoto.Index = "IndFotoNome"
      
 Set TabSetor = Cadastro.OpenRecordset("Setor")
     TabSetor.Index = "IndSetor"
       
 Set TabUsuario = Cadastro.OpenRecordset("Usuario")
     TabUsuario.Index = "IndUsuario"
        
 Set TabGerador = Cadastro.OpenRecordset("gerador")
     TabGerador.Index = "Indgerador"
         
Caminho = (App.Path & "\Fotos\")
Extensao = (".bmp")
End Sub

Public Sub Rotina_FecharBanco()
 Cadastro.Close
End Sub

RODRIGOMARCHESE 24/05/2007 14:31:06
#218109

observe a nova estrutura do codigo, considerando consideranco o seu código e o que postei anteriormente:

Sub main()

If Rotina_AbrirBanco = False Then
   Call CriarDSN(strDriver, strNomeDSN, strDscDSN, strDatabase, strUsuario, strSenha)
Else
    Set TabClientes = Cadastro.OpenRecordset("Clientes")
        TabClientes.Index = "IndClientes"
        
    Set TabCliNomeResumo = Cadastro.OpenRecordset("Clientes")
        TabCliNomeResumo.Index = "IndNomeResumido"
     
    Set TabCliSetor = Cadastro.OpenRecordset("Clientes")
        TabCliSetor.Index = "IndSetor"
        
    Set TabNomeFoto = Cadastro.OpenRecordset("NomeFoto")
        TabNomeFoto.Index = "IndFotoNome"
         
    Set TabSetor = Cadastro.OpenRecordset("Setor")
        TabSetor.Index = "IndSetor"
          
    Set TabUsuario = Cadastro.OpenRecordset("Usuario")
        TabUsuario.Index = "IndUsuario"
           
    Set TabGerador = Cadastro.OpenRecordset("gerador")
        TabGerador.Index = "Indgerador"
            
    Caminho = (App.Path & "\Fotos\")
    Extensao = (".bmp")
End If

End Sub

Public Function Rotina_AbrirBanco() As Boolean
  
On Error GoTo TrataErro
  
 Set Area = DBEngine.Workspaces(0)
 Set Cadastro = Area.OpenDatabase(App.Path & "\Banco\Cadastro.mdb")
 Rotina_AbrirBanco = true

TrataErro:
If Err.Number <> 0 Then
   Rotina_AbrirBanco = False
End If

End Function

USUARIO.EXCLUIDOS 24/05/2007 14:48:47
#218113

certo amigo, mas no caso: o primeiro cod q vc mandou junto com este ultimo q vc mandou: todos eles vao no global.bas ou outro lugar tb?

USUARIO.EXCLUIDOS 24/05/2007 14:57:20
#218117

deu erro amigo... quando ponho login e clico ok pra entrar no sistema, ele me retorna erro...

meu cod de login:

Dim curalpha As Integer

Option Explicit

Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long

Private Const MF_BYPOSITION = &H400&
Private Const MF_REMOVE = &H1000&

Dim vCont As Integer

Private Sub CmdCanc_Click()
    End
End Sub

Private Sub cmdOk_Click()
    Dim erro As Byte
    Dim NomeUsua, SenhaUsua, SQL As String
    
    erro = 0
    
    If TxtNome = "" Then
       MsgBox "Informar o Nome do Usuário", vbInformation, "S.I.C.A.D."
       erro = 1
       CmdCanc.SetFocus
       Exit Sub
    End If
    
    TabUsuario.Seek "=", TxtNome
    If TabUsuario.NoMatch Then
       MsgBox "Usuário não Cadastrado", vbInformation, "S.I.C.A.D."
       erro = 1
       CmdCanc.SetFocus
       Exit Sub
    End If
    
    If Not TxtSenh = TabUsuario("ususenha") Then
       MsgBox "Senha Inválida", vbInformation, "S.I.C.A.D."
       erro = 1
       CmdCanc.SetFocus
       Exit Sub
    Else
       erro = 0
    End If
    
    If erro > 0 Then
       MsgBox "Sistema será Descontinuado", vbInformation, "S.I.C.A.D."
       
       
       
       End
    Else
       glbUsuario = TxtNome
       Unload Me
    End If

End Sub

Private Sub Form_Load()
    vCont = 0
    SetTranslucent Me.hwnd, 0
    curalpha = 0
    TmrAnima.Enabled = True
    
     Dim hSysMenu As Long
  Dim nCnt As Long
  
  'Aqui vc desabilita:
  '(Restaurar, Maximizar, Mover, Fechar etc.)
  hSysMenu = GetSystemMenu(Me.hwnd, False)
  
  If hSysMenu Then
    ' Get System menu's menu count
    nCnt = GetMenuItemCount(hSysMenu)
    
    If nCnt Then
      'Menu count is based on 0 (0, 1, 2, 3...)
      
      RemoveMenu hSysMenu, nCnt - 1, MF_BYPOSITION Or MF_REMOVE
      RemoveMenu hSysMenu, nCnt - 2, MF_BYPOSITION Or MF_REMOVE ' Remove the seperator
      
      DrawMenuBar Me.hwnd
      'Force caption bar's refresh. Disabilita o botão Fechar
     
    End If
  End If
End Sub

Private Sub TmrAnima_Timer()
    SetTranslucent Me.hwnd, curalpha
    curalpha = curalpha + 10
    If curalpha > 255 Then
        curalpha = 255
        SetTranslucent Me.hwnd, curalpha
        TmrAnima.Enabled = False
    End If
End Sub

Private Sub Form_Activate()
Dim X As String
  If App.PrevInstance Then
     X = MsgBox("O S.I.C.A.D. já se encontra em execução!!", vbCritical, "Aviso S.I.C.A.D.")
     End
  End If
End Sub

o erro fika em: TabUsuario.Seek "=", TxtNome

RODRIGOMARCHESE 24/05/2007 14:57:41
#218118

se as rotinas forem publicas, poderão estar em outro módulo, senão deverá ser no mesmo.

Página única

Tópico encerrado , respostas não são mais permitidas

Voltar