Soft phase application example code

The following section contains Visual Basic .NET code for creating the soft phase example. The standard code is provided by the template when you run CreateSoftPhase.exe.

UserCode.bas

Option Strict Off
Option Explicit On 
Imports System.Xml

Module usercode

    'define constants for the different operator prompt types
    Public Const promptTypeBoolean As Long = 3400
    Public Const promptTypeFloat As Long = 3300
    Public Const promptTypeInteger As Long = 3200
    Public Const promptTypeString As Long = 3500

    'Define constants for confirm and verify prompt options
    Public Const noConfirmReqd As Boolean = False
    Public Const confirmReqd As Boolean = True
    Public Const noVerifyReqd As Boolean = False
    Public Const VerifyReqd As Boolean = True

    'define constants for the errors that may be returned from the operator prompt function
    Public Const promptSuccess As Long = 0
    Public Const promptInvalidPromptType As Long = 10
    Public Const promptInvalidMessageId As Long = 20
    Public Const promptSetConfirmFlagError As Long = 30
    Public Const promptSetVerifyFlagError As Long = 40
    Public Const promptIssuePromptError As Long = 50
    Public Const promptGetResultError As Long = 60
    Public Const promptPhaseStateChangeError As Long = 70

    Public Structure Lot
        Dim Code As String
        Dim Manufacturer As String
        Dim Amount As Integer
        Dim Expiration_Date As Date

        Public Sub empty()
            Code = ""
            Manufacturer = ""
            Amount = 0
            Expiration_Date = #1/1/1979#
        End Sub
    End Structure

    Public Function promptOperator(ByVal promptType As Long, _
                                   ByVal messageId As Long, _
                                   ByRef promptResult As Object, _
                                   Optional ByVal confirm As Boolean = False, _
                                   Optional ByVal verify As Boolean = False) As Long

        Dim attrName As String
        Dim attrValue As Object
        Dim returnValue As Long
        Dim responseAvailable As Boolean
        Dim debugRequest As Object
        Dim debugReqData1 As Object
        Dim debugReqData2 As Object

        'verify the promptType is valid
        Select Case promptType
            Case promptTypeBoolean, promptTypeFloat, promptTypeInteger, promptTypeString

                'verify that the message id is valid - if it is, set the confirm and verify status registers and then issue the prompt
                If (messageId > 0) And (messageId <= 99) Then

                    'if operator confirmation required set reqdata1 = 1 else set reqdata1 = 0
                    If confirm = True Then
                        attrValue = 1
                    Else
                        attrValue = 0
                    End If 'confirm = True
                    attrName = "REQDATA1"
                    returnValue = WriteAttribute(attrName, attrValue)

                    'if supervisor verification required set reqdata2 = 1 else set reqdata2 = 0
                    If verify = True Then
                        attrValue = 1
                    Else
                        attrValue = 0
                    End If 'verify = True
                    attrName = "REQDATA2"
                    returnValue = WriteAttribute(attrName, attrValue)

                    'issue the operator prompt
                    attrName = "REQUEST"
                    attrValue = promptType + messageId
                    returnValue = WriteAttribute(attrName, attrValue)

                    'read back the values of request, reqdata1 and reqdata2
                    'to confirm that they have been set correctly - write values in debug messages.
                    attrName = "REQUEST"
                    returnValue = ReadAttribute(attrName, attrValue)
                    debugRequest = attrValue

                    attrName = "REQDATA1"
                    returnValue = ReadAttribute(attrName, attrValue)
                    debugReqData1 = attrValue

                    attrName = "REQDATA2"
                    returnValue = ReadAttribute(attrName, attrValue)
                    debugReqData2 = attrValue

                    DebugMessage("Operator prompt debug data follows:")
                    DebugMessage("Request = " + CStr(debugRequest))
                    DebugMessage("Reqdata1 = " + CStr(debugReqData1))
                    DebugMessage("Reqdata2 = " + CStr(debugReqData2))

                    'if the message id is not valid return an error and exit the function
                Else
                    promptOperator = promptInvalidMessageId
                    promptResult = "Error - Operator Prompt Not Issued: Invalid Message Id"
                    Exit Function
                End If '(messageId > 0) And (messageId <= 99)

                'if the prompt type is not valid return an error and exit the function
            Case Else
                promptOperator = promptInvalidPromptType
                promptResult = "Error - Operator Prompt Not Issued: Invalid Prompt Type"
                Exit Function
        End Select 'promptType

        'wait for the operator to respond to the prompt (i.e. the request register will be set to 0)
        responseAvailable = False
        While responseAvailable = False
            If GetPhaseState() = PHASE_STATE_RUNNING Then
                Sleep(2000)
                attrName = "REQUEST"
                returnValue = ReadAttribute(attrName, attrValue)
                If (returnValue = RW_NO_ERROR) And (attrValue = 0) Then
                    responseAvailable = True
                End If 'returnValue = RW_NO_ERRORR...
            Else
                'phase state has changed - set error status and end the function
                promptOperator = promptPhaseStateChangeError
                promptResult = "Error - Operator Prompt Cancelled Due To Phase State Change"
                Exit Function
            End If 'GetPhaseState() = PHASE_STATE_RUNNING
        End While

        'determine which of the phases parameters the response will be located in
        Select Case promptType
            Case promptTypeBoolean
                attrName = "PROMPT_BOOL"
            Case promptTypeFloat
                attrName = "PROMPT_FLOAT"
            Case promptTypeInteger
                attrName = "PROMPT_INT"
            Case promptTypeString
                attrName = "PROMPT_STRING"
        End Select

        'read the value of the response
        returnValue = ReadAttribute(attrName, attrValue)

        'The operator prompt was successfully issued. Return a success code.
        promptOperator = promptSuccess
        promptResult = attrValue

    End Function

    Sub CancelPendingRequest()

        Dim attrName As String
        Dim attrValue As Object
        Dim returnValue As Long

        DebugMessage("Cancelling Request")
        attrName = "REQUEST"
        returnValue = -1

        While returnValue <> RW_NO_ERROR
            returnValue = ReadAttribute(attrName, attrValue)
            Sleep(1000)
        End While

        If attrValue <> 0 Then
            returnValue = -1
            attrName = "REQUEST"
            attrValue = 6000
            While returnValue <> RW_NO_ERROR
                returnValue = WriteAttribute(attrName, attrValue)
                Sleep(1000)
            End While

            While (returnValue <> RW_NO_ERROR) Or (attrValue <> 0)
                returnValue = ReadAttribute(attrName, attrValue)
                Sleep(1000)
            End While
        End If
    End Sub
    Public Function AdjustLotCodeFromFile(ByVal Lot_Code As String, ByVal AdjustAmount As Integer) As Boolean
        Dim bRet As Boolean
        Dim xd As XmlDocument
        Dim xnl As XmlNodeList
        Dim xn As XmlNode

        Try
            bRet = False
            xd = New XmlDocument
            xd.Load("C:\color_stabilizer_db.xml")
            xnl = xd.SelectNodes("Root/Lot")
            Dim i As Integer
            i = 0

            While (i < xnl.Count) And (bRet = False)
                xn = xnl.Item(i)
                Dim xn2 As XmlNode
                xn2 = xn.SelectSingleNode("Code")

                If Not (xn2 Is Nothing) And (xn2.InnerText = Lot_Code) Then
                    bRet = True
                    xn2 = xn.SelectSingleNode("Amount_Available")

                    If Not (xn2 Is Nothing) Then
                        Dim iAmount As Integer
                        iAmount = xn2.InnerText
                        iAmount -= AdjustAmount
                        xn2.InnerText = iAmount
                        xd.Save("C:\color_stabilizer_db.xml")
                    End If
                End If
                i += 1
            End While

        Catch ex As Exception
            DebugMessage("Error in AdjustLotCodeFromFile: " & ex.ToString())
        End Try
        Return bRet
    End Function

    Public Function FindLotCodeFromFile(ByVal Lot_Code As String, ByRef The_Lot As Lot) As Boolean
        Dim bRet As Boolean
        Dim xd As XmlDocument
        Dim xnl As XmlNodeList
        Dim xn As XmlNode

        Try
            bRet = False
            xd = New XmlDocument
            xd.Load("C:\color_stabilizer_db.xml")
            xnl = xd.SelectNodes("Root/Lot")
            Dim i As Integer
            i = 0

            While (i < xnl.Count) And (bRet = False)
                xn = xnl.Item(i)
                Dim xn2 As XmlNode
                xn2 = xn.SelectSingleNode("Code")

                If Not (xn2 Is Nothing) And (xn2.InnerText = Lot_Code) Then
                    The_Lot.Code = Lot_Code
                    bRet = True
                    xn2 = xn.SelectSingleNode("Manufacturer")

                    If Not (xn2 Is Nothing) Then
                        The_Lot.Manufacturer = xn2.InnerText
                    End If

                    xn2 = xn.SelectSingleNode("Amount_Available")

                    If Not (xn2 Is Nothing) Then
                        The_Lot.Amount = xn2.InnerText
                    End If

                    xn2 = xn.SelectSingleNode("Expiration_Date")

                    If Not (xn2 Is Nothing) Then
                        The_Lot.Expiration_Date = xn2.InnerText
                    End If
                End If
                i += 1
            End While

        Catch ex As Exception
            DebugMessage("Error in FindLotCodeFromFile: " & ex.ToString())
        Finally
        End Try

        Return bRet
    End Function

    'These are the five user methods.

    Sub running()
        'define variables required for reading and writing phase attributes
        Dim attrName As String
        Dim attrValue As Object
        Dim returnValue As Long
        'define the variables used specifically for the run logic
        Dim operResponse As Object
        Dim colorStabilizerAmountRequired As Integer
        Dim colorStabilizerLotCode As String
        Dim colorStabilizerManufacturerCode As String
        Dim colorStabilizerAmountAvailable As Integer
        Dim colorStabilizerExpirationDate As Date
        Dim currentDate As Date
        Dim count As Long
        Dim continue As Boolean
        Dim errorOccurred As Boolean
        Dim bLotFound As Boolean
        Dim The_Lot As Lot

        'as a precaution, cancel any pending request (there could be one if the phase is restarting).
        Call CancelPendingRequest()

        'initialize variables that will be set via prompts
        errorOccurred = False
        colorStabilizerAmountRequired = 0
        colorStabilizerLotCode = vbEmpty
        'check if a manual addition is required
        DebugMessage("Enter the amount of color stabilizer to be added (0 for no addition): ")
        returnValue = promptOperator(promptTypeInteger, 1, operResponse, confirmReqd, noVerifyReqd)

        If returnValue = promptSuccess Then
            colorStabilizerAmountRequired = operResponse
        Else
            errorOccurred = True
            GoTo PromptError
        End If 'returnValue = promptSuccess

        'if the manual addition of color stabilizer is not required then the phase will complete
        If colorStabilizerAmountRequired <= 0 Then
            GoTo Complete
        End If 'color StabilizerAmountRequired <= 0

