clsresponseprocedure.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 = "clsResponseProcedure"
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

Implements IProcedureItem

Private m_sProcedureID As String
Private m_sProcedureProcessID As String
Private m_sWorkflowID As String
Private m_sResponse As String
Private m_dtStartDate As Date
Private m_dtCompleteDate As Date
Private m_sStepType As String

Private Property Let IProcedureItem_CompleteDate(ByVal vData As String)
    m_dtCompleteDate = vData
End Property

Private Property Get IProcedureItem_CompleteDate() As String
  IProcedureItem_CompleteDate = m_dtCompleteDate
End Property

Private Function IProcedureItem_getNextProcedure() As IProcedureItem

On Error GoTo Error_Handler

  Dim conWF As ADODB.Connection
  Dim rsProcedure As ADODB.Recordset
  Dim rsWorkflow As ADODB.Recordset
  Dim rsWork_Pro As ADODB.Recordset
  
  Dim sSQL As String
  Dim sNextProc As String
  
  Dim oItem As IProcedureItem
  
  Set conWF = New ADODB.Connection
  
  With conWF
    .ConnectionTimeout = 10
    .ConnectionString = "DSN=workflow"
    .Open
  End With
   If m_sResponse = "Reject" Then
     
      sSQL = "UPDATE workflow SET " & _
         "Status= '" & "cancelled" & "', " & _
          " ExpirationDate = '" & Format$(Now, "mm-dd-yyyy") & "'" & _
          " WHERE Workflow.WorkflowID = " & m_sWorkflowID & " "
   
      Set rsWorkflow = New ADODB.Recordset
      rsWorkflow.Open sSQL, conWF, adOpenForwardOnly, adLockReadOnly
  
      Set rsWorkflow = Nothing
 
      sSQL = "UPDATE workflow_process SET " & _
         "Status= '" & "cancelled" & "', " & _
          " CompleteDate = '" & Format$(Now, "mm-dd-yyyy") & "'" & _
          " WHERE Workflow_Process.WorkflowID = " & m_sWorkflowID & " "
      Set rsWork_Pro = New ADODB.Recordset
   
      rsWork_Pro.Open sSQL, conWF, adOpenForwardOnly, adLockReadOnly
      Set conWF = Nothing
      Set IProcedureItem_getNextProcedure = Nothing
   Else
      sSQL = "SELECT Procedure_Process.*, Procedure1.* " & _
         "FROM [Procedure1] INNER JOIN Procedure_Process ON " & _
         " Procedure1.ProcedureID = Procedure_Process.ProcedureID" & _
         " Where ProcedureProcessID = " & m_sProcedureProcessID
         
     Set rsProcedure = New ADODB.Recordset
  
     rsProcedure.Open sSQL, conWF, adOpenForwardOnly, adLockReadOnly
  
     sNextProc = rsProcedure("NextProcedureID")
  
     rsProcedure.Close
  
     sSQL = "SELECT Procedure1.* " & _
         "FROM [Procedure1] " & _
         " Where [Procedure1].ProcedureID = " & sNextProc
         
     Set rsProcedure = New ADODB.Recordset
  
    rsProcedure.Open sSQL, conWF, adOpenForwardOnly, adLockReadOnly
  
    If Not rsProcedure.EOF Then
      Select Case rsProcedure("Type")
        Case "Response"
        Set oItem = New clsResponseProcedure
      Case "Start"
        Set oItem = New clsStartProcedure
      Case "Stop"
        Set oItem = New clsStopProcedure
      Case "FYI"
        Set oItem = New clsFYIProcedure
     End Select
  '在返回对象之前，已经调用相应的属性方法，实现对其私有变量的负值
     oItem.WorkflowID = m_sWorkflowID
     oItem.Response = ""
     oItem.StartDate = Format$(Date, "mm-dd-yyyy")
     oItem.StepType = rsProcedure("Type")
     oItem.ProcedureID = rsProcedure("ProcedureID")
    
   End If
  
   Set rsProcedure = Nothing
  
   Set IProcedureItem_getNextProcedure = oItem
  
End If
Exit Function
Error_Handler:

  IProcedureItem_getNextProcedure = Nothing
  
  Set rsProcedure = Nothing
  Set conWF = Nothing

End Function

Private Function IProcedureItem_IsProcedureComplete() As Boolean

  Dim bResponse As Boolean

  If m_sResponse <> "" Then
    bResponse = True
  Else
    bResponse = False
  End If
  
  IProcedureItem_IsProcedureComplete = bResponse

End Function

Private Property Let IProcedureItem_NextProcedureID(ByVal RHS As String)

End Property

Private Property Get IProcedureItem_NextProcedureID() As String

End Property

