Test for AS400 program MSGW?

Is there a way to test for a program that has gone onto message wait on an AS400 system?

My VB program is currently hanging because the AS400 program is expecting a reponse due to a function check etc. I've tried a couple of different methods...

Method 1 - ADODB.Connection
Program just hangs at con400.Execute...

Code:

---

Private Function ExecuteAS400Cmd(ByRef con400 As ADODB.Connection, strCmd As String) As Boolean

    On Error GoTo AS400_Error

    con400.Execute "CALL QSYS.QCMDEXC('" & strCmd & "', " & Format(Len(strCmd), "0000000000") & ".00000)"
    ExecuteAS400Cmd = True
   
AS400_Resume:
    Exit Function
   
AS400_Error:
    Dim lErrNo      As Long
    Dim sErrMSG    As String
    Dim sErrSource  As String
    With Err
        lErrNo = .Number
        sErrMSG = .Description
        sErrSource = .Source
    End With
    Err.Raise lErrNo, sErrMSG, sErrSource
    Resume AS400_Resume

End Function

---

Method 2 - IBM Client Access Express Activex Objects
Program hangs at objAS400Command.Run

Code:

---

Private Function IBMExecuteCommand(SystemName As String, CommandString As String) As Boolean

    Dim objAS400Command    As cwbx.Command
   
'// Create new command object
    Set objAS400Command = New cwbx.Command
   
'// Create new as400 system object
    Set objAS400Command.System = New cwbx.AS400System
   
'// Define the system and sign on
    With objAS400Command
        .System.Define SystemName
        .System.UserID = "MYUSER"
        .System.Password = "MYPASSWORD"
        .System.Signon
    End With
   
'// Run the command
    objAS400Command.Run CommandString

    If objAS400Command.Errors.Count > 0 Then
   
    Else
        IBMExecuteCommand = True
    End If

End Function

---

Does anyone have any idea how to execute the command, then test for the response, handling any possible MSGW status or other errors on the AS400 system?

Thanks

Coonnection timeout could help?

It would be hard for me to judge whether something has timed out due to an actual AS400 program error or if the program is just taking a long time to finish! The data going into the program will vary considerably...so I couldn't just put '30 secs' and assume anything over this is an error.

I suppose what I really need to do is submit the job rather than calling interactively, retrieve a handle to the job, then monitor it for completion or message waits...

Got to try and figure out how though..!!

Batch on as 400 could be a solution: it could write on a file if any matter arise,
and you could read from it via Vb to know....it might be easier linking teh "msg
file" via access and then reading the access "table" (Iouri used to, and could be
the one to contact if you need details)

Well I've managed to submit the job under its own name now, my program wont hang anymore because I am submitting rather than calling interactively...

Code:

---

Private Function RunCommandMonitorQue(SystemName As String)

'// Each of these variables are provided from the ActiveX object provided by IBM
    Dim objAS400        As cwbx.AS400System
    Dim objAS400Cmd    As cwbx.Command
    Dim objdQueue      As cwbx.DataQueue
    Dim strData        As String
    Dim sJobCommand    As String

' // Setup AS400 Session object. This signs on and provides you with a session. At this point a new
' // QTEMP library is provided
    Set objAS400 = New cwbx.AS400System
    With objAS400
        .Define SystemName
        .UserID = "MYUSER"
        .Password = "MYPWD"
           
        .Signon
    End With

'// Build the submit command job
    sJobCommand = "SBMJOB CMD(CALL PGM(MMHOFPLT/COR050CL)) JOB(COEDIDATA) JOBQ(QS36EVOKE) LOG(4 *JOBD *SECLVL) LOGCLPGM(*YES)"

' // Add any libraries required by the job
    With objAS400Cmd
        Set .System = objAS400
        .Run sJobCommand    '// Job submit here!
    End With

'// THIS IS WHERE I NEED TO WRITE CODE TO MONITOR FOR THE RESULTS...

'// NEED TO FIGURE OUT HOW TO GET A 'HANDLE' TO THE JOB I HAVE SUBMITTED
'// AND READ ITS OUT Q / MESSAGE Q??

    Set objAS400 = Nothing
    Set objAS400Cmd = Nothing

End Function

---

This is all good, but at the moment my VB interface will just return OK because it has submitted a job - regardless of the outcome of that job.

Hmmmmmm.....??!

and so, have the as400 set a flag somewhere where you can read from vb (say
access linked table, looping till something enter there) to know if job is running,
is waiting, is finished ?...

Thats definitely an option Cimperiali, I'm trying to complete the function using all IBM Activex objects though.....they must have code in the DLL to do exactly what I want, just a matter of finding what it is!

LOG(4 *JOBD *SECLVL) LOGCLPGM(*YES)

This is specifying full jog logging with all CL commands, it will always generate a detailed spool file attached to the job (unless it message waits!).

I'm thinking something like....

test for job message wait
On MSGW? > Return CWB_FAIL
All OK? > read job log
All OK? > return CWB_OK
job log Errors? > return CWB_FAIL

I'll let this thread die - I'll only post back if i figure it out!! Thanks anyway

Resolved! The solution required a change to the CL program that I am submitting on the AS400 so that it writes its results to a data queue (Type *DTAQ on AS400).

The program now writes a specifc message if it went ok, or dumps error info into the queue if not.

To avoid the MSGW problem, the program now answers its own message with a C (cancel) and dumps the reason why it went onto MSGW.

Heres the example code for submitting a job, and monitoring a specific queue for a response....

