Question

VB中怎么通过代码创建ODBC数据源

Answer 1

创建SQL Server的ODBC数据源如下：



Private Const ODBC_ADD_DSN = 1        ' Add data source
Private Const ODBC_CONFIG_DSN = 2    ' Configure (edit) data source
Private Const ODBC_REMOVE_DSN = 3    ' Remove data source
Private Const vbAPINull As Long = 0&  ' NULL Pointer
Private Declare Function SQLAllocEnv Lib "odbc32.dll" (phenv&) As Integer
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

'********************************************
'函数：创建SQL DSN
Public Function CreateSQLDSN(ByVal DSN As String, ByVal Server As String, ByVal Database As String, _
                              ByVal Driver As String, ByVal Description As String) As Boolean
    Dim strAttributes As String
    
    SQLConfigDataSource vbAPINull, ODBC_REMOVE_DSN, Driver, "DSN=" & DSN
    strAttributes = "DSN=" & DSN & Chr$(0) & _
                    "Description=" & Description & Chr$(0) & _
                    "Server=" & Server & Chr$(0) & _
                    "Database=" & Database & Chr$(0)
    If SQLConfigDataSource(vbAPINull, ODBC_ADD_DSN, Driver, strAttributes) = 0 Then
        CreateSQLDSN = False
    Else
        CreateSQLDSN = True
    End If
End Function

创建Foxpro(DBF)数据源如下：
Private Const mc_RegKeyRun$ = "SOFTWARE\Microsoft\Windows\CurrentVersion\Run"
Private Declare Function RegCloseKey Lib "advapi32.dll" _
                (ByVal Hkey As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
                (ByVal Hkey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" _
                (ByVal Hkey As Long, ByVal lpSubKey As String, _
                phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
                (ByVal Hkey As Long, ByVal lpValueName As String, _
                ByVal lpReserved As Long, lpType As Long, lpData As Any, _
                lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _
                (ByVal Hkey As Long, ByVal lpValueName As String, _
                ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, _
                ByVal cbData As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" _
                (ByVal Hkey As Long, ByVal lpSubKey As String, _
                phkResult As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
                (ByVal Hkey As Long, ByVal lpSubKey As String) As Long
Private Const REG_SZ = 1 ' Unicode nul terminated String
Private Const REG_DWORD = 4 ' 32-bit number
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003
Private Const HKEY_PERFORMANCE_DATA = &H80000004
Private Const ERROR_SUCCESS = 0&

'**********************************************
'函数：创建DBF DSN
Public Function CreateDBFDSN(ByVal DSN As String, ByVal FilePath As String, ByVal Description As String) As Boolean
    Dim phkResult As Long
    Dim strRegVal As String
    Dim retVal As Boolean
    
    retVal = False
    On Error GoTo ErrProc

    RegOpenKey HKEY_CURRENT_USER, "Software\ODBC\ODBC.INI\ODBC Data Sources", phkResult
    strRegVal = "Microsoft Visual Foxpro Driver"
    RegSetValueEx phkResult, DSN, 0, REG_SZ, ByVal strRegVal, Len(strRegVal) + 2
    RegCloseKey phkResult

    RegDeleteKey HKEY_CURRENT_USER, "Software\ODBC\ODBC.INI\" & DSN

    RegCreateKey HKEY_CURRENT_USER, "Software\ODBC\ODBC.INI\" & DSN, phkResult
    strRegVal = "Yes"
    RegSetValueEx phkResult, "BackgroundFetch", 0, REG_SZ, ByVal strRegVal, Len(strRegVal) + 2
    strRegVal = "Machine"
    RegSetValueEx phkResult, "Collate", 0, REG_SZ, ByVal strRegVal, Len(strRegVal) + 2
    strRegVal = "Yes"
    RegSetValueEx phkResult, "Deleted", 0, REG_SZ, ByVal strRegVal, Len(strRegVal) + 2
    strRegVal = Description
    RegSetValueEx phkResult, "Description", 0, REG_SZ, ByVal strRegVal, Len(strRegVal) + 2
    strRegVal = "C:\WINNT\System32\vfpodbc.dll"
    RegSetValueEx phkResult, "Driver", 0, REG_SZ, ByVal strRegVal, Len(strRegVal) + 2
    strRegVal = "No"
    RegSetValueEx phkResult, "Exclusive", 0, REG_SZ, ByVal strRegVal, Len(strRegVal) + 2
    strRegVal = "Yes"
    RegSetValueEx phkResult, "Null", 0, REG_SZ, ByVal strRegVal, Len(strRegVal) + 2
    strRegVal = "No"
    RegSetValueEx phkResult, "SetNoCountOn", 0, REG_SZ, ByVal strRegVal, Len(strRegVal) + 2
    strRegVal = FilePath
    RegSetValueEx phkResult, "SourceDB", 0, REG_SZ, ByVal strRegVal, Len(strRegVal) + 2
    strRegVal = "DBF"
    RegSetValueEx phkResult, "SourceType", 0, REG_SZ, ByVal strRegVal, Len(strRegVal) + 2

    RegCloseKey phkResult
    retVal = True
ErrProc:
    CreateDBFDSN = retVal
End Function
对我有用[0] 丢个板砖[0] 引用 | 举报 | 管理