📄 seldatabas.bas
字号:
Attribute VB_Name = "SelDataBas"
Option Explicit
Public meObj As New SelRight.SelRightCls
Public Query As String
Public Const TitleStr = "权限方案"
'//
Public Function getClassSql(ByVal inParentID As Long) As String
Dim RetValue As String
RetValue = "select Js_RightID as FItemID,Js_RightName as Fname,Js_RightParentID as FParentID,Js_RightLevel as FLevel,Js_RightDetail as FDetail,Js_RightUseSign as FUseSign,Js_RightUserID as FUserID from Js_Right where Js_RightParentID=" & inParentID & " and Js_RightDetail=0"
getClassSql = RetValue
End Function
Public Function getListSql(ByVal inParentID As Long) As String
Dim RetValue As String
Dim FParentIDs As String
FParentIDs = GetNextParID(inParentID)
If Trim(FParentIDs) <> "" Then
FParentIDs = "(" & inParentID & "," & Right(FParentIDs, Len(FParentIDs) - 1) & ")"
Else
FParentIDs = "(" & inParentID & ")"
End If
RetValue = "select a.Js_RightID as FItemID,a.Js_RightName as Fname,dbo.getUserList(a.Js_RightID) as FDesc,b.Js_RightName as FPName,"
RetValue = RetValue & " FDateil=case a.Js_RightDetail when 0 then '方案目录' when 1 then '权限方案' end,"
RetValue = RetValue & " FUseSign=case a.Js_RightUseSign when 0 then '禁止' when 1 then '启用' end,"
RetValue = RetValue & " c.Js_UserName as FUName"
RetValue = RetValue & " from Js_Right a"
RetValue = RetValue & " left join Js_Right b on b.Js_RightID=a.Js_RightParentID"
RetValue = RetValue & " left join Js_User c on c.Js_UserID=a.Js_RightUserID"
RetValue = RetValue & " where a.Js_RightDetail=1 and a.Js_RightParentID in " & FParentIDs
getListSql = RetValue
End Function
Public Function GetNextParID(ByVal inParentID As Long) As String
Dim RetStrValue As String
Dim RetIntValue As Long
Dim daCn As New ADODB.Connection
Dim daRs As New ADODB.Recordset
Dim Sql As String
'//
Sql = "select Js_RightID from Js_Right where Js_RightParentID=" & inParentID & " and Js_RightDetail=0"
daCn.ConnectionString = meObj.BaseInfo.getConStr
daCn.Open
daRs.CursorLocation = adUseClient
daRs.Open Sql, daCn, adOpenStatic, adLockReadOnly
If Not daRs.EOF Then
While Not daRs.EOF
If Not IsNull(daRs(0)) Then
RetIntValue = daRs(0)
RetStrValue = RetStrValue & "," & RetIntValue
RetStrValue = RetStrValue & GetNextParID(RetIntValue)
End If
daRs.MoveNext
Wend
End If
daRs.Close
daCn.Close
Set daRs = Nothing
Set daCn = Nothing
GetNextParID = RetStrValue
End Function
Public Function getListTitle() As String
Dim RetValue As String
RetValue = "方案内码|方案名称|方案描述|上级名称|方案类型|方案状态|添加用户|"
getListTitle = RetValue
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -