IT资讯
用代码创建 DSN(SQL Server ODBC)[转帖]
2006-11-13 21:47:17
正    文：    这里是我分发程序中的一些代码。通常应用程序需要通过ODBC连接SQL Server数据库，因此要为链接表创建系统的DSN。该程序将在未发现现在的ODBC时创建一个新的系统的DSN。'*********************** Code Start ***************************'Const JDS_DSN_name = "MDTS"               ' DSN的名字Const JDS_Server_name = "148.154.61.15"   ' 服务器名，这里给出的服务器的IP地址，                                          ' 也可以通过域名解析给出域名' 定义注册表API函数Private Declare Function RegEnumKeyEx Lib "advapi32.dll" _Alias "RegEnumKeyExA" _  (ByVal hKey As Long, _   ByVal dwIndex As Long, _   ByVal lpName As String, _   lpcbName As Long, _   ByVal lpReserved As Long, _   ByVal lpClass As String, _   lpcbClass As Long, _   ByVal lpftLastWriteTime As String) As LongPrivate 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 LongPrivate Declare Function RegCloseKey Lib "advapi32.dll" _    (ByVal hKey As Long) As LongConst HKEY_LOCAL_MACHINE = &H80000002Const ERROR_SUCCESS = 0&Const SYNCHRONIZE = &H100000Const STANDARD_RIGHTS_READ = &H20000Const STANDARD_RIGHTS_WRITE = &H20000Const STANDARD_RIGHTS_EXECUTE = &H20000Const STANDARD_RIGHTS_REQUIRED = &HF0000Const STANDARD_RIGHTS_ALL = &H1F0000Const KEY_QUERY_value = &H1Const KEY_SET_value = &H2Const KEY_CREATE_SUB_KEY = &H4Const KEY_ENUMERATE_SUB_KEYS = &H8Const KEY_NOTIFY = &H10Const KEY_CREATE_LINK = &H20Const KEY_READ = ((STANDARD_RIGHTS_READ Or _                   KEY_QUERY_value Or _                   KEY_ENUMERATE_SUB_KEYS Or _                   KEY_NOTIFY) And _                   (Not SYNCHRONIZE))Const REG_DWORD = 4Const REG_BINARY = 3Const REG_SZ = 1      Const ODBC_ADD_SYS_DSN = 4      Private Declare Function SQLConfigDataSource Lib "odbccp32.dll" _    (ByVal hwndParent As Long, _    ByVal fRequest As Integer, _    ByVal lpszDriver As String, _    ByVal lpszAttributes As String) As LongFunction Check_SDSN()    ' 查看我们要的系统数据源(DSN)是否存在。    ' 如果存在，正好；否则，我们就创建一个。             Dim lngKeyHandle As Long    Dim lngResult As Long    Dim lngCurIdx As Long    Dim strvalue As String    Dim classvalue As String    Dim timevalue As String    Dim lngvalueLen As Long    Dim classlngvalueLen As Long    Dim lngData As Long    Dim lngDataLen As Long    Dim strResult As String    Dim DSNfound As Long    Dim syscmdresult As Long    syscmdresult = SysCmd(acSysCmdSetStatus, "查找系统DSN: " & JDS_DSN_name & " …")             ' 打开包含系统数据源(DSN)的注册表主键。             lngResult = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _                             "SOFTWARE\ODBC\ODBC.INI", _                             0&, _                             KEY_READ, _                             lngKeyHandle)    If lngResult <> ERROR_SUCCESS Then        MsgBox "错误: 不能打开注册键 HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBC.INI." & _               vbCrLf & vbCrLf & _               "请安装SQL Server的ODBC驱动程序用以调用MDTS系统数据源。" & _               vbCrLf & _               "要获得更多的信息，请与管理员联系。"        syscmdresult = SysCmd(acSysCmdClearStatus)        Check_SDSN = -1    End If             ' 现在这个注册键是打开的，我们在这个查找看是否我们需要的。    lngCurIdx = 0    DSNfound = False             Do        lngvalueLen = 512        classlngvalueLen = 512        strvalue = String(lngvalueLen, 0)        classvalue = String(classlngvalueLen, 0)        timevalue = String(lngvalueLen, 0)        lngDataLen = 512        lngResult = RegEnumKeyEx(lngKeyHandle, _                                 lngCurIdx, _                                 strvalue, _                                 lngvalueLen, _                                 0&, _                                 classvalue, _                                 classlngvalueLen, _                                 timevalue)        lngCurIdx = lngCurIdx + 1        If lngResult = ERROR_SUCCESS Then                     ' 是我们要的系统数据源吗?                     If strvalue = JDS_DSN_name Then                           ' 是! 那就不需要我们再做什么了。                             DSNfound = True                syscmdresult = SysCmd(acSysCmdClearStatus)                     End If                   End If    Loop While lngResult = ERROR_SUCCESS And Not DSNfound             Call RegCloseKey(lngKeyHandle)    If Not DSNfound Then                 ' 我们所需的系统数据源不存在，因此，我们试着创建一个。                 Syscmdresult = SysCmd(acSysCmdSetStatus, "创建系统数据源DSN: " & JDS_DSN_name & "…")                 lngResult = SQLConfigDataSource(0, _                                        ODBC_ADD_SYS_DSN, _                                        "SQL Server", _                                        "DSN=" & JDS_DSN_name & Chr(0) & _                                        "Server=" & JDS_Server_name & Chr(0) & _                                        "Database=SvCvMarketing" & Chr(0) & _                                        "UseProcForPrepare=Yes" & Chr(0) & _                                        "Description=MDTS Database" & Chr(0) & Chr(0))                               If lngResult = False Then                       MsgBox "错误: 不能创建系统数据源DSN: " & JDS_DSN_name & "." & _                    vbCrLf & vbCrLf & _                    "请确认已安装了SQL Server的ODBC驱动程序。" & _                    vbCrLf & _                    "需要更的有关MDTS的信息，请与系统管理员联系。"                                syscmdresult = SysCmd(acSysCmdClearStatus)            Check_SDSN = -1        End If               End If             syscmdresult = SysCmd(acSysCmdClearStatus)    Check_SDSN = 0End Function
首页