seldatabas.bas

来自「本系统是一个报表分析查询系统」· BAS 代码 · 共 69 行

BAS
69
字号
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 + =
减小字号Ctrl + -
显示快捷键?