CodeGuru Home VC++ / MFC / C++ .NET / C# Visual Basic VB Forums Developer.com
Results 1 to 10 of 10
  1. #1
    Join Date
    Aug 2003
    Location
    London
    Posts
    515

    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

  2. #2
    Join Date
    Jul 2000
    Location
    Milano, Italy
    Posts
    7,726

    Re: Test for AS400 program MSGW?

    Coonnection timeout could help?
    ...at present time, using mainly Net 4.0, Vs 2010



    Special thanks to Lothar "the Great" Haensler, Chris Eastwood , dr_Michael, ClearCode, Iouri and
    all the other wonderful people who made and make Codeguru a great place.
    Come back soon, you Gurus.

  3. #3
    Join Date
    Aug 2003
    Location
    London
    Posts
    515

    Re: Test for AS400 program MSGW?

    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..!!

  4. #4
    Join Date
    Jul 2000
    Location
    Milano, Italy
    Posts
    7,726

    Re: Batch...

    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)
    ...at present time, using mainly Net 4.0, Vs 2010



    Special thanks to Lothar "the Great" Haensler, Chris Eastwood , dr_Michael, ClearCode, Iouri and
    all the other wonderful people who made and make Codeguru a great place.
    Come back soon, you Gurus.

  5. #5
    Join Date
    Aug 2003
    Location
    London
    Posts
    515

    Re: Test for AS400 program MSGW?

    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.....??!

  6. #6
    Join Date
    Jul 2000
    Location
    Milano, Italy
    Posts
    7,726

    Re: Test for AS400 program MSGW?

    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 ?...
    ...at present time, using mainly Net 4.0, Vs 2010



    Special thanks to Lothar "the Great" Haensler, Chris Eastwood , dr_Michael, ClearCode, Iouri and
    all the other wonderful people who made and make Codeguru a great place.
    Come back soon, you Gurus.

  7. #7
    Join Date
    Aug 2003
    Location
    London
    Posts
    515

    Re: Test for AS400 program MSGW?

    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

  8. #8
    Join Date
    Aug 2003
    Location
    London
    Posts
    515

    Re: Test for AS400 program MSGW?

    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

  9. #9
    Join Date
    Jul 2000
    Location
    Milano, Italy
    Posts
    7,726

    Really nice, Dmorley.

    Thanks for sharing. You are a smart one, and this code is valuable.
    ...at present time, using mainly Net 4.0, Vs 2010



    Special thanks to Lothar "the Great" Haensler, Chris Eastwood , dr_Michael, ClearCode, Iouri and
    all the other wonderful people who made and make Codeguru a great place.
    Come back soon, you Gurus.

  10. #10
    Join Date
    Aug 2003
    Location
    London
    Posts
    515

    Re: Test for AS400 program MSGW?

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

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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  





Click Here to Expand Forum to Full Width

Featured