⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 seldatabas.bas

📁 本系统是一个报表分析查询系统
💻 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 + -