Private Sub IProcedureItem_Populate(domProcedure As MSXML.IXMLDOMDocument)

  m_sProcedureProcessID = domProcedure.documentElement.Attributes.getNamedItem("ID").Text
  m_sWorkflowID = domProcedure.documentElement.Attributes.getNamedItem("WFID").Text
  m_sResponse = domProcedure.documentElement.selectSingleNode("UserResponse").childNodes.Item(1).Text
  
  If domProcedure.documentElement.selectSingleNode("StartDate").Text <> "" Then
    m_dtStartDate = domProcedure.documentElement.selectSingleNode("StartDate").Text
  End If
  
  If domProcedure.documentElement.selectSingleNode("CompleteDate").Text <> "" Then
    m_dtCompleteDate = domProcedure.documentElement.selectSingleNode("CompleteDate").Text
  End If
  
  m_sStepType = domProcedure.documentElement.selectSingleNode("Type").Text
  
End Sub

Private Property Let IProcedureItem_ProcedureID(ByVal vData As String)
    m_sProcedureID = vData
End Property

Private Property Get IProcedureItem_ProcedureID() As String
  IProcedureItem_ProcedureID = m_sProcedureID
End Property

Private Property Get IProcedureItem_ProcedureProcess() As String
  IProcedureItem_ProcedureProcess = m_sProcedureProcessID
End Property

Private Property Let IProcedureItem_ProcedureProcessID(ByVal vData As String)
  m_sProcedureProcessID = vData
End Property

Private Function IProcedureItem_procedureStart() As Boolean

On Error GoTo Error_Handler
  
  Dim conWF As ADODB.Connection
  Dim rsProcedure As ADODB.Recordset
  Dim rsUser As ADODB.Recordset
  Dim sSQL As String
  Dim sUserName As String
  
  Set conWF = New ADODB.Connection
  
  With conWF
    .ConnectionTimeout = 10
    .ConnectionString = "DSN=workflow"
    .Open
  End With
          
  sSQL = "SELECT User.UserName, Procedure1.ProcedureID " & _
         "FROM (Role INNER JOIN [Procedure1] ON Role.RoleID = Procedure1.RoleID) " & _
         "INNER JOIN [User] ON Role.RoleID = User.RoleID " & _
         "WHERE (((Procedure1.ProcedureID)=" & m_sProcedureID & "))"
        
  Set rsUser = New ADODB.Recordset
  rsUser.Open sSQL, conWF, adOpenForwardOnly, adLockReadOnly
        
  If Not rsUser.EOF Then
    sUserName = rsUser("UserName")
  End If
         
  Set rsUser = Nothing
  
  sSQL = "INSERT INTO Procedure_Process " & _
         "(WorkflowProcessID, ProcedureID, Status, UserName, StartDate) " & _
         "VALUES(" & m_sWorkflowID & "," & m_sProcedureID & ", 'OPEN','" & sUserName & "', " & "'" & Format$(m_dtStartDate, "mm-dd-yyyy") & "'" & ")"
         
  Set rsProcedure = New ADODB.Recordset
  rsProcedure.Open sSQL, conWF, adOpenForwardOnly, adLockReadOnly
  
Exit Function
Error_Handler:
  
  IProcedureItem_procedureStart = False
  
  Set rsUser = Nothing
  Set rsProcedure = Nothing
  Set conWF = Nothing

End Function

Private Function IProcedureItem_procedureStop() As Boolean

On Error GoTo Error_Handler

  Dim conWF As ADODB.Connection
  Dim rsProcedure As ADODB.Recordset
  Dim sSQL As String
  
  Set conWF = New ADODB.Connection
  
  With conWF
    .ConnectionTimeout = 10
    .ConnectionString = "DSN=workflow"
    .Open
  End With
          
  sSQL = "UPDATE procedure_process SET " & _
         " Response = '" & m_sResponse & "', " & _
         "Status= '" & "Complete" & "', " & _
          " CompleteDate = '" & Format$(Now, "mm-dd-yyyy") & "'" & _
         " WHERE ProcedureProcessID = " & m_sProcedureProcessID & " "
         
  Set rsProcedure = New ADODB.Recordset
  rsProcedure.Open sSQL, conWF, adOpenForwardOnly, adLockReadOnly
   
  IProcedureItem_procedureStop = True
  
  Set rsProcedure = Nothing
  Set conWF = Nothing
  
Exit Function
Error_Handler:

  IProcedureItem_procedureStop = False
  
  Set rsProcedure = Nothing
  Set conWF = Nothing
End Function

Private Property Let IProcedureItem_Response(ByVal vData As String)
    m_sResponse = vData
End Property

Private Property Get IProcedureItem_Response() As String
    IProcedureItem_Response = m_sResponse
End Property

Private Property Let IProcedureItem_StartDate(ByVal vData As Date)
  m_dtStartDate = vData
End Property

Private Property Get IProcedureItem_StartDate() As Date
  IProcedureItem_StartDate = m_dtStartDate
End Property

Private Property Let IProcedureItem_StepType(ByVal vData As String)
  m_sStepType = vData
End Property

Private Property Get IProcedureItem_StepType() As String
  IProcedureItem_StepType = m_sStepType
End Property

Private Property Let IProcedureItem_WorkflowID(ByVal vData As String)
    m_sWorkflowID = vData
End Property

Private Property Get IProcedureItem_WorkflowID() As String
  IProcedureItem_WorkflowID = m_sWorkflowID
End Property