如何做一个增加系统DSN的过程

from:http://topic.youkuaiyun.com/t/20030114/13/1356922.html


1楼   nik_Amis   (...)  回复于 2003-01-14 13:12:18  得分 0

SQLConfigDatasource

Top

2楼   daviddivad   (你真行，居然比我还快！ Scorpio)  回复于 2003-01-14 13:17:54  得分 30

Public   Enum   e_DSNtype
        eUserDSN   =   0         '用户数据源
        eSysDSN                   '系统数据源
End   Enum

Private   Const   ODBC_ADD_DSN   =   1
Private   Const   ODBC_CONFIG_DSN   =   2
Private   Const   ODBC_REMOVE_DSN   =   3
Private   Const   ODBC_ADD_SYS_DSN   =   4
Private   Const   ODBC_REMOVE_SYS_DSN   =   6
Private   Const   vbAPINull   As   Long   =   0&

Private   Const   SQL_SUCCESS   As   Long   =   0
Private   Const   SQL_ERROR   As   Long   =   -1
Private   Const   SQL_FETCH_NEXT   As   Long   =   1

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   SQLDataSources   Lib   "ODBC32.DLL"   (ByVal   henv   As   Long,   ByVal   fDirection   As   Integer,   ByVal   szDSN   As   String,   ByVal   cbDSNMax   As   Integer,   pcbDSN   As   Integer,   ByVal   szDescription   As   String,   ByVal   cbDescriptionMax   As   Integer,   pcbDescription   As   Integer)   As   Integer
Private   Declare   Function   SQLAllocEnv   Lib   "ODBC32.DLL"   (env   As   Long)   As   Integer


'创建数据源       成功返回TRUE，失败返回FALSE
Public   Function   fun_CreateDSN(ByVal   DSNname   As   String,   ByVal   ODBCdriver   As   String,   ByVal   DSNtype   As   e_DSNtype,   _
                                                            ByVal   SVRname   As   String,   ByVal   DBname   As   String,   ByVal   User   As   String,   _
                                                            ByVal   pwd   As   String,   ByVal   DSNdesc   As   String)   As   Boolean
'         DSNname：数据源名
'         ODBCdriver：数据源驱动
'         DSNtype：数据源类型（系统、用户）
'         SVRname：服务器名称
'         DBname：数据库名
'         User：用户名
'         PWD：密码
'         DSNdesc：数据源描述
        On   Error   Resume   Next
        Dim   nRet   As   Long
        Dim   sAttributes   As   String
        If   DSNname   <>   ""   Then   sAttributes   =   "DSN="   &   DSNname   &   Chr$(0)
        If   DSNdesc   <>   ""   Then   sAttributes   =   sAttributes   &   "DESCRIPTION="   &   DSNdesc   &   Chr$(0)
        If   SVRname   <>   ""   Then   sAttributes   =   sAttributes   &   "SERVER="   &   SVRname   &   Chr$(0)
        If   User   <>   ""   Then   sAttributes   =   sAttributes   &   "UID="   &   User   &   Chr$(0)
        If   pwd   <>   ""   Then   sAttributes   =   sAttributes   &   "PWD="   &   pwd   &   Chr$(0)
        If   InStr(1,   LCase$(ODBCdriver),   "access")   >   0   Then
                If   DBname   <>   ""   Then   sAttributes   =   sAttributes   &   "DBQ="   &   DBname   &   Chr$(0)
        ElseIf   InStr(1,   LCase$(ODBCdriver),   "sql   server")   >   0   Then
                sAttributes   =   "DSN="   &   DSNname   &   Chr$(0)   &   "Server="   &   SVRname   &   Chr$(0)   &   _
                                        "UseProcForPrepare=Yes"   &   Chr$(0)
        Else
                If   DBname   <>   ""   Then   sAttributes   =   sAttributes   &   "DATABASE="   &   DBname   &   Chr$(0)
        End   If
        If   DSNtype   =   eSysDSN   Then
                nRet   =   SQLConfigDataSource(vbAPINull,   ODBC_ADD_SYS_DSN,   ODBCdriver,   sAttributes)
        ElseIf   DSNtype   =   eUserDSN   Then
                nRet   =   SQLConfigDataSource(vbAPINull,   ODBC_ADD_DSN,   ODBCdriver,   sAttributes)
        Else
                fun_CreateDSN   =   False
                Exit   Function
        End   If
        If   nRet   =   0   Then
                fun_CreateDSN   =   False
        Else
                fun_CreateDSN   =   True
        End   If
