mdldb.bas

利用ＶＢ和ＡＣＥＳＳ联合制作的一个人事和物品管理系统

Attribute VB_Name = "mdlDB"
Option Explicit



Public g_Conn As Connection '用于全局的数据连接
Public g_DBPath As String   '如果是Access数据库，记录下数据库的路径

'ActiveX DLL的启动程序，为DLL初始化时执行
Public Sub DBMain()
  g_DBPath = App.Path & "\DB\I_DB.mdb"
  
  If ConnectToDatabase(DBAccess) = False Then
    Err.Raise vbObjectError + 1, , "连接数据库出错！"
  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 = "JF"
  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
  
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 ExistByNameExceptID(ByVal strTable As String, _
    ByVal strFieldId As String, ByVal strId As String, _
    ByVal strFieldName As String, ByVal strName As String) As Boolean
  '第一个参数为表名，第二个为字段名，第三个为具体的字段值
  Dim rs As Recordset
  Dim strSQL As String
  strSQL = " SELECT COUNT(*) FROM " & strTable
  strSQL = strSQL & " WHERE "
  strSQL = strSQL & strFieldId & "<>" & strId & " AND "
  strSQL = strSQL & strFieldName & "='" & strName & "'"
  
  Set rs = g_Conn.Execute(strSQL)
  ExistByNameExceptID = (rs(0).Value > 0)
  
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

Public Function CheckPath(ByVal sPath As String) As String
If Right$(sPath, 1) = "\" Then
  CheckPath = sPath
Else
  CheckPath = sPath & "\"
End If
End Function
Public Function GetTypeName(ByVal obj As clsImage) As String
  Dim rs As Recordset

  
  '按输入的参数查询,并返回一个集合类
  Dim strSQL As String
   I_TypeID = obj.TypeID
  
  strSQL = "select * from IImage,IType where "
  strSQL = strSQL & "I_TypeID=IT_ID"
  
 
  '清空当前集合

  Set rs = g_Conn.Execute(strSQL)
 
  
                
   
   
  
   GetTypeName = Trim(rs.Fields("IT_Name").Value)


End Function