right.cls

本系统是一个报表分析查询系统

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Right"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

'//本类属性
Public Js_RightID As Long
Public Js_RightParentID As Long
Public Js_RightNumber As String
Public Js_RightName As String
Public Js_RightDesc As String
Public Js_RightLevel As Long
Public Js_RightDetail As Long
Public Js_RightUseSign As Long
Public Js_RightUserID As Long
Public Js_RightDate As String
Public Js_RightTime As String

'//本类方案

'//保存用户 成功返回：True 失败返回False
Public Function Save(ByRef MsgInfo As String) As Boolean
 '//On Error GoTo ErrHandle
 Dim BaseObj As New StdRptBase.StdRptBaseCls
 Dim DaCn As New ADODB.Connection
 Dim Sql As String
 DaCn.ConnectionString = BaseObj.getConStr
 DaCn.Open
 DaCn.BeginTrans
 Sql = "delete from Js_Right where Js_RightID=" & Js_RightID
 DaCn.Execute Sql
 Sql = "exec NewRight "
 Sql = Sql & Js_RightID & ","
 Sql = Sql & Js_RightParentID & ","
 Sql = Sql & "'" & Js_RightNumber & "',"
 Sql = Sql & "'" & Js_RightName & "',"
 Sql = Sql & "'" & Js_RightDesc & "',"
 Sql = Sql & Js_RightLevel & ","
 Sql = Sql & Js_RightDetail & ","
 Sql = Sql & Js_RightUseSign & ","
 Sql = Sql & Js_RightUserID & ","
 Sql = Sql & "'" & Js_RightDate & "',"
 Sql = Sql & "'" & Js_RightTime & "'"
 DaCn.Execute Sql
 Sql = "update Js_Right set Js_RightDetail=0 where Js_RightID=" & Js_RightParentID
 DaCn.Execute Sql
 DaCn.CommitTrans
 DaCn.Close
 Set DaCn = Nothing
 Set BaseObj = Nothing
 MsgInfo = "保存权限方案成功"
 Save = True
 Exit Function
ErrHandle:
 MsgInfo = "保存权限方案成功，错误：" & Err.Description
 If DaCn.State = adStateOpen Then DaCn.Close
 Set DaCn = Nothing
 Set BaseObj = Nothing
 Save = False
End Function

'//装载用户信息 成功返回True 失败返回False
Public Function Load(ByVal lgRightID As Long, ByRef MsgInfo As String) As Boolean
 On Error GoTo ErrHandle
 Dim BaseObj As New StdRptBase.StdRptBaseCls
 Dim DaCn As New ADODB.Connection
 Dim DaRs As New ADODB.Recordset
 Dim Sql As String
 Sql = "select Js_RightID,Js_RightParentID,Js_RightNumber,Js_RightName,Js_RightDesc,Js_RightLevel,Js_RightDetail,Js_RightUseSign,Js_RightUserID,Js_RightDate,Js_RightTime from Js_Right where Js_RightID=" & lgRightID
 DaCn.ConnectionString = BaseObj.getConStr
 DaCn.Open
 DaRs.CursorLocation = adUseClient
 DaRs.Open Sql, DaCn, adOpenStatic, adLockReadOnly
 If Not DaRs.EOF Then
  If Not IsNull(DaRs("Js_RightID")) Then Js_RightID = DaRs("Js_RightID")
  If Not IsNull(DaRs("Js_RightParentID")) Then Js_RightParentID = DaRs("Js_RightParentID")
  If Not IsNull(DaRs("Js_RightNumber")) Then Js_RightNumber = Trim(DaRs("Js_RightNumber"))
  If Not IsNull(DaRs("Js_RightName")) Then Js_RightName = Trim(DaRs("Js_RightName"))
  If Not IsNull(DaRs("Js_RightDesc")) Then Js_RightDesc = Trim(DaRs("Js_RightDesc"))
  If Not IsNull(DaRs("Js_RightLevel")) Then Js_RightLevel = DaRs("Js_RightLevel")
  If Not IsNull(DaRs("Js_RightDetail")) Then Js_RightDetail = DaRs("Js_RightDetail")
  If Not IsNull(DaRs("Js_RightUseSign")) Then Js_RightUseSign = DaRs("Js_RightUseSign")
  If Not IsNull(DaRs("Js_RightUseSign")) Then Js_RightUseSign = DaRs("Js_RightUseSign")
  If Not IsNull(DaRs("Js_RightUserID")) Then Js_RightUserID = DaRs("Js_RightUserID")
  If Not IsNull(DaRs("Js_RightDate")) Then Js_RightDate = Trim(DaRs("Js_RightDate"))
  If Not IsNull(DaRs("Js_RightTime")) Then Js_RightTime = Trim(DaRs("Js_RightTime"))
 Else
  MsgInfo = "错误的权限方案"
  DaRs.Close
  DaCn.Close
  Set DaRs = Nothing
  Set DaCn = Nothing
  Set BaseObj = Nothing
  Load = False
  Exit Function
 End If
 DaRs.Close
 DaCn.Close
 Set DaRs = Nothing
 Set DaCn = Nothing
 Set BaseObj = Nothing
 MsgInfo = "装载数据成功"
 Load = True
 Exit Function
ErrHandle:
 MsgInfo = "装载权限方案，错误：" & Err.Description
 If DaRs.State = adStateOpen Then DaRs.Close
 If DaCn.State = adStateOpen Then DaCn.Close
 Set DaRs = Nothing
 Set DaCn = Nothing
 Set BaseObj = Nothing
 Load = False