Start:
        'prompt the operator for the color stabilizer lot code
        DebugMessage("Enter the color stabilizer lot code: ")
        returnValue = promptOperator(promptTypeString, 2, operResponse, confirmReqd, noVerifyReqd)
        If returnValue = promptSuccess Then
            colorStabilizerLotCode = operResponse
        Else
            errorOccurred = True
            GoTo PromptError
        End If 'returnValue = promptSuccess

        'initialize all of the variable which will be read from the materials database
        colorStabilizerExpirationDate = "01/01/1800"

        'initialize the variables used to locate the specified color stabilizer lot code in the in the materials
        'database and check the expiration date
        currentDate = Now()
        count = 2
        'select the row from the materials database where the color stabilizer lot code matches the
        'color stabilizer lot code entered by the operator

        bLotFound = FindLotCodeFromFile(colorStabilizerLotCode, The_Lot)

        'check if the current lot code is defined (if not, we've reached the end of the list)
        If bLotFound = False Then
            'inform operator that lot code entered was not found - continue with invalid code?
            DebugMessage("Lot code not found in database - continue with invalid lot code?")
            returnValue = promptOperator(promptTypeBoolean, 3, operResponse, confirmReqd, VerifyReqd)
            continue = operResponse
            If returnValue = promptSuccess Then
                If continue = False Then
                    colorStabilizerLotCode = vbEmpty
                    GoTo Start
                Else
                    'write the material manufacturing id for the material to be used
                    attrName = "CS_MANUFAC_DATA"
                    attrValue = "Color Stabilizer Addition: Amount Added = " + CStr(colorStabilizerAmountRequired) + _
                                     ", Lot Code = " + colorStabilizerLotCode + _
                                     ", Lot Code Not Found in Color Stabilizer Database - Manufacturer" + _
                                     " and Expiration Date unknown"
                    DebugMessage(attrValue)
                    returnValue = WriteAttribute(attrName, attrValue)
                End If 'continue = false
            Else
                errorOccurred = True
                GoTo PromptError
            End If 'returnValue = promptSuccess
        ElseIf The_Lot.Code = colorStabilizerLotCode Then
            colorStabilizerManufacturerCode = The_Lot.Manufacturer
            colorStabilizerAmountAvailable = The_Lot.Amount
            colorStabilizerExpirationDate = The_Lot.Expiration_Date

            If (colorStabilizerAmountAvailable < colorStabilizerAmountRequired) Then
                'inform the operator that there is not enough color stabilizer and ask if he wants to continue
                DebugMessage("The materials database indicates that there is insufficient color" + _
                             " stabilizer available.  Continue with this Lot Code?")
                returnValue = promptOperator(promptTypeBoolean, 4, operResponse, confirmReqd, VerifyReqd)
                If returnValue = promptSuccess Then
                    continue = operResponse
                    If continue = False Then
                        colorStabilizerLotCode = vbEmpty
                        GoTo Start
                    Else
                        colorStabilizerAmountRequired = colorStabilizerAmountAvailable
                    End If 'continue = false
                Else
                    errorOccurred = True
                    GoTo PromptError
                End If 'returnValue = promptSuccess
            End If 'colorStabilizerAmountAvailable < colorStabilizerAmountRequired

            If (colorStabilizerExpirationDate < currentDate) Then
                'inform the operator that the color stabilizer is expired and ask if he wants to continue
                DebugMessage("The materials database indicates that this color stabilizer lot" + _
                             " code has expired.  Continue with this Lot Code?")
                returnValue = promptOperator(promptTypeBoolean, 5, operResponse, confirmReqd, VerifyReqd)
                If returnValue = promptSuccess Then
                    continue = operResponse
                    If continue = False Then
                        colorStabilizerLotCode = vbEmpty
                        GoTo Start
                    End If 'continue = false
                Else
                    errorOccurred = True
                    GoTo PromptError
                End If 'returnValue = promptSuccess
            End If 'colorStabilizerExpirationDate < currentDate
            'write the material manufacturing id for the material to be used
            attrName = "CS_MANUFAC_DATA"
            attrValue = "Color Stabilizer Addition: Amount Added = " + CStr(colorStabilizerAmountRequired) + _
                             ", Manufactured By = " + colorStabilizerManufacturerCode + _
                             ", Lot Code = " + colorStabilizerLotCode + _
                             ", Expiration Date = " + CStr(colorStabilizerExpirationDate)
            DebugMessage(attrValue)
            returnValue = WriteAttribute(attrName, attrValue)

            If returnValue = RW_NO_ERROR Then
                AdjustLotCodeFromFile(colorStabilizerLotCode, colorStabilizerAmountRequired)
            End If 'returnValue = RW_NO_ERROR
        End If 'The_Lot.Code = colorStabilizerLotCode

PromptError:
        'execute error handling if an error has occurred
        If errorOccurred = True Then
            'if prompt error not due to a phase state change then set the fail flag
            If returnValue <> promptPhaseStateChangeError Then
                DebugMessage("Setting Fail Flag - Value = 254")
                attrName = "FAIL_INDEX"
                attrValue = 254
                returnValue = WriteAttribute(attrName, attrValue)
            End If 'returnValue <> promptPhaseStateChangeError
        End If 'errorOccurred = True
Complete:
    End Sub

    Sub holding()
        DebugMessage(("Holding"))
    End Sub

    Sub stopping()
        DebugMessage(("Stopping"))
    End Sub

    Sub aborting()
        DebugMessage(("Aborting"))
    End Sub

    Sub restarting()
        DebugMessage(("Restarting"))
    End Sub
End Module