请问,怎么才能用VB程序创建一个ODBC

Question

请问,怎么才能用VB程序创建一个ODBC，
比如说ODBC名为21peixun,数据库是ACCESS的
请帮帮我,先谢谢了！！！

Answer 1

可以引用SQL_DMO库来完成。ADO也是可以的。

Answer 2

能不能在一进程序的时候先检测是否存在21peixun的odbc，没有的话就创建一个啊？

Answer 3

刚好我有
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, 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 ' Note that if you declare the lpData parameter as String, you must pass it By Value.
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 RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
'创建DSN的函数createAccessDSN
Public Function createAccessDSN(szDriverName As String, szWantedDSN As String, dbvalue As String) As Boolean
    Dim hKey As Long
    Dim szKeyPath As String
    Dim szKeyName As String
    Dim szKeyValue As String
    Dim lKeyValue As Long
    Dim lRes As Long
    Dim lSize As Long
    Dim szEmpty As String
    szEmpty = Chr(0)
    
    
    lSize = 4
    '在注册表中创建关键字
    lRes = RegCreateKey(HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\" & szWantedDSN, hKey)
    
    If lRes <> ERROR_SUCCESS Then
        createAccessDSN = False
        Exit Function
    End If
    '将数据库的相关信息写到注册表中
    '用户名
    lRes = RegSetValueExString(hKey, "UID", 0&, REG_SZ, szEmpty, Len(szEmpty))
    szKeyValue = dbvalue
    '数据提供者
    lRes = RegSetValueExString(hKey, "DBQ", 0&, REG_SZ, _
    szKeyValue, Len(szKeyValue))
    szKeyValue = szDriverName
    '驱动程序
    lRes = RegSetValueExString(hKey, "Driver", 0&, REG_SZ, _
    szKeyValue, Len(szKeyValue))
    szKeyValue = "MS Access;"
    lRes = RegSetValueExString(hKey, "FIL", 0&, REG_SZ, _
    szKeyValue, Len(szKeyValue))
    lKeyValue = 25
    lRes = RegSetValueExLong(hKey, "DriverId", 0&, REG_DWORD, _
    lKeyValue, 4)
    
    lKeyValue = 0
    lRes = RegSetValueExLong(hKey, "SafeTransactions", 0&, REG_DWORD, _
    lKeyValue, 4)
    
    lRes = RegCloseKey(hKey)
    szKeyPath = "SOFTWARE\ODBC\ODBC.INI\" & szWantedDSN & "\Engines\Jet"
    
    lRes = RegCreateKey(HKEY_LOCAL_MACHINE, szKeyPath, hKey)
    
    If lRes <> ERROR_SUCCESS Then
        createAccessDSN = False
        Exit Function
    End If
    '设定其他属性
    lRes = RegSetValueExString(hKey, "ImplicitCommitSync", 0&, REG_SZ, szEmpty, Len(szEmpty))
    szKeyValue = "Yes"
    lRes = RegSetValueExString(hKey, "UserCommitSync", 0&, REG_SZ, szKeyValue, Len(szKeyValue))
    lKeyValue = 2048
    lRes = RegSetValueExLong(hKey, "MaxBufferSize", 0&, REG_DWORD, lKeyValue, 4)
    
    lKeyValue = 5
    lRes = RegSetValueExLong(hKey, "PageTimeout", 0&, REG_DWORD, lKeyValue, 4)
    
    lKeyValue = 3
    lRes = RegSetValueExLong(hKey, "Threads", 0&, REG_DWORD, lKeyValue, 4)
    
    lRes = RegCloseKey(hKey)
    lRes = RegCreateKey(HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources", hKey)
    
    If lRes <> ERROR_SUCCESS Then
        createAccessDSN = False
        Exit Function
    End If
    
    szKeyValue = "Microsoft Access Driver (*.mdb)"
    lRes = RegSetValueExString(hKey, szWantedDSN, 0&, REG_SZ, szKeyValue, Len(szKeyValue))
    lRes = RegCloseKey(hKey)
    createAccessDSN = True
    End Function
'浏览按钮单击事件，用于选择ACCESS数据库
Private Sub Browse_Click()
Dim oDialog As Object
    Set oDialog = DAPP.xDialog.Object
    ' 通过对话框选择数据库文件
    oDialog.DialogTitle = "Please Select New Data File"
    oDialog.Filter = "Access Database(*.mdb;*.mda;*.mde;*.mdw)|*.mdb; *.mda; *.mde; *.mdw|All(*.*)|*.*"
    oDialog.FilterIndex = 1
    oDialog.ShowOpen
    ' 如果用户选择了文件名，则把文件路径显示在文本框中
    If Len(oDialog.FileName) > 0 Then
        DAPP.DatabaseName = oDialog.FileName
        strFilename = DAPP.DatabaseName
    End If
End Sub
'创建DSN按钮单击事件
Private Sub CreateDSN_Click()
Dim dsnname As String
    dsnname = DAPP.DSN
    If Not (dsname = "" And strFilename = "") Then
        createAccessDSN "Microsoft Access Driver (*.mdb)", dsnname, strFilename
        MsgBox ("DSN" & dsnname & "Created Sucessfully")
    Else
        If dsnname = "" Then
            MsgBox ("Please Enter A Data Source Name")
            Exit Sub
        End If
        If strFilename = "" Then
            MsgBox ("Please Select a Database")
            Exit Sub
        End If
   End If
End Sub
这个是创建odbc access的dsn

Answer 4

Private Sub Command1_Click()
    Dim oODBC As New ODBCTool.Dsn
    Dim aDSN() As String
        '通过GetDataSourceList方法来获取DSN列表
        oODBC.GetDataSourceList aDSN
        For i = LBound(aDSN) To UBound(aDSN)
            List1.AddItem aDSN(i)
        Next
        List1.ListIndex = 0
    Set oODBC = Nothing
End Sub
这个是获取dsn列表的需要引用 odbc driver & data source name functions

Answer 5

十分感谢您，怎么才能给分啊？还有Set oDialog = DAPP.xDialog.Object这句我这里有问题，会出错
DAPP是什么？
我不知道要还要加什么东西，麻烦您了createAccessDSN "Microsoft Access Driver (*.mdb)", dsnname, strFilename
这句里面strFilename的"类型错误"最后的Dim oODBC As New ODBCTool.Dsn说是"用户类型出错"

Answer 6

不可能阿 
我本机测试完全可以的阿一点错误没有 
我刚才有测试了一下我就是把整个代码都给你拿上来的你只需要加两个text控件和2个button控件和一个commondialgo控件
就可以了
commondialgo控件
命名为xDialog
按钮一个叫Browse
另一个是CreateDSN 这样就ok
text属性一个是DatabaseName
另一个是DSN搞定以后点管理然后给分