functionbase.bas

一套企业设备管理系统源代码,所有的业务单据和流程都可以自定义,业务报表也可以通过SQL的存储过程来定义.

Attribute VB_Name = "FunctionBase"
Option Explicit

Public Sub DelTreeData()
 Dim iLoop As Long
 If TreeData.Count > 0 Then
  For iLoop = TreeData.Count To 1 Step -1
   TreeData.Remove iLoop
  Next
 End If
End Sub

'//计算本类指定的顶部数据
Public Sub getTreeData(ByVal ParentID As Long)
 Dim DaCn As New ADODB.Connection
 Dim DaRs As New ADODB.Recordset
 Dim TreeNodeInfo As ChoiceInfo.TreeInfo
 Dim Sql As String
 Call DelTreeData
 Sql = "select FItemID,FName,FParentIDStr from Ks_item where FItemClassID=" & SysPara.TreeValue & " and FParentID=" & ParentID
 DaCn.ConnectionString = BaseDllLib.getConStr
 DaCn.Open
 DaRs.CursorLocation = adUseClient
 DaRs.Open Sql, DaCn, adOpenStatic, adLockReadOnly
 If Not DaRs.EOF Then
  While Not DaRs.EOF
   Set TreeNodeInfo = New ChoiceInfo.TreeInfo
   If Not IsNull(DaRs("FItemID")) Then TreeNodeInfo.FItemID = DaRs("FItemID")
   If Not IsNull(DaRs("FName")) Then TreeNodeInfo.FName = Trim(DaRs("FName"))
   If Not IsNull(DaRs("FParentIDStr")) Then TreeNodeInfo.ParentIDStr = Trim(DaRs("FParentIDStr"))
   TreeData.Add TreeNodeInfo
   Set TreeNodeInfo = Nothing
   DaRs.MoveNext
  Wend
 End If
 DaRs.Close
 DaCn.Close
 Set DaRs = Nothing
 Set DaCn = Nothing
End Sub

'//回填列表宽度
Public Sub UpdateListWidth(ByVal WidthStr As String, ByVal ItemClassID As Long)
 Dim DaCn As New ADODB.Connection
 Dim Sql As String
 Sql = "update Ks_ItemClass set FItemWidth='" & WidthStr & "' where FITemClassID=" & BaseDllLib.getClassID
 DaCn.ConnectionString = BaseDllLib.getConStr
 DaCn.Open
 DaCn.Execute Sql
 DaCn.Close
 Set DaCn = Nothing
End Sub

Public Function getLngValue(ByVal ProName As String) As Long
 getLngValue = CLng(CallByName(ThisCls, ProName, VbGet))
End Function

Public Function getStrValue(ByVal ProName As String) As String
 getStrValue = CStr(CallByName(ThisCls, ProName, VbGet))
End Function

'//计算查询语句
Public Function getQueryPro() As String
 Dim ResSign As Long
 Dim ErrInfo As String
 Dim iLoop As Long
 Dim RetStr As String
 If QueryInfo Is Nothing Then
  Set QueryInfo = BaseDllLib.getSearchInfo(ResSign, ErrInfo, BaseDllLib.getClassID, BaseDllLib.getFormID)
  If QueryInfo.Count > 0 Then
   For iLoop = 1 To QueryInfo.Count
    Select Case Trim(QueryInfo.Item(iLoop).FSearchValue)
     Case "getFormID"
      RetStr = RetStr & "'" & SysPara.frmInfoColl.Item(1).FUpriverDataForm & "',"
     Case "getUserID"
      RetStr = RetStr & "'" & BaseDllLib.getUserID & "',"
     Case Else
      RetStr = RetStr & "'" & QueryInfo.Item(iLoop).FLastRlValue & "',"
     End Select
    Next
  End If
  If Trim(RetStr) <> "" Then RetStr = Left(RetStr, Len(RetStr) - 1)
  getQueryPro = "exec " & SysPara.frmInfoColl.Item(1).FInfoProcName & " " & RetStr
  Exit Function
 Else
  For iLoop = 1 To QueryInfo.Count
   Select Case Trim(QueryInfo.Item(iLoop).FSearchValue)
    Case "getFormID"
     RetStr = RetStr & "'" & SysPara.frmInfoColl.Item(1).FUpriverDataForm & "',"
    Case "getUserID"
     RetStr = RetStr & "'" & BaseDllLib.getUserID & "',"
    Case Else
     RetStr = RetStr & "'" & QueryInfo.Item(iLoop).FLastRlValue & "',"
   End Select
  Next
  If Trim(RetStr) <> "" Then RetStr = Left(RetStr, Len(RetStr) - 1)
  getQueryPro = "exec " & SysPara.frmInfoColl.Item(1).FInfoProcName & " " & RetStr
  Exit Function
 End If
End Function