📄 mdlpublic.bas
字号:
Attribute VB_Name = "mdlPublic"
Option Explicit
Public g_Conn As Connection '用于全局的数据连接
Public g_DBPath As String '如果是Access数据库,记录下数据库的路径
'ActiveX DLL的启动程序,为DLL初始化时执行
Public Sub Main()
g_DBPath = App.Path & "\Database\ManageClient.mdb"
'MsgBox g_DBPath
If ConnectToDatabase(DBAccess) = False Then
Err.Raise vbObjectError + 1, , "连接数据库出错!|" + App.Path + "|"
End If
End Sub
'连接到数据库
Public Function ConnectToDatabase(DBType As gxcDBType) As Boolean
On Error GoTo ERR_CONN
Set g_Conn = New Connection
'设置服务器名称,数据库名称,登录名(此时假设密码为空)
Dim ServerName As String, DBName As String, UserName As String, strPwd As String
'这些是为连接Sql Server而用
ServerName = "localhost"
DBName = "ManageClient"
UserName = "sa"
strPwd = ""
'连接到数据库
With g_Conn
.CursorLocation = adUseClient
.CommandTimeout = 10
If DBType = DBAccess Then
' 连接到ACCESS数据库
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Password='';" & _
"Data Source=" & g_DBPath
Else
' 连接到SQL Server数据库
.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=True;" & _
"User ID=" & UserName & ";Initial Catalog=" & DBName & _
";Data Source=" & ServerName & ";pwd=" & strPwd
End If
.Open
End With
ConnectToDatabase = True
Exit Function
ERR_CONN:
ConnectToDatabase = False
MsgBox Err.Description
End Function
'替换字符串中的单引号
Public Function RealString(strOrigional) As String
RealString = Replace(strOrigional, "'", "''")
End Function
'得到某个数据表中主键的下一个值,即当前主键值加1
Public Function NextID(ByVal strTable As String, ByVal strID As String) As Long
'两个参数分别是表的名称与主键的名称
Dim rs As Recordset
Set rs = g_Conn.Execute("SELECT MAX(" & strID & ") FROM " & strTable)
If IsNull(rs(0)) Then
'如果值为NULL,则说明无任何数据记录,此时ID应为1
NextID = 1
Else
'使新ID为最大ID值+1
NextID = rs(0).Value + 1
End If
End Function
'得到某个数据表中主键的最大值
Public Function MaxID(ByVal strTable As String, ByVal strID As String) As Long
'两个参数分别是表的名称与主键的名称
Dim rs As Recordset
Set rs = g_Conn.Execute("SELECT MAX(" & strID & ") FROM " & strTable)
If IsNull(rs(0)) Then
'如果值为NULL,则说明无任何数据记录,此时ID应为1
MaxID = 0
Else
'使新ID为最大ID值+1
MaxID = rs(0).Value
End If
End Function
'查看某个数据表中,是否存在某个字段等于某个值的记录(整型)
Public Function ExistByID(ByVal strTable As String, ByVal strID As String, _
ByVal lngID As Long) As Boolean
'第一个参数为表名,第二个为字段名,第三个为具体的字段值
Dim rs As Recordset
Set rs = g_Conn.Execute("Select Count(*) from " & strTable & _
" where " & strID & "=" & lngID)
ExistByID = (rs(0).Value = 1)
End Function
'查看某个数据表中,是否存在某个字段等于某个值的记录(字符型)
Public Function ExistByName(ByVal strTable As String, ByVal strFieldName As String, ByVal strName As String) As Boolean
'第一个参数为表名,第二个为字段名,第三个为具体的字段值
Dim rs As Recordset
Set rs = g_Conn.Execute("Select Count(*) from " & strTable & " where " & strFieldName & "='" & strName & "'")
ExistByName = (rs(0).Value = 1)
End Function
'以上两个函数实际上可以合并,本程序中为了说明问题,故而分开
'根据给定的主键值,获取某一指定的字段值
Public Function GetValueByID(ByVal strTable As String, ByVal strID As String, _
ByVal lngID As Long, ByVal strValueField As String) As String
'第一个参数为表名,第二个为主键字段名,第三个为主键字段值,第四个为要获取值的字段名
Dim rs As Recordset
Set rs = g_Conn.Execute("Select " & strValueField & " from " & strTable & _
" where " & strID & "=" & lngID)
If rs.RecordCount = 1 Then
GetValueByID = rs(0).Value
Else
GetValueByID = ""
End If
Set rs = Nothing
End Function
'//
'// 执行一条无返回结果的 SQL 语句
'//
Public Function RunSql(strSQL As String, ByRef strErrMsg As String) As Boolean
On Error Resume Next
g_Conn.Execute strSQL '执行SQL语句
'根据是否出错,返回给调用者相应的信息
If Err.Number = 0 Then
RunSql = True
Else
strErrMsg = Err.Description
RunSql = False
End If
End Function
'//
'// 执行一条有返回结果的 SQL 语句
'//
Public Function GetRecordset(strSQL As String, ByRef strErrMsg As String, ByRef rs As Recordset) As Boolean
On Error Resume Next
Set rs = g_Conn.Execute(strSQL) '执行SQL语句
'根据是否出错,返回给调用者相应的信息
If Err.Number = 0 Then
GetRecordset = True
Else
strErrMsg = Err.Description
GetRecordset = False
End If
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -