clsworkflowmanager.cls

欢迎您使用审批系统!该系统主要面向银行内部人员,但也为客户提供一些信息." 登陆,注册和管理员入口"项目专为银行内部人员设计."客户登陆,注册,贷款须知和预约"项目专为客户设计.客户可通过这些窗口浏览

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsWorkflowManager"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

Const ERROR_SOURCE = "clsWorkflowManager"

Implements ObjectControl

Private m_objContext As ObjectContext

Private Sub ObjectControl_Activate()
    ' Get a reference to the object's context here,
    ' so it can be used by any method that may be
    ' called during this activation of the object.
    Set m_objContext = GetObjectContext()
End Sub
Private Function ObjectControl_CanBePooled() As Boolean
    ' This object should not be recycled,
    ' so return false.
    ObjectControl_CanBePooled = False
End Function
Private Sub ObjectControl_Deactivate()
    ' Perform any necessary cleanup here.
    Set m_objContext = Nothing
End Sub

Public Function executeWorkflow(ProcedureXML As String) As String

  Dim oStepManager As clsStepManager
  Set oStepManager = New clsStepManager
  
  executeWorkflow = oStepManager.processStep(ProcedureXML)

End Function

Public Function getWorkflowItem(sUID As String, sPWD As String, sWFID As String, sProcID As String) As String

  Dim conWF As ADODB.Connection
  Dim rsProcedure As ADODB.Recordset
  Dim rsResponse As ADODB.Recordset
  Dim rsAttachment As ADODB.Recordset
  Dim sSQL As String
  Dim sResponseXML As String
  Dim sProcedureXML As String
  
  Set conWF = New ADODB.Connection
  
  With conWF
    .ConnectionTimeout = 10
    .ConnectionString = "DSN=workflow"
    .Open
  End With
          
        
 sSQL = "SELECT Response.*, Procedure_Process.ProcedureProcessID " & _
        "FROM ([Procedure1] INNER JOIN Procedure_Process ON " & _
        "Procedure1.ProcedureID = Procedure_Process.ProcedureID) " & _
        "INNER JOIN Response ON Procedure1.ProcedureID = Response.ProcedureID " & _
        "WHERE (((Procedure_Process.ProcedureProcessID)=" & sProcID & "))"
         
         
  Set rsResponse = New ADODB.Recordset
  rsResponse.Open sSQL, conWF, adOpenForwardOnly, adLockReadOnly
  
  While Not rsResponse.EOF
    sResponseXML = sResponseXML & _
                 "<Response>" & _
                 "<ResponseID>" & rsResponse("ResponseID") & "</ResponseID>" & _
                 "<ResponseText>" & rsResponse("ResponseText") & "</ResponseText>" & _
                 "</Response>"
    rsResponse.MoveNext
  Wend
  
  rsResponse.Close
  Set rsResponse = Nothing
  '这里也需要加入Workflow_Process表
  sSQL = "SELECT Procedure1.*, Procedure_Process.*, User.*,Workflow_Process.workflowID " & _
         "FROM ((Role INNER JOIN ([Procedure1] INNER JOIN Procedure_Process ON " & _
         "Procedure1.ProcedureID = Procedure_Process.ProcedureID) ON " & _
         "Role.RoleID = Procedure1.RoleID) INNER JOIN [User] ON Role.RoleID = User.RoleID) INNER JOIN Workflow_Process " & _
         "ON Procedure_Process.WorkflowProcessID=Workflow_Process.WorkflowProcessID " & _
         "WHERE (((Procedure_Process.ProcedureProcessID)=" & sProcID & "))"

  Set rsProcedure = New ADODB.Recordset
  rsProcedure.Open sSQL, conWF, adOpenForwardOnly, adLockReadOnly
  
  
    sProcedureXML = sProcedureXML & _
                    "<Procedure ID='" & rsProcedure("ProcedureProcessID") & "' WFID='" & rsProcedure("WorkflowID") & _
                    "' Name='" & rsProcedure("Name") & "'>" & _
                    "<Description>" & rsProcedure("Description") & "</Description>" & _
                    "<Status>" & rsProcedure("Status") & "</Status>" & _
                    "<Type>" & rsProcedure("Type") & "</Type>" & _
                    "<User>" & _
                    "<FullName>" & rsProcedure("FullName") & "</FullName>" & _
                    "<UserName>" & rsProcedure("UserName") & "</UserName>" & _
                    "<Password>" & rsProcedure("Password") & "</Password>" & _
                    "</User>" & _
                    "<ResponsePool>" & sResponseXML & "</ResponsePool>" & _
                    "<UserResponse>" & _
                    "<ResponseID></ResponseID>" & _
                    "<ResponseText></ResponseText>" & _
                    "</UserResponse>" & _
                    "<StartDate>" & rsProcedure("StartDate") & "</StartDate>" & _
                    "<CompleteDate></CompleteDate>" & _
                    "<Priority>" & rsProcedure("Priority") & "</Priority>" & _
                    "<ExpirationDate>" & rsProcedure("CompleteDate") & "</ExpirationDate>" & _
                    "<Message>" & _
                    "<MessageID></MessageID>" & "<MessageBody>Please Select a Response</MessageBody>" & _
                    "</Message>" & _
                    "<Attachment> </Attachment>" & _
                    "</Procedure>"

  
  rsProcedure.Close
  conWF.Close
  
  getWorkflowItem = sProcedureXML
  
  Set rsProcedure = Nothing
  Set conWF = Nothing
  
  Exit Function
Error_Handler:

  m_objContext.SetAbort
  Err.Raise vbObjectError, ERROR_SOURCE, Err.Description
  Exit Function

End Function


Public Function getWorkflowList(sUID As String, sPWD As String) As String

On Error GoTo Error_Handler:

  Dim conWF As ADODB.Connection
  Dim rsProcedure As ADODB.Recordset
  Dim sSQL As String
  Dim sProcedureXML As String
  
  Set conWF = New ADODB.Connection
  
  With conWF
    .ConnectionTimeout = 10
    .ConnectionString = "DSN=workflow"
    .Open
  End With
  
'这里加入了Workflow_Process表
sSQL = "SELECT Procedure_Process.*, Procedure1.*, User.* ,[Workflow_Process].[WorkflowID]" & _
       "FROM ((Role INNER JOIN [User] ON [Role].[RoleID] = [User].[RoleID]) " & _
       "INNER JOIN ([Procedure1] INNER JOIN Procedure_Process ON " & _
       "[Procedure1].[ProcedureID] = [Procedure_Process].[ProcedureID]) ON " & _
       "[Role].[RoleID] = [Procedure1].[RoleID]) INNER JOIN Workflow_Process  " & _
       "ON [Procedure_Process].[WorkflowProcessID]=[Workflow_Process].[WorkflowProcessID] " & _
       "WHERE ((([User].[UserName])='" & sUID & "') AND [Procedure_Process].[CompleteDate] Is Null)"


  Set rsProcedure = New ADODB.Recordset
  rsProcedure.Open sSQL, conWF, adOpenForwardOnly, adLockReadOnly
  
  sProcedureXML = "<ProcedureList>"
  
  While Not rsProcedure.EOF
  
    sProcedureXML = sProcedureXML & _
                    "<Procedure ID='" & CStr(rsProcedure("ProcedureProcessID")) & "' WFID='" & rsProcedure("WorkflowID") & _
                    "' Name='" & rsProcedure("Name") & "'>" & _
                    "<Description>" & rsProcedure("Description") & "</Description>" & _
                    "<Status>" & rsProcedure("Status") & "</Status>" & _
                    "<Type>" & rsProcedure("Type") & "</Type>" & _
                    "<User>" & _
                    "<FullName>" & rsProcedure("FullName") & "</FullName>" & _
                    "<UserName>" & rsProcedure("UserName") & "</UserName>" & _
                    "<Password>" & rsProcedure("Password") & "</Password>" & _
                    "</User>" & _
                    "<ResponsePool>" & _
                    "</ResponsePool>" & _
                    "<UserResponse>" & _
                    "</UserResponse>" & _
                    "<StartDate>" & Format$(Now, "mm-dd-yyyy") & "</StartDate>" & _
                    "<CompleteDate></CompleteDate>" & _
                    "<Priority>" & rsProcedure("Priority") & "</Priority>" & _
                    "<ExpirationDate/>" & _
                    "<Message/>" & _
                    "<Attachment/>" & _
                    "</Procedure>"
    rsProcedure.MoveNext
    
  Wend
  
  sProcedureXML = sProcedureXML & "</ProcedureList>"
  
  rsProcedure.Close
  conWF.Close
  
  getWorkflowList = sProcedureXML
  
  Set rsProcedure = Nothing
  Set conWF = Nothing
  
  Exit Function
Error_Handler:

  m_objContext.SetAbort
  Err.Raise vbObjectError, ERROR_SOURCE, Err.Description
  Exit Function

End Function