seldatabas.bas

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

Attribute VB_Name = "SelDataBas"
Option Explicit

Public meObj As New SelUserGroup.SelUserGroupCls
Public Query As String
Public Const TitleStr = "用户组"

'//
Public Function getClassSql(ByVal inParentID As Long) As String
 Dim RetValue As String
 RetValue = "select a.Js_GroupID as FItemID,a.Js_GroupName as FName from Js_UserGroup a where a.Js_ParentID=" & inParentID & " and a.Js_Detail=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_GroupID as FItemID,a.Js_GroupName as FName,dbo.getGUserList(a.Js_GroupID) as FUsers,b.Js_RightName as FRName,"
 RetValue = RetValue & " FDateil=case a.Js_Detail when 0 then '组目录' when 1 then '用户组' end,"
 RetValue = RetValue & " FUseSign=case a.Js_UseSign when 0 then '禁止' when 1 then '启用' end"
 RetValue = RetValue & " from Js_UserGroup a"
 RetValue = RetValue & " inner join Js_Right b on b.Js_RightID=a.Js_RightID"
 RetValue = RetValue & " where a.Js_Detail=1 and a.Js_ParentID 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_GroupID from Js_UserGroup where Js_ParentID=" & inParentID & " and Js_Detail=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