Office中國(guó)論壇/Access中國(guó)論壇 › Access中國(guó)門戶舊版 ›Sql ServerOracle其它 › 查看內(nèi)容

用代碼創(chuàng)建 DSN(SQL Server ODBC)[轉(zhuǎn)帖]

1970-1-1 08:00| 發(fā)布者: A.S. Karre| 查看: 3188| 評(píng)論: 0

正文：

這里是我分發(fā)程序中的一些代碼。通常應(yīng)用程序需要通過(guò)ODBC連接SQL Server數(shù)據(jù)庫(kù)，因此要為鏈接表創(chuàng)建系統(tǒng)的DSN。該程序?qū)⒃谖窗l(fā)現(xiàn)現(xiàn)在的ODBC時(shí)創(chuàng)建一個(gè)新的系統(tǒng)的DSN。

'*********************** Code Start ***************************
'
Const JDS_DSN_name = "MDTS"             ' DSN的名字
Const JDS_Server_name = "148.154.61.15" ' 服務(wù)器名，這里給出的服務(wù)器的IP地址，
                                       ' 也可以通過(guò)域名解析給出域名

' 定義注冊(cè)表API函數(shù)
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 Long

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 RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long

Const HKEY_LOCAL_MACHINE = &H80000002

Const ERROR_SUCCESS = 0&
Const SYNCHRONIZE = &H100000
Const STANDARD_RIGHTS_READ = &H20000
Const STANDARD_RIGHTS_WRITE = &H20000
Const STANDARD_RIGHTS_EXECUTE = &H20000
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const STANDARD_RIGHTS_ALL = &H1F0000
Const KEY_QUERY_value = &H1
Const KEY_SET_value = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
               KEY_QUERY_value Or _
               KEY_ENUMERATE_SUB_KEYS Or _
               KEY_NOTIFY) And _
               (Not SYNCHRONIZE))

Const REG_DWORD = 4
Const REG_BINARY = 3
Const 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 Long

Function Check_SDSN()

' 查看我們要的系統(tǒng)數(shù)據(jù)源(DSN)是否存在。
' 如果存在，正好；否則，我們就創(chuàng)建一個(gè)。

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, "查找系統(tǒng)DSN: " & JDS_DSN_name & " …")

' 打開包含系統(tǒng)數(shù)據(jù)源(DSN)的注冊(cè)表主鍵。

lngResult = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _
                           "SOFTWARE\ODBC\ODBC.INI", _
                           0&, _
                           KEY_READ, _
                           lngKeyHandle)

If lngResult <> ERROR_SUCCESS Then
      MsgBox "錯(cuò)誤: 不能打開注冊(cè)鍵 HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBC.INI." & _
            vbCrLf & vbCrLf & _
            "請(qǐng)安裝SQL Server的ODBC驅(qū)動(dòng)程序用以調(diào)用MDTS系統(tǒng)數(shù)據(jù)源。" & _
            vbCrLf & _
            "要獲得更多的信息，請(qǐng)與管理員聯(lián)系。"
      syscmdresult = SysCmd(acSysCmdClearStatus)
      Check_SDSN = -1
End If

' 現(xiàn)在這個(gè)注冊(cè)鍵是打開的，我們?cè)谶@個(gè)查找看是否我們需要的。

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

         ' 是我們要的系統(tǒng)數(shù)據(jù)源嗎?

         If strvalue = JDS_DSN_name Then

            ' 是! 那就不需要我們?cè)僮鍪裁戳恕?BR>
            DSNfound = True
            syscmdresult = SysCmd(acSysCmdClearStatus)

         End If

      End If

Loop While lngResult = ERROR_SUCCESS And Not DSNfound

Call RegCloseKey(lngKeyHandle)

If Not DSNfound Then

      ' 我們所需的系統(tǒng)數(shù)據(jù)源不存在，因此，我們?cè)囍鴦?chuàng)建一個(gè)。

      Syscmdresult = SysCmd(acSysCmdSetStatus, "創(chuàng)建系統(tǒng)數(shù)據(jù)源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 "錯(cuò)誤: 不能創(chuàng)建系統(tǒng)數(shù)據(jù)源DSN: " & JDS_DSN_name & "." & _
                  vbCrLf & vbCrLf & _
                  "請(qǐng)確認(rèn)已安裝了SQL Server的ODBC驅(qū)動(dòng)程序。" & _
                  vbCrLf & _
                  "需要更的有關(guān)MDTS的信息，請(qǐng)與系統(tǒng)管理員聯(lián)系。"

         syscmdresult = SysCmd(acSysCmdClearStatus)
         Check_SDSN = -1

      End If

End If

syscmdresult = SysCmd(acSysCmdClearStatus)
Check_SDSN = 0

End Function

收藏分享邀請(qǐng)

帳號(hào)		自動(dòng)登錄	找回密碼
密碼			注冊(cè)

用代碼創(chuàng)建 DSN(SQL Server ODBC)[轉(zhuǎn)帖]

最新評(píng)論

相關(guān)分類