End   Function

'删除数据源，成功返回TRUE，失败返回FALSE
Public   Function   fun_DeleteDSN(ByVal   DSNname   As   String,   ByVal   ODBCdriver   As   String,   ByVal   DSNtype   As   e_DSNtype)   As   Boolean
'         DSNname：数据源名
'         ODBCdriver：数据源驱动
'         DSNtype：数据源类型（系统、用户）
        On   Error   Resume   Next
        Dim   nRet   As   Long
        Dim   sAttributes   As   String
        sAttributes   =   sAttributes   &   "DSN="   &   DSNname   &   Chr$(0)
        If   DSNtype   =   eSysDSN   Then
                nRet   =   SQLConfigDataSource(vbAPINull,   ODBC_REMOVE_SYS_DSN,   ODBCdriver,   sAttributes)
        ElseIf   DSNtype   =   eUserDSN   Then
                nRet   =   SQLConfigDataSource(vbAPINull,   ODBC_REMOVE_DSN,   ODBCdriver,   sAttributes)
        Else
                fun_DeleteDSN   =   False
                Exit   Function
        End   If
        If   nRet   =   0   Then
                fun_DeleteDSN   =   False
        Else
                fun_DeleteDSN   =   True
        End   If
End   Function

'搜索系统中所有的DSN(ODBC)数据源和对应的驱动         0表示失败，其余数值表示返回的驱动或数据源的数量（数组从1开始）
Public   Function   fun_GetDSNsAndDrivers(ByRef   strArr_DSNs()   As   String,   ByRef   strArr_DRVs()   As   String)   As   Long
        Dim   int_Ret   As   Integer
        Dim   sDSNItem   As   String   *   1024
        Dim   sDRVItem   As   String   *   1024
        Dim   int_I   As   Integer
        Dim   sDSN   As   String
        Dim   sDRV   As   String
        Dim   iDSNLen   As   Integer
        Dim   iDRVLen   As   Integer
        Dim   lHenv   As   Long           '对环境处理
       
        On   Error   GoTo   doError
       
        ReDim   strArr_DSNs(0)   As   String
        ReDim   strArr_DRVs(0)   As   String
        If   SQLAllocEnv(lHenv)   <>   SQL_ERROR   Then
                int_I   =   0
                sDSNItem   =   Space(1024)
                sDRVItem   =   Space(1024)
                int_Ret   =   SQLDataSources(lHenv,   SQL_FETCH_NEXT,   sDSNItem,   1024,   iDSNLen,   sDRVItem,   1024,   iDRVLen)
                Do   Until   int_Ret   <>   SQL_SUCCESS
                        sDSN   =   Left$(sDSNItem,   iDSNLen)
                        sDRV   =   Left$(sDRVItem,   iDRVLen)
                        int_I   =   int_I   +   1
                        If   int_I   =   1   Then
                                ReDim   strArr_DSNs(1   To   1)   As   String
                                ReDim   strArr_DRVs(1   To   1)   As   String
                        Else
                                ReDim   Preserve   strArr_DSNs(1   To   int_I)   As   String
                                ReDim   Preserve   strArr_DRVs(1   To   int_I)   As   String
                        End   If
                        strArr_DSNs(int_I)   =   sDSN
                        strArr_DRVs(int_I)   =   sDRV
                        sDSNItem   =   Space(1024)
                        sDRVItem   =   Space(1024)
                        int_Ret   =   SQLDataSources(lHenv,   SQL_FETCH_NEXT,   sDSNItem,   1024,   iDSNLen,   sDRVItem,   1024,   iDRVLen)
                Loop
                fun_GetDSNsAndDrivers   =   int_I
        Else
                fun_GetDSNsAndDrivers   =   0
        End   If
        Exit   Function
