Postada em 26/12/2011 13:58 hs
Caro jongle, é possivel sim, tem uma função circulando na web nos sites e foruns que vc
embute no sistema, ela checa a existencia da conexao e se não tiver cria, com a dll
da conexão que vc vai utilizar...
é mais ou menos isso aqui, é claro que vc tem de adaptar se for o caso...
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
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" _
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias _
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, _
ByRef lpcbData As Long) As Long
Const REG_SZ = 1
Const KEY_ALL_ACCESS = &H2003F
Const HKEY_CURRENT_USER = &H80000001
Const ODBC_ADD_DSN = 1 ' cria o DSN
Const ODBC_REMOVE_DSN = 3 ' excluir o DSN
Sub CriaDSN(ByVal sDSN As String, ByVal sDriver As String, ByVal sDBFile As String, ByVal lAction As Long)
Dim sAttributes As String
Dim sDBQ As String
Dim lngRet As Long
Dim hKey As Long
Dim regValue As String
Dim valueType As Long
'OdbcJdbc.dll 'DLL PARA CRIAR O DRIVE FIREBIRD
' consulta o registro para verificar se o DSN já esta instalado
' abre a chave
If RegOpenKeyEx(HKEY_CURRENT_USER, "SoftwareODBCODBC.INI" & sDSN, 0, KEY_ALL_ACCESS, hKey) = 0 Then
' zero significa sem errosr => Retorna o valor de chave "DBQ"
regValue = String$(1024, 0)
' Aloca espaço para a variável
If RegQueryValueEx(hKey, "DBQ", 0, valueType, regValue, Len(regValue)) = 0 Then
' zero signifia sem erros, podemo retornar o valor
If valueType = REG_SZ Then
sDBQ = Left$(regValue, InStr(regValue, vbNullChar) - 1)
End If
End If
' fecha a chave
RegCloseKey hKey
End If
' Realiza a ação somente se você esta incluindo um DSN que nao existe ou remove um existente
If (sDBQ = "" And lAction = ODBC_ADD_DSN) Or (sDBQ <> "" And lAction = ODBC_REMOVE_DSN) Then
' verifica se o arquivo existe
If Len(dir$(sDBFile)) = 0 Then
MsgBox "Banco de dados não existe ! ", vbOKOnly + vbCritical
Exit Sub
End If
sAttributes = "DSN=" & sDSN & vbNullChar & "DBQ=" & sDBFile & vbNullChar
lngRet = SQLConfigDataSource(0&, lAction, sDriver, sAttributes)
End If
End Sub
|