End Function

'//删除用户
Public Function Del(ByVal lgRightID As Long, ByRef MsgInfo As String) As Boolean
 On Error GoTo ErrHandle
 Dim DelSign As Long
 Dim BaseObj As New StdRptBase.StdRptBaseCls
 Dim DaCn As New ADODB.Connection
 Dim Sql As String
 '//
 If Load(lgRightID, MsgInfo) = False Then
  Del = False
  Exit Function
 End If
 '//
 If getRightCount(lgRightID) > 0 Then
  MsgInfo = "本方案已经被使用，拒绝删除"
  Del = False
  Exit Function
 End If
 '//
 DelSign = MsgBox("删除[" & Js_RightName & "]？", vbQuestion + vbYesNo + vbDefaultButton2, BaseObj.getMsgInfo)
 If DelSign <> 6 Then
  Set DaCn = Nothing
  Set BaseObj = Nothing
  MsgInfo = "用户取消删除操作"
  Del = False
  Exit Function
 End If
 '//
 Sql = "delete from Js_Right where Js_RightID=" & lgRightID
 DaCn.ConnectionString = BaseObj.getConStr
 DaCn.Open
 DaCn.Execute Sql
 DaCn.Close
 Set DaCn = Nothing
 Set BaseObj = Nothing
 MsgInfo = "删除[" & Js_RightName & "]成功"
 Del = True
 Exit Function
ErrHandle:
 If DaCn.State = adStateOpen Then DaCn.Close
 Set DaCn = Nothing
 Set BaseObj = Nothing
 MsgInfo = "删除权限方案，错误：" & Err.Description
 Del = False
End Function

'//计算指定的用户下面属于多少个用户组
Public Function getRightCount(ByVal lgRightID As Long) As Long
 On Error GoTo ErrHandle
 Dim BaseObj As New StdRptBase.StdRptBaseCls
 Dim DaCn As New ADODB.Connection
 Dim DaRs As New ADODB.Recordset
 Dim Sql As String
 Dim RetValue As Long
 RetValue = 0
 Sql = "select count(*) as RightCount from Js_User where Js_RightID= " & lgRightID
 DaCn.ConnectionString = BaseObj.getConStr
 DaCn.Open
 DaRs.Open Sql, DaCn, adOpenStatic, adLockReadOnly
 If Not DaRs.EOF And Not IsNull(DaRs("RightCount")) Then
  RetValue = DaRs("RightCount")
 End If
 DaRs.Close
 '//
 Sql = "select count(*) as RightCount from Js_UserGroup where Js_RightID= " & lgRightID
 DaCn.ConnectionString = BaseObj.getConStr
 DaCn.Open
 DaRs.Open Sql, DaCn, adOpenStatic, adLockReadOnly
 If Not DaRs.EOF And Not IsNull(DaRs("RightCount")) Then
  RetValue = RetValue + DaRs("RightCount")
 End If
 DaRs.Close
 '//
 Sql = "select count(*) as RightCount from Js_FieldControl where Js_RightID=" & lgRightID
 DaCn.ConnectionString = BaseObj.getConStr
 DaCn.Open
 DaRs.Open Sql, DaCn, adOpenStatic, adLockReadOnly
 If Not DaRs.EOF And Not IsNull(DaRs("RightCount")) Then
  RetValue = RetValue + DaRs("RightCount")
 End If
 DaRs.Close
 '//
 Sql = "select count(*) as RightCount from Js_Rpt where Js_RightID=" & lgRightID
 DaCn.ConnectionString = BaseObj.getConStr
 DaCn.Open
 DaRs.Open Sql, DaCn, adOpenStatic, adLockReadOnly
 If Not DaRs.EOF And Not IsNull(DaRs("RightCount")) Then
  RetValue = RetValue + DaRs("RightCount")
 End If
 DaRs.Close
 DaCn.Close
 Set DaRs = Nothing
 Set DaCn = Nothing
 getRightCount = RetValue
 Exit Function
ErrHandle:
 If DaRs.State = adStateOpen Then DaRs.Close
 If DaCn.State = adStateOpen Then DaCn.Close
 Set DaRs = Nothing
 Set DaCn = Nothing
 Set BaseObj = Nothing
 getRightCount = 0
End Function

'//统计当前用户组的数量
Public Function getSum() As Long
 On Error GoTo ErrHandle
 Dim BaseObj As New StdRptBase.StdRptBaseCls
 Dim DaCn As New ADODB.Connection
 Dim DaRs As New ADODB.Recordset
 Dim Sql As String
 Dim RetValue As Long
 Sql = "select count(*) as UserSum from Js_Right"
 DaCn.ConnectionString = BaseObj.getConStr
 DaCn.Open
 DaRs.Open Sql, DaCn, adOpenStatic, adLockReadOnly
 If Not DaRs.EOF And Not IsNull(DaRs("UserSum")) Then
  RetValue = DaRs("UserSum")
 End If
 DaRs.Close
 DaCn.Close
 Set DaRs = Nothing
 Set DaCn = Nothing
 getSum = RetValue
 Exit Function
ErrHandle:
 If DaRs.State = adStateOpen Then DaRs.Close
 If DaCn.State = adStateOpen Then DaCn.Close
 Set DaRs = Nothing
 Set DaCn = Nothing
 Set BaseObj = Nothing
 getSum = 0
End Function