The MonitorQ routine requires you to set all parameters for a QSYS program call rather than using the DataQueue object, due to error CWB4016 which is described here

Hope this helps somone in the future!!

Code:

---


Private Sub SubmitAS400JobForResult()

    Dim bResult As Boolean
    Dim sJobCommand As String
   
'// Build the submit command job
    sJobCommand = "SBMJOB CMD(CALL PGM(HOFPLT/COR050CL)) JOB(COEDIDATA) JOBQ(YOURQ) LOG(4 *JOBD *SECLVL) LOGCLPGM(*YES)"
    bResult = RunCommandMonitorQ("TES001", sJobCommand)

End Sub

Private Function RunCommandMonitorQ(SystemName As String, _
                                    CommandString As String) As Boolean

'// ActiveX objects provided by IBM
    Dim objAS400        As cwbx.AS400System
    Dim objAS400Cmd    As cwbx.Command
   
    Dim strData        As String
    Dim sJobCommand    As String
    Dim bQResult        As Boolean
   
    On Error GoTo RunCommandMonitorQ_Error

'// Setup AS400 Session object. This signs on and provides you with a session. At this point a new
'// QTEMP library is provided
    Set objAS400 = New cwbx.AS400System
    With objAS400
        .Define SystemName
        .UserID = "YOURUSER"
        .Password = "YOURPWD"
        .Signon
    End With

'// Submit the command
    Set objAS400Cmd = New cwbx.Command
    With objAS400Cmd
        Set .System = objAS400
        .Run sJobCommand
    End With
   
'// Job has been submitted, so monitor the output data q for any messages
    bQResult = MonitorQ(objAS400)

    Set objAS400 = Nothing
    Set objAS400Cmd = Nothing
   
    RunCommandMonitorQ = bQResult

RunCommandMonitorQ_Resume:
    Exit Function
   
RunCommandMonitorQ_Error:
    Dim lErrNo      As Long
    Dim sErrMSG    As String
    Dim sErrSource  As String
    With Err
        lErrNo = .Number
        sErrMSG = .Description
        sErrSource = .Source
    End With
    Err.Raise lErrNo, sErrMSG, sErrSource
    Resume RunCommandMonitorQ_Resume
   
End Function

Private Function MonitorQ(oAS400 As cwbx.AS400System) As Boolean

    Dim objParams  As cwbx.ProgramParameters
    Dim oPgm        As cwbx.Program
    Dim strCvtr    As cwbx.StringConverter
    Dim pckCvtr    As cwbx.PackedConverter
    Dim strData    As String
    Dim bSuccess    As Boolean

    On Error GoTo MonitorQ_Error

'// Set up parameters for the QSYS program call
    Set objParams = New cwbx.ProgramParameters

    With objParams
        .Append "QNAME", cwbx.cwbrcParameterTypeEnum.cwbrcInout, 10
        .Append "LIBNAME", cwbx.cwbrcParameterTypeEnum.cwbrcInout, 10
        .Append "LENGTH", cwbx.cwbrcParameterTypeEnum.cwbrcInout, 5
        .Append "DATA", cwbx.cwbrcParameterTypeEnum.cwbrcInout, 1000
        .Append "WAIT", cwbx.cwbrcParameterTypeEnum.cwbrcInout, 5
    End With

'// Set up the data type converters
    Set strCvtr = New cwbx.StringConverter
    Set pckCvtr = New cwbx.PackedConverter

'// Set the paramater values
    strCvtr.Length = 10
    objParams("QNAME").Value = strCvtr.ToBytes("YOUR_DATA_Q_NAME")

    strCvtr.Length = 10
    objParams("LIBNAME").Value = strCvtr.ToBytes("YOUR_LIBRARY_NAME")

    pckCvtr.Digits = 5
    pckCvtr.DecimalPosition = 0
    objParams("LENGTH").Value = pckCvtr.ToBytes("1000")

    strCvtr.Length = 1000
    objParams("DATA").Value = strCvtr.ToBytes("")

    pckCvtr.Digits = 5
    pckCvtr.DecimalPosition = 0
    objParams("WAIT").Value = pckCvtr.ToBytes("1")

'// Default value to start the loop!
    strData = "NO DATA"

    Set oPgm = New cwbx.Program
    With oPgm
        Set .System = oAS400
        .LibraryName = "QSYS"          '// Attempt to read the data queue
        .ProgramName = "QRCVDTAQ"      '// using the QRCVDTAQ API
    End With

    Do While Len(Trim(strData)) > 0
        oPgm.Call objParams
        strCvtr.Length = 1000
        strData = strCvtr.FromBytes(objParams("DATA").Value)
       
        If InStr(1, strData, "COR_EDI_OK") > 0 Then
            bSuccess = True
        End If
       
        Debug.Print strData
    Loop
   
    MonitorQ = bSuccess

MonitorQ_Resume:
    Set pckCvtr = Nothing
    Set strCvtr = Nothing
    Set oPgm = Nothing
    Set objParams = Nothing
    Exit Function
   
MonitorQ_Error:
    Dim lErrNo      As Long
    Dim sErrMSG    As String
    Dim sErrSource  As String
    With Err
        lErrNo = .Number
        sErrMSG = .Description
        sErrSource = .Source
    End With
    Err.Raise lErrNo, sErrMSG, sErrSource
    Resume MonitorQ_Resume

End Function

---

Thanks for sharing. You are a smart one, and this code is valuable.

Stole most of the code for MonitorQ routine from some thread on vbCity.....! :D

That was for a slightly different problem, but showed me how to call the QRCVDTAQ program.