doError:
        fun_GetDSNsAndDrivers   =   0
End   Function

Top

3楼   zmcpu   (CPU)  回复于 2003-01-14 13:33:28  得分 20

新增   DSN   的方法有二种：
1、使用   DBEngine   控件的   RegisterDatabase   方法
2、呼叫   SQLConfigDataSource   API

不管使用以上任何一种方法新增   DSN，一共会写入二个地方，一个是注册表，一个是   ODBC.INI。

而刪除   DSN   的方法同上面的第二种方法，呼叫   SQLConfigDataSource   API。

以下之模块以   Oracle73   Ver   2.5   为例，在   Form   的声明区中加入以下声明及模块：

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   SQLConfigDataSource   Lib   "ODBCCP32.DLL"   _
(ByVal   hwndParent   As   Long,   ByVal   fRequest   As   Long,   _
ByVal   lpszDriver   As   String,   ByVal   lpszAttributes   As   String)   As   Long

Public   Sub   CreateDSN(sDSN   As   String)
Dim   nRet   As   Long
Dim   sDriver   As   String
Dim   sAttributes   As   String
sDriver   =   "Oracle73   Ver   2.5"
sAttributes   =   "Server=Oracle8"   &   Chr$(0)
sAttributes   =   sAttributes   &   "DESCRIPTION="   &   sDSN   &   Chr$(0)
'sAttributes   =   sAttributes   &   "DSN="   &   sDSN   &   Chr$(0)
sAttributes   =   sAttributes   &   "DATABASE=DBFinance"   &   Chr$(0)
sAttributes   =   sAttributes   &   "Userid=Scott"   &   Chr$(0)
'sAttributes   =   sAttributes   &   "PWD=myPassword"   &   Chr$(0)
DBEngine.RegisterDatabase   sDSN,   sDriver,   True,   sAttributes   '注一
'nRet   =   SQLConfigDataSource(vbAPINull,   ODBC_ADD_DSN,   sDriver,   sAttributes)   '注二
End   Sub

Public   Sub   DeleteDSN(sDSN   As   String)
Dim   nRet   As   Long
Dim   sDriver   As   String
Dim   sAttributes   As   String
sDriver   =   "Oracle73   Ver   2.5"
sAttributes   =   sAttributes   &   "DSN="   &   sDSN   &   Chr$(0)
nRet   =   SQLConfigDataSource(vbAPINull,   ODBC_REMOVE_DSN,   sDriver,   sAttributes)
End   Sub
'假设要产生的   DSN   为   Test，实际使用示例如下：

Private   Sub   Command1_Click()
CreateDSN   "Test"
End   Sub

Private   Sub   Command2_Click()
DeleteDSN   "Test"
End   Sub
'而写到系統的数据如下：
1、ODBC.INI

[ODBC   32   bit   Data   Sources]
Test=Oracle73   Ver   2.5   (32   bit)

[Test]
Driver32=C:\ORAWIN95\ODBC250\sqo32_73.dll
2、注册表

机码：HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\ODBC   Data   Sources
名称：Test   数据：Oracle73   Ver   2.5

机码：HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\Test
名称：Description   数据：Test
名称：Driver   数据：C:\ORAWIN95\ODBC250\sqo32_73.dll
名称：Server   数据：Oracle8
名称：UserId   数据：Scott
※注一及注二可任选一种，只要將不使用的方法   Mark   起來即可！
※若您想使用其他之数据库，只要將以上模块稍作修改即可！

转载于:https://www.cnblogs.com/pcchs/archive/2006/04/05/367493.html