用ODBC吧
有两种用法
一种是用ODBC API 这种不多说
另一种用ADO然后动态创建DSN,当然效率会比第一种低,但简单
动态创建DSN的例子:
程序代码:ODBC_CONFIG_DSN = 2 ' Configure (edit) data source
Private Const ODBC_REMOVE_DSN = 3 ' Remove data source
Private Const ODBC_ADD_DSN = 4
Private Const vbAPINull As Long = 0&
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 SQLCreateDataS
' ource Lib "ODBCCP32.DLL" (ByVal hwndPare
' nt As Long, ByVal lpszDriver As String)
' Api sql
Private Declare Function GetActiveWindow Lib "user32.dll" () As Long
Private Declare Function SQLAllocEnv Lib "ODBC32.DLL" (phenv&) As Integer
Private Declare Function SQLAllocConnect Lib "ODBC32.DLL" (ByVal henv&, hDBC&) As Integer
Private Declare Function SQLCreateDataSource Lib "ODBCCP32.DLL" (ByVal hwndParent As Long, ByVal lpszDriver As String)
Private Declare Function SQLDriverConnect Lib "ODBC32.DLL" (ByVal hDBC As Long, ByVal hwnd As Long, _
ByVal szCSIn As String, ByVal cbCSIn As Long, ByVal szCSOut As String, _
ByVal cbCSMax As Long, cbCSOut As Long, ByVal f As Long) As Long
Private Declare Function SQLAllocStmt Lib "ODBC32.DLL" (ByVal hDBC As Long, HStmt As Long) As Long
****************************************************
Public Function CreateDSN(ByVal pstrServer As String, ByVal pstrDescription As String, ByVal pstrDSN As String, ByVal pstrDataBase As String) As Long
On Error Resume Next
Dim strDriver As String
Dim strAttributes As String
'set the driver to SQL Server because it
' is most common.
strDriver = "SQL Server"'set the attributes delimited by null.
'See driver documentation for a complete
'list of supported attributes.
strAttributes = "SERVER=" & pstrServer & Chr(0)
strAttributes = strAttributes & "DESCRIPTION=" & pstrDescription & Chr(0)
strAttributes = strAttributes & "DSN=" & pstrDSN & Chr(0)
strAttributes = strAttributes & "DATABASE=" & pstrDataBase & Chr(0)
' strAttributes = strAttributes & "UID=u
' serid" & Chr$(0)
' strAttributes = strAttributes & "PWD=p
' assword" & Chr$(0)
strAttributes = strAttributes & "Trusted_Connection=Yes"
'Calls API to create DSN
CreateDSN = SQLConfigDataSource(vbAPINull, ODBC_ADD_DSN, strDriver, strAttributes)
End Function
Public Sub DeleteDSN(sDSN As String)
Dim nRet As Long
Dim sDriver As String
Dim sAttributes As String
sDriver = "SQL Server"
sAttributes = sAttributes & "DSN=" & sDSN & Chr$(0)
nRet = SQLConfigDataSource(vbAPINull, ODBC_REMOVE_DSN, sDriver, sAttributes)
End Sub
Private Sub Command1_Click()
Dim lngRet As Long
Dim RetValue As Integer
RetValue = CreateDSN("Server", "DSN Server", "server", "master")
If RetValue = 0 Then
MsgBox Err.Description
Else
MsgBox "DSN Created!"
End If
End Sub
Private Sub Command2_Click()
'DeleteDSN "dsnTEst3"
Dim szConnectOut As String * 512
Dim Cadena As String
Dim Server As String
Dim stTmp As String
Dim User As String
Dim Cbout As Long
Dim lgTmp As Long
Dim henv As Long
Dim retcode As Long
' Lit le nom de l'utilisateur courant de
' l'ordinateur
stTmp = Space$(250)
lgTmp = 251
henv = 0
' Allocation de m閙oire pour un handle d
'environnement "HEnv".
If SQLAllocEnv(henv) = 0 Then
' Allocation d'un handle de connexion "H
' dbc".
If SQLAllocConnect(henv, hDBC) = 0 Then
' Etablir la connexion
' If you like you can specify a userId a
' nd Password and the database to be linke
' d the File DSN
'DATABASE=DB_CARTAS;UID=userid;PWD=passw
' ord
Cadena = "SAVEFILE=Testing_drv;DRIVER={SQL Server};FILEDSN=TEst_Drive;DSN=DB_PMR;SERVER=PMR02;Trusted_Connection=Yes"
retcode = SQLDriverConnect(hDBC, Me.hwnd, Cadena, Len(Cadena), szConnectOut, 255, Cbout, 1)
End If
End If
End Sub
Private Sub Command3_Click()
DeleteDSN "server"
MsgBox "DSN Remove!"
End Sub
[[it] 本帖最后由 三断笛 于 2008-12-10 22:32 编辑 [/it]]