Copy Code
|
|
---|---|
Private Sub addConditionToFlow() '-------------------------------------- ' Add a condition to a flow. '-------------------------------------- On Error GoTo handle_errors errmsg = "" Dim tstFactory As TestFactory Dim tst As Test Dim fl As IBusinessProcess2 Dim bpComp As BPComponent Dim bpParam As BPParameter Dim foundBpComp As BPComponent Dim foundComp As Component Dim foundCompParam As ComponentParam Dim found As Boolean ' Find a test of type "Flow" Set tstFactory = tdc.TestFactory For Each tst In tstFactory.NewList("") If (tst.Type = "FLOW") Then Set fl = tst Exit For End If Next tst If fl Is Nothing Then MsgBox "No flow tests in project" Exit Sub End If Dim VersionCntl As Object Dim NoCheckoutError As Boolean ' Check the test out of version control and load the test. ' The code of CheckoutTest is the example to the ' Test coclass, "Checking out a Test." Set VersionCntl = _ CheckoutTest(tst, "Set condition on input param", NoCheckoutError) If Not NoCheckoutError Then Exit Sub fl.Load found = False ' Find an input parameter. For Each bpComp In fl.BPComponents For Each bpParam In bpComp.BPParams Debug.Print bpParam.ComponentParamName, bpParam.ComponentParamIsOut If bpParam.ComponentParamIsOut = 0 Then Set foundBpComp = bpComp Set foundComp = bpComp.Component Set foundCompParam = bpParam.ComponentParam found = True Exit For End If Next bpParam If found = True Then Exit For Next bpComp If found = False Then MsgBox "No input parameters in flow: " & fl.name Exit Sub End If ' Create a condition for the input parameter as XML: ' For example: ' <expression><leftParam type="ip" compid="1" compparamorder="0" paramid="7" ' flowtestid="1">param_name</leftParam><operation>eq</operation><rightParam type="value"><![CDATA ' [some_value]]></rightParam><otherwise>Continue</otherwise></expression> Dim compId As Integer compId = foundComp.ID Dim paramId As Integer paramId = foundCompParam.ID Dim flowTestId As Integer flowTestId = fl.ID ' Project must reference Microsoft XML library. Dim conditionDOM As DOMDocument Set conditionDOM = New DOMDocument conditionDOM.async = False Dim expression ' Create the expression. Set expression = conditionDOM.createElement("expression") conditionDOM.appendChild (expression) Dim lparam Set lparam = conditionDOM.createElement("leftParam") Dim attType, attCompId, attCompParamOrder, attParamId, attFlowId Set attType = conditionDOM.createAttribute("type") ' ip - for input parameters, op - for output parameters, rt - for run time parameters attType.value = "ip" lparam.setAttributeNode (attType) Set attCompId = conditionDOM.createAttribute("compid") attCompId.value = compId lparam.setAttributeNode (attCompId) Set attCompParamOrder = conditionDOM.createAttribute("compparamorder") attCompParamOrder.value = foundCompParam.order lparam.setAttributeNode (attCompParamOrder) Set attParamId = conditionDOM.createAttribute("paramid") attParamId.value = foundCompParam.ID lparam.setAttributeNode (attParamId) Set attFlowId = conditionDOM.createAttribute("flowtestid") attFlowId.value = fl.ID lparam.setAttributeNode (attFlowId) lparam.Text = foundCompParam.name expression.appendChild (lparam) Dim operation Set operation = conditionDOM.createElement("operation") ' eq - equal to ' neq - not equal to ' st - less than ' steq - less than or equal to ' gt - greate than ' gteq - greater than or equal to operation.Text = "eq" expression.appendChild (operation) Dim rparam Set rparam = conditionDOM.createElement("rightParam") Dim attRightParamType Set attRightParamType = conditionDOM.createAttribute("type") attRightParamType.value = "value" rparam.setAttributeNode (attRightParamType) Dim rparamValue ' Set the value for the condition. Set rparamValue = conditionDOM.createCDATASection("abcd") rparam.appendChild (rparamValue) expression.appendChild (rparam) Dim otherwise Set otherwise = conditionDOM.createElement("otherwise") ' Can be Continue or Fail. otherwise.Text = "Continue" expression.appendChild (otherwise) Debug.Print conditionDOM.xml ' Set the condition. foundBpComp.Field("BC_BPTA_CONDITION") = conditionDOM.xml ' Save the flow. fl.Save On Error Resume Next NoCheckoutError = CheckinTest(VersionCntl, "Condition set on input param.") Set VersionCntl = Nothing Set tstFactory = Nothing Set tst = Nothing Set fl = Nothing Set bpComp = Nothing Set bpParam = Nothing Set foundBpComp = Nothing Set foundComp = Nothing Set foundCompParam = Nothing Set conditionDOM = Nothing Set expression = Nothing Set otherwise = Nothing Set attCompId = Nothing Set attCompParamOrder = Nothing Set attFlowId = Nothing Set attParamId = Nothing Set attRightParamType = Nothing Set attType = Nothing Set rparam = Nothing Set lparam = Nothing Set operation = Nothing Exit Sub handle_errors: errmsg = errmsg & " Error code " & Str(err.Number) ErrHandler err, "addConditionToFlow", errmsg, NON_FATAL_ERROR Resume Next End Sub |