您所在位置：主题：类模块中创建连接
wkl1973
[专家分：400] 发布于 2008-09-28 01:09:00
各位前辈
下面这段代码,在类模块中的.可以正确连接.同时我创建一个数据添加函数,每次调用AddName()函数时,就会终止连接数据库的连接.我不明白为何我在其它位置调用函数时会终止上个连接对象.
Option Explicit
Private G_DateName数据库名 As String '全局数据库名
Private G_PassWord密码名 As String '全局登陆密码
Private G_Name登陆用户名 As String '全局登陆用户名
Private G_SerVer服务器名IP地址 As String '全局服务器名称。
Private GACN As ADODB.Connection
Private Recordset As ADODB.Recordset
Private Sub Class_initialize()
'P初始化连接对象。
Set GACN = New ADODB.Connection
End Sub
Private Sub Class_terminate()
'终止事件，卸载，销毁对象。
Call CloseConnention
End Sub
Public Function CloseConnention() As Boolean
'关闭连接
On Error Resume Next
If GACN.State = adStateOpen Then
MsgBox "终止事件，卸载，销毁对象", vbExclamation, "终止程序"
GACN.Close
Set GACN = Nothing
End If
End Function
Public Function ConnectToSerVer() As Boolean
On Error GoTo ON_ERROR
'连接数据库
Dim Gmsql As String
Gmsql = "Provider=SQLOLEDB.1;Password=" & G_PassWord密码名 & " ;" & _
"Persist Security Info=True;" & _
"User ID=" & G_Name登陆用户名 & ";" & _
"Initial Catalog=" & G_DateName数据库名 & ";" & _
"Data Source=" & G_SerVer服务器名IP地址
' Debug.Print "连接时: " & G_DateName数据库名, G_PassWord密码名, G_Name登陆用户名, G_SerVer服务器名IP地址
GACN.ConnectionTimeout = 30 'ConnectionTimeout等待属性。为30秒。
GACN.Open Gmsql
ConnectToSerVer = True
Exit Function
ON_ERROR:
MsgBox "错误代码：" & Err.Number & " 错误描述:" & Err.Description, 17, "数据库连接错误"
ConnectToSerVer = False
End Function
Public Function Uname_IP_Data(ByVal 数据库名 As Variant, _
ByVal 密码名 As Variant, _
ByVal 登陆名 As Variant, _
ByVal Ip地址 As Variant) As Boolean
If 数据库名 = Empty Then
MsgBox "数据库名称", 17, "数据库名称为空"
Exit Function
Else
G_DateName数据库名 = 数据库名
End If
If 密码名 = Empty Then
MsgBox "请输入连接密码", 17, "密码为空"
Exit Function
Else
G_PassWord密码名 = 密码名
End If
If 登陆名 = Empty Then
MsgBox "数据库登陆用户名错误", 17, "用户名错误"
Exit Function
Else
G_Name登陆用户名 = 登陆名
End If
If Ip地址 = Empty Then
MsgBox "服务器地址错误", 17, "服务器地址错误"
Exit Function
Else
G_SerVer服务器名IP地址 = Ip地址
End If
' Debug.Print " 函数名: " & 数据库名, 密码名, 登陆名, Ip地址
If ConnectToSerVer() = False Then
Call CloseConnention
Uname_IP_Data = False
Else
Uname_IP_Data = True
End If
End Function
'参数;Name 是新用户的名称
'添加一个新的用户
Public Function AddName(ByVal Name As String) As Boolean
On Error GoTo NOERROR
Dim SQLstring As String
Set Recordset = New ADODB.Recordset
SQLstring = "insert into tbPassWord values ('" & Name & "')"
Set Recordset = GACN.Execute(SQLstring)
Exit Function
NOERROR:
Select Case Err.Number
Case Else
MsgBox "错误代码:" & Err.Number & " 错误描述:" & Err.Description
AddName = False
Exit Function
End Select
End Function
下面这段代码,在类模块中的.可以正确连接.同时我创建一个数据添加函数,每次调用AddName()函数时,就会终止连接数据库的连接.我不明白为何我在其它位置调用函数时会终止上个连接对象.
Option Explicit
Private G_DateName数据库名 As String '全局数据库名
Private G_PassWord密码名 As String '全局登陆密码
Private G_Name登陆用户名 As String '全局登陆用户名
Private G_SerVer服务器名IP地址 As String '全局服务器名称。
Private GACN As ADODB.Connection
Private Recordset As ADODB.Recordset
Private Sub Class_initialize()
'P初始化连接对象。
Set GACN = New ADODB.Connection
End Sub
Private Sub Class_terminate()
'终止事件，卸载，销毁对象。
Call CloseConnention
End Sub
Public Function CloseConnention() As Boolean
'关闭连接
On Error Resume Next
If GACN.State = adStateOpen Then
MsgBox "终止事件，卸载，销毁对象", vbExclamation, "终止程序"
GACN.Close
Set GACN = Nothing
End If
End Function
Public Function ConnectToSerVer() As Boolean
On Error GoTo ON_ERROR
'连接数据库
Dim Gmsql As String
Gmsql = "Provider=SQLOLEDB.1;Password=" & G_PassWord密码名 & " ;" & _
"Persist Security Info=True;" & _
"User ID=" & G_Name登陆用户名 & ";" & _
"Initial Catalog=" & G_DateName数据库名 & ";" & _
"Data Source=" & G_SerVer服务器名IP地址
' Debug.Print "连接时: " & G_DateName数据库名, G_PassWord密码名, G_Name登陆用户名, G_SerVer服务器名IP地址
GACN.ConnectionTimeout = 30 'ConnectionTimeout等待属性。为30秒。
GACN.Open Gmsql
ConnectToSerVer = True
Exit Function
ON_ERROR:
MsgBox "错误代码：" & Err.Number & " 错误描述:" & Err.Description, 17, "数据库连接错误"
ConnectToSerVer = False
End Function
Public Function Uname_IP_Data(ByVal 数据库名 As Variant, _
ByVal 密码名 As Variant, _
ByVal 登陆名 As Variant, _
ByVal Ip地址 As Variant) As Boolean
If 数据库名 = Empty Then
MsgBox "数据库名称", 17, "数据库名称为空"
Exit Function
Else
G_DateName数据库名 = 数据库名
End If
If 密码名 = Empty Then
MsgBox "请输入连接密码", 17, "密码为空"
Exit Function
Else
G_PassWord密码名 = 密码名
End If
If 登陆名 = Empty Then
MsgBox "数据库登陆用户名错误", 17, "用户名错误"
Exit Function
Else
G_Name登陆用户名 = 登陆名
End If
If Ip地址 = Empty Then
MsgBox "服务器地址错误", 17, "服务器地址错误"
Exit Function
Else
G_SerVer服务器名IP地址 = Ip地址
End If
' Debug.Print " 函数名: " & 数据库名, 密码名, 登陆名, Ip地址
If ConnectToSerVer() = False Then
Call CloseConnention
Uname_IP_Data = False
Else
Uname_IP_Data = True
End If
End Function
'参数;Name 是新用户的名称
'添加一个新的用户
Public Function AddName(ByVal Name As String) As Boolean
On Error GoTo NOERROR
Dim SQLstring As String
Set Recordset = New ADODB.Recordset
SQLstring = "insert into tbPassWord values ('" & Name & "')"
Set Recordset = GACN.Execute(SQLstring)
Exit Function
NOERROR:
Select Case Err.Number
Case Else
MsgBox "错误代码:" & Err.Number & " 错误描述:" & Err.Description
AddName = False
Exit Function
End Select
End Function