Link to home
Start Free TrialLog in
Avatar of krtarwood
krtarwood

asked on

Running AS/400 Program Remotely w/return Params - Hangs!

Hi Experts!

I am kind of new to interacting with the 400 and so far loathe dealing with it, however I have to complete this project soon so hopefully you can help!
 
I am using VB.Net to connect, run an RPG program which takes two input parameters and returns a float and a data structure to my application. I haven't tried going back to the ODBC/ADO method yet but I am not above giving that a shot. Initially my application was hanging while trying to connect to the 400, but I've fixed that. Now it hangs up when attempting to call the program itself. No exception is returned - it just sits there. I have no real knowledge of the 400 side of things so I don't know how to log user activity to see what is going wrong or anything.

Below is my code:
[code]
Imports ADODB
Imports System
Imports System.IO
Imports System.Configuration

Namespace InfoWebCore

    Public Class GetItemData

        Dim sServerName As String
        Dim sUserID As String
        Dim sPassword As String
        Dim sLibrary As String
        Dim sProgram As String
        Dim bUseSSL As Boolean = False

#Region "Properties"
        Public Property HostName() As String
            Get
                Return sServerName
            End Get
            Set(ByVal Value As String)
                sServerName = Value
            End Set
        End Property

        Public Property UserID() As String
            Get
                Return sUserID
            End Get
            Set(ByVal Value As String)
                sUserID = Value
            End Set
        End Property

        Public Property Password() As String
            Get
                Return sPassword
            End Get
            Set(ByVal Value As String)
                sPassword = Value
            End Set
        End Property

        Public Property Library() As String
            Get
                Return sLibrary
            End Get
            Set(ByVal Value As String)
                sLibrary = Value
            End Set
        End Property

        Public Property Program() As String
            Get
                Return sProgram
            End Get
            Set(ByVal Value As String)
                sProgram = Value
            End Set
        End Property

        Public Property UseSSL() As Boolean
            Get
                Return bUseSSL
            End Get
            Set(ByVal Value As Boolean)
                bUseSSL = Value
            End Set
        End Property
#End Region

#Region "Methods"
        Public Function RunProgram(ByVal itemId As String, ByVal customerId As Integer) As Array
            ' Check that required properties have been set
            If sServerName Is Nothing Then
                Throw New Exception("HostName property must be set to AS/400 IP or hostname prior to calling this method.")
            End If
            If sUserID Is Nothing Then
                Throw New Exception("UserID property must be set to AS/400 username prior to calling this method.")
            End If
            If sPassword Is Nothing Then
                Throw New Exception("Password property must be set to AS/400 user's password prior to calling this method.")
            End If
            If sLibrary Is Nothing Then
                Throw New Exception("Library property must be set to AS/400 library prior to calling this method.")
            End If
            If sProgram Is Nothing Then
                Throw New Exception("Program property must be set to AS/400 program to call prior to calling this method.")
            End If

            Dim as400 As cwbx.AS400System = New cwbx.AS400SystemClass
            Dim program As cwbx.Program = New cwbx.Program

            ' Grab the library, username, password, etc from the properties
            Try
                as400.Define(sServerName)
                program.system = as400
                program.system.UserID = sUserID
                program.system.Password = sPassword
                program.system.PromptMode = cwbx.cwbcoPromptModeEnum.cwbcoPromptNever
                program.system.DefaultUserMode = cwbx.cwbcoDefaultUserModeEnum.cwbcoDefaultUserIgnore
                program.LibraryName = sLibrary
                program.ProgramName = sProgram
                program.system.UseSecureSockets = bUseSSL

                as400.Signon()
            Catch g As Exception
                Throw New Exception("Failed to set AS/400 properties.", g)
            End Try

            ' Try to connect to 400
            Try
                as400.Connect(cwbx.cwbcoServiceEnum.cwbcoServiceRemoteCmd)
            Catch j As Exception
                Throw New Exception("Failed to connect with AS/400 - Please try again later.", j)
            End Try

            Dim stringConverter As cwbx.StringConverter = New cwbx.StringConverterClass
            Dim packedConverter As cwbx.PackedConverter = New cwbx.PackedConverterClass
packedConverter.DecimalPosition = 0
            packedConverter.Digits = 8
           
Dim floatConverter As cwbx.FloatConverter = New cwbx.FloatConverterClass
           
            Dim parameters As cwbx.ProgramParameters = New cwbx.ProgramParametersClass

            ' // ********************************************************
            ' // P55ADVP Program Parameters
            ' // ********************************************************

            ' // Parameter list for P55ADVP:
            ' //
            ' // Name   Size    Desc
            ' //
            ' // PSLITM 25,0    (Input) Alpha - Long Item Number
            ' // PSSHAN 8,0     (Input) Numeric - Customer Shipping ID
            ' // PSUPRC 15,4    (Output) Numeric - Adjusted Price
            ' // PSITM          (Output) Data Structure - Item Attributes

            ' Input Parameters
            parameters.Append("PSLITM", cwbx.cwbrcParameterTypeEnum.cwbrcInput, 25)
            stringConverter.Length = 25
            parameters("PSLITM").Value = stringConverter.ToBytes(itemId.PadRight(25, " "c))
           
            parameters.Append("PSSHAN", cwbx.cwbrcParameterTypeEnum.cwbrcInput, 8)
            parameters("PSSHAN").Value = packedConverter.ToBytes(customerId)

            'Output Parameters
            parameters.Append("PSUPRC", cwbx.cwbrcParameterTypeEnum.cwbrcOutput, 15)
            ' I tried passing a zero value here because the RPG guy told me it might work - it didn't
            'parameters("PSUPRC").Value = floatConverter.ToBytes(0)

            parameters.Append("PSITM", cwbx.cwbrcParameterTypeEnum.cwbrcOutput, 195)
            ' Same here - passed empty
            'parameters("PSITM").Value = stringConverter.ToBytes("")

            Try
                    ' Hangs here!
                    program.Call(parameters)
            Catch ex As Exception
                If as400.Errors.Count > 0 Then
                    Dim error400 As cwbx.Error
                    For Each error400 In as400.Errors
                        Throw New Exception("An error occured while attempting to call the program " & sProgram & " on the AS/400 - see stack trace for details.", ex)
                    Next
                End If

                If program.Errors.Count > 0 Then
                    Dim errorPgm As cwbx.Error
                    For Each errorPgm In program.Errors
                        Throw New Exception("An execution error occured while attempting to execute the program " & sProgram & " on the AS/400 - see stack trace for details.", ex)
                    Next
                End If
            End Try

            ' Lets return values from the 400 in the order they appear in the catalog, shall we?
            Dim itemStruc As New cwbx.Structure
            Dim i As Integer

            itemStruc.Bytes = parameters("PSITM").Value

            Dim byteLength As Integer
            byteLength = itemStruc.Length

            itemStruc.Fields.Append("SIITM", 8)
            itemStruc.Fields.Append("SILITM", 25)
            itemStruc.Fields.Append("SIITSZ", 15)
            itemStruc.Fields.Append("SIITUN", 15)
            itemStruc.Fields.Append("SIUNWT", 15)
            itemStruc.Fields.Append("SIUNPL", 15)
            itemStruc.Fields.Append("SIPLWT", 15)
            itemStruc.Fields.Append("SIGCLR", 25)
            itemStruc.Fields.Append("SIIUPC", 20)
            itemStruc.Fields.Append("SICUPC", 20)
            itemStruc.Fields.Append("SIPUPC", 20)
            itemStruc.Fields.Append("SIAMCR", 1)
            itemStruc.Fields.Append("SIGRGD", 1)

            ' Eventually I will return everything in an array but I am just testing a couple values below.
            Dim returnArr() As String

            ReDim returnArr(2)

            stringConverter.Length = 15
            returnArr(0) = stringConverter.FromBytes(itemStruc("SIITSZ").Value)

            packedConverter.DecimalPosition = 4
            packedConverter.Digits = 15
            returnArr(1) = packedConverter.FromBytes(parameters("PSUPRC").Value)
            returnArr(2) = byteLength.ToString

            ' Finally, disconnect
            as400.Disconnect(cwbx.cwbcoServiceEnum.cwbcoServiceAll)

            Return returnArr
        End Function
#End Region
    End Class

End Namespace

--
' The call to the class looks like this:

        Dim talkTo400 As New InfoWebCore.GetItemData
        talkTo400.HostName = ConfigurationSettings.AppSettings("priceBookServer").ToString
        talkTo400.Library = ConfigurationSettings.AppSettings("priceBookLibrary").ToString
        talkTo400.UserID = ConfigurationSettings.AppSettings("priceBookUser").ToString
        talkTo400.Password = ConfigurationSettings.AppSettings("priceBookPassword").ToString
        talkTo400.Program = ConfigurationSettings.AppSettings("priceBookProgram").ToString
        talkTo400.UseSSL = False

        Dim outArray() As String
        Dim tidbit As String
        Try
            outArray = talkTo400.RunProgram("0253-0050-21", 100845)
            For Each tidbit In outArray
                lblTestOut.Text &= tidbit & ";"
            Next
        Catch f As Exception
            lblTestOut.Text = "An error has occured while attempting to gather necessary data. Error was: " & f.ToString
        End Try

[/code]

Firstly our RPG programmer tells me there is no such thing as an input or output parameter, they are always both. This is interesting considering the cwbx.cwbrcParameterTypeEnum types can be input, output or both. Either way, I've tried them all different ways to no avail - still hangs. Even the test program that took no input params hung, so I'm assuming this has something to do with the call itself, the setup or the output parameters (maybe).

Perhaps you can suggest some reasons as to why the call would hang? I've tried testing the process by calling a program that our RPG guy wrote with hard coded input params just to see if I was malformatting them. Evidently I have no messages waiting on the 400 either so I don't think this is the problem.

I'm using V5R1M0 version of Client Access and .Net v1 in case that matters.

Thanks for the help!
Avatar of krtarwood
krtarwood

ASKER

I'd like to emphasize the need to do this the using CAE automation method here as I have to deal with a return data structure. From what I understand it is much more difficult to deal with these using the ADO method (cwbx class gives you the ability to work with these foreign datatypes more easily I guess).

Just a thought :)
I've increased the point total as this does deal with some esoteric subject matter!

- Ken
Another point increase - let's spice things up.

- Ken
300 points to the expert who comes up with something viable here..
The problem might be if you have library list set to run RPG program. When you call RPG from VB the library list will not be set. You have to crreate CL which will set the library lits and callthe RPG program. It works for me all the time

  sParam = "bla"
        sSQL = "CALL " & POSTCL & "('" & sParam & "')"
        Call pExecuteNQ(sSQL, cn400)



 Public Sub pExecuteNQ(ByVal sSQL As String, ByVal con As OleDbConnection)
        Dim cmd As New OleDbCommand

        cmd.Connection = con
        cmd.CommandText = sSQL
        Try
            cmd.ExecuteNonQuery()
        Catch e As Exception
            MsgBox(Err.Number & " " & Err.Description & " " & e.ToString)
            mbSomethingWrong = True
        End Try
        cmd = Nothing
    End Sub

Here is an example of As400 connection string

 ConnStr = "Provider=IBMDA400;Data Source=YourAS400;"

Make sure that IBMDA400 provider is installed. It will be installed automatically when you install Client Access (or IBM iSeries Access for Windows)
Thanks for the tip iboutchkine!

I went the ADO route and instead of hanging I get the standard ambiguous: Cannot resolve to object P55ADVP. I'm assuming this is because of your library list comment above. I'm trying to get in touch with our RPG guy so he can implement your above suggestion.

Crossing my fingers!

- Ken
OK - I had our 400 guru implement your suggestion in the CL program but it's still hanging. I also switched over to the ADO method w/.Net provider (and hence had to upgrade to V5R3). Below is my code as it stands now. Even with the revisions it still hangs at the program call:

[code]
Imports ADODB
Imports System
Imports System.IO
Imports System.Data
Imports System.Configuration

Namespace InfoWebCore

    Public Class GetItemData

        Dim sServerName As String
        Dim sUserID As String
        Dim sPassword As String
        Dim sLibrary As String
        Dim sProgram As String
        Dim AS400Conn As New ADODB.Connection

#Region "Properties"
        Public Property HostName() As String
            Get
                Return sServerName
            End Get
            Set(ByVal Value As String)
                sServerName = Value
            End Set
        End Property

        Public Property UserID() As String
            Get
                Return sUserID
            End Get
            Set(ByVal Value As String)
                sUserID = Value
            End Set
        End Property

        Public Property Password() As String
            Get
                Return sPassword
            End Get
            Set(ByVal Value As String)
                sPassword = Value
            End Set
        End Property

        Public Property Library() As String
            Get
                Return sLibrary
            End Get
            Set(ByVal Value As String)
                sLibrary = Value
            End Set
        End Property

        Public Property Program() As String
            Get
                Return sProgram
            End Get
            Set(ByVal Value As String)
                sProgram = Value
            End Set
        End Property

#End Region

#Region "Methods"
        Public Function Connect()
            If sServerName Is Nothing Then
                Throw New Exception("HostName property must be set to AS/400 IP or hostname prior to calling Connect method.")
            End If
            If sUserID Is Nothing Then
                Throw New Exception("UserID property must be set to AS/400 username prior to calling Connect method.")
            End If
            If sPassword Is Nothing Then
                Throw New Exception("Password property must be set to AS/400 user's password prior to calling Connect method.")
            End If
            If sLibrary Is Nothing Then
                Throw New Exception("Library property must be set to AS/400 library prior to calling Connect method.")
            End If

            ' Connect
            Try
                AS400Conn.Open("PROVIDER=IBMDA400;DATA SOURCE=" & sServerName & ";DEFAULT COLLECTION=" & sLibrary & ";USER ID=" & sUserID & ";PASSWORD=" & sPassword)
            Catch ex As Exception
                Throw New Exception("Unable to connect to AS/400 at this time. Please try again later. Error was: ", ex)
            End Try
        End Function

        Public Function Disconnect()
            If AS400Conn Is Nothing Or AS400Conn.State = ConnectionState.Closed Or AS400Conn.State = ConnectionState.Broken Then
                Throw New Exception("There is no active AS/400 connection to terminate, or connection state is closed.")
            End If

            ' Terminate connection
            AS400Conn.Close()
            AS400Conn = Nothing
        End Function

        Public Function RunProgram(ByVal itemId As String, ByVal customerId As Integer) As Array
            ' Check that required properties have been set
            If sProgram Is Nothing Then
                Throw New Exception("Program property must be set to AS/400 program to call prior to calling this method.")
            End If
            ' Check that connection set
            If AS400Conn Is Nothing Or AS400Conn.State <> ConnectionState.Open Then
                Throw New Exception("Connect() method must be called before calling this method.")
            End If


            ' Prepare for call
            Dim AS400Pgm As New ADODB.Command
            AS400Pgm.ActiveConnection = AS400Conn

            AS400Pgm.Parameters.Append(AS400Pgm.CreateParameter("PSLITM", DataTypeEnum.adChar, ParameterDirectionEnum.adParamInputOutput, 25))
            AS400Pgm.Parameters.Append(AS400Pgm.CreateParameter("PSSHAN", DataTypeEnum.adChar, ParameterDirectionEnum.adParamInputOutput, 8))
            AS400Pgm.Parameters.Append(AS400Pgm.CreateParameter("PSUPRC", DataTypeEnum.adChar, ParameterDirectionEnum.adParamInputOutput, 15))
            AS400Pgm.Parameters.Append(AS400Pgm.CreateParameter("PSITM", DataTypeEnum.adChar, ParameterDirectionEnum.adParamInputOutput, 195))

            AS400Pgm.CommandText = "{{call DEVMOD/" & sProgram & "(?,?,?,?)}}"
            AS400Pgm.Prepared = True

            ' Eventually I will return everything in an array but I am just testing a couple values below.
            Dim returnArr() As String

            ' Execute
            Dim Parms As Array = Array.CreateInstance(GetType(Object), 3)
            Parms.Initialize()
            Parms.SetValue(itemId.PadRight(25, " "c), 0)
            Parms.SetValue(CInt(customerId), 1)

            AS400Pgm.Execute(Nothing, Parms)

            ReDim returnArr(0)
            ' PSITM is a data structure and therefore probably a problem in and of itself - using returned price only for demo purposes
            'returnArr(0) = AS400Pgm.Parameters.Item("PSITM").Value
            returnArr(0) = AS400Pgm.Parameters.Item("PSUPRC").Value

            AS400Pgm = Nothing

            Return returnArr
        End Function
#End Region
    End Class

End Namespace
[/code]


Here is how I call it:

[code]
        ...
        Dim talkTo400 As New InfoWebCore.GetItemData
        talkTo400.HostName = ConfigurationSettings.AppSettings("priceBookServer").ToString
        talkTo400.Library = ConfigurationSettings.AppSettings("priceBookLibrary").ToString
        talkTo400.UserID = ConfigurationSettings.AppSettings("priceBookUser").ToString
        talkTo400.Password = ConfigurationSettings.AppSettings("priceBookPassword").ToString
        talkTo400.Program = ConfigurationSettings.AppSettings("priceBookProgram").ToString

        talkTo400.Connect()

                 Dim outArray(0) As String
                Try
                    outArray = talkTo400.RunProgram(itemSku, 148267)
                Catch f As Exception
                    Throw New Exception("An error has occured while attempting to gather necessary data. This is most likely due to high server load at this time. Please try again later. Error was: ", f)
                End Try

talkTo400.Disconnect()
...
[/code]

Deadline is looming - any insight would be much appreciated!

Regards,
Ken
I ususally call without AddParameter statement

CL on 400 must accept parameters. try it this way

Do the following

1.Create Cl with parameters on 400
2.try this CL from 400 command line. make sure that it works
3.Call CL from VB as I showed it above




sParam = "bla"
        sSQL = "CALL Library.MyCL('" & sParam & "')"
        Call pExecuteNQ(sSQL, cn400)

make sure that after library name it is a dot but not the slash (which must be on 400)


 Public Sub pExecuteNQ(ByVal sSQL As String, ByVal con As OleDbConnection)
        Dim cmd As New OleDbCommand

        cmd.Connection = con
        cmd.CommandText = sSQL
        Try
            cmd.ExecuteNonQuery()
        Catch e As Exception
            MsgBox(Err.Number & " " & Err.Description & " " & e.ToString)
            mbSomethingWrong = True
        End Try
        cmd = Nothing
    End Sub

That is all the code required
iboutchkine,

Thanks - I'll throw the .Net provider method out the window (both because I wasn't doing it correctly above and because I can't find any documentation which leads me to believe one can call programs using the interface).

My question to you is how does one go about returning values of parameters from your example above? Would I just execute the command against a normal sqlDataReader and grab it that way? Further, how would I handle a datastructure return type using this method - would I have to return it as a huge string and parse it manually?

Thanks for the help,
Ken



ASKER CERTIFIED SOLUTION
Avatar of iboutchkine
iboutchkine

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Also I don't see how I can inject a binary parameter into the command string like that - if I convert an integer to packed binary data then there would either be a conversion error (binary to string) or if I pass the parameter as a regular old integer injected into the string I get the good old "Token was not valid" error, which cites the integer as the cause.

I'm thinking I *have* to use the parameters collection to pass and retrieve parameters unless you can suggest a way to your suggested method with more than just string parameters.

Ken
you can pass a binary parameter as a string and then on 400 side parse it and convert to binary
I don't have the capability to create a stored procedure on the 400 - our RPG guy could only create the program for me - his knowledge is limited to that from what I understand.

For all intents and purposes everyone should assume nothing else can be done on the 400. It is supposedly possible to do everything neccesary on the .Net side - this is the assumption under which I am proceeding.
good luck
iboutchkine,

Thank you for helping out.

Increased points to 350. I'm going back to the original cwbx CAE object model method - I haven't tried it this way since we upgraded to V5R3 of CAE. Will report back.

Regards,
Ken
All,

I've jacked up the point total to 400. I have switched back to the original CAE object model method. My code appears below. Even after upgrading to V5R3 the program call hangs. I have attached a debugger to the process to confirm that program.Call(parameters) is the point at which the hang condition originates. Can anyone reccomend a procedure for troubleshooting this further? I'm going to play with the return parameters and see if this is the problem (RPG guy says there are 4 parameters, all are both input and output which is standard I guess in AS/400 land. They are listed in the comments below). I am stumped as to how to further debug this - hang conditions are tricky.

Any help will earn points!


[code]

Imports ADODB
Imports System
Imports System.IO
Imports System.Data
Imports System.Data.Odbc
Imports System.Configuration

Namespace InfoWebCore

    Public Class GetItemData

        Dim sServerName As String
        Dim sUserID As String
        Dim sPassword As String
        Dim sLibrary As String
        Dim sProgram As String
        Dim as400 As cwbx.AS400System = New cwbx.AS400SystemClass
        Dim program As cwbx.Program = New cwbx.Program


#Region "Properties"
        Public Property HostName() As String
            Get
                Return sServerName
            End Get
            Set(ByVal Value As String)
                sServerName = Value
            End Set
        End Property

        Public Property UserID() As String
            Get
                Return sUserID
            End Get
            Set(ByVal Value As String)
                sUserID = Value
            End Set
        End Property

        Public Property Password() As String
            Get
                Return sPassword
            End Get
            Set(ByVal Value As String)
                sPassword = Value
            End Set
        End Property

        Public Property Library() As String
            Get
                Return sLibrary
            End Get
            Set(ByVal Value As String)
                sLibrary = Value
            End Set
        End Property

        Public Property CLProgram() As String
            Get
                Return sProgram
            End Get
            Set(ByVal Value As String)
                sProgram = Value
            End Set
        End Property

#End Region

#Region "Methods"
        Public Function Connect()
            If sServerName Is Nothing Then
                Throw New Exception("HostName property must be set to AS/400 IP or hostname prior to calling Connect method.")
            End If
            If sUserID Is Nothing Then
                Throw New Exception("UserID property must be set to AS/400 username prior to calling Connect method.")
            End If
            If sPassword Is Nothing Then
                Throw New Exception("Password property must be set to AS/400 user's password prior to calling Connect method.")
            End If
            If sLibrary Is Nothing Then
                Throw New Exception("Library property must be set to AS/400 library prior to calling Connect method.")
            End If

            ' Connect
            ' Grab the library, username, password, etc from the properties
            Try
                as400.Define(sServerName)
                program.system = as400
                program.system.UserID = sUserID
                program.system.Password = sPassword
                program.system.PromptMode = cwbx.cwbcoPromptModeEnum.cwbcoPromptNever
                program.system.DefaultUserMode = cwbx.cwbcoDefaultUserModeEnum.cwbcoDefaultUserIgnore
                program.LibraryName = sLibrary
                program.ProgramName = sProgram
                program.system.UseSecureSockets = False

                as400.Signon()
            Catch g As Exception
                Throw New Exception("Failed to set AS/400 properties.", g)
            End Try

            ' Try to connect to 400
            Try
                as400.Connect(cwbx.cwbcoServiceEnum.cwbcoServiceRemoteCmd)
            Catch j As Exception
                Throw New Exception("Failed to connect with AS/400 - Please try again later.", j)
            End Try
        End Function

        Public Function Disconnect()
            ' Terminate connection
           
            as400.Disconnect(cwbx.cwbcoServiceEnum.cwbcoServiceAll)
            as400 = Nothing
        End Function

        Public Function RunProgram(ByVal itemId As String, ByVal customerId As Integer) As Array
            ' Check that required properties have been set
            If sProgram Is Nothing Then
                Throw New Exception("CLProgram property must be set to AS/400 program to call prior to calling this method.")
            End If

            ' Check that connection set
            If as400 Is Nothing Or as400.HasSignedOn = False Then
                Throw New Exception("Connect() method must be called before calling this method.")
            End If

            ' Prepare for call
            Dim stringConverter As cwbx.StringConverter = New cwbx.StringConverterClass
            Dim packedConverter As cwbx.PackedConverter = New cwbx.PackedConverterClass
            Dim floatConverter As cwbx.FloatConverter = New cwbx.FloatConverterClass

            Dim parameters As cwbx.ProgramParameters = New cwbx.ProgramParametersClass

            ' // ********************************************************
            ' // P55ADVP Program Parameters
            ' // ********************************************************

            ' // Parameter list for P55ADVP:
            ' //
            ' // Name   Size    Desc
            ' //
            ' // PSLITM 25,0    (Input) Alpha - Long Item Number
            ' // PSSHAN 8,0     (Input) Numeric - Customer Shipping ID
            ' // PSUPRC 15,4    (Output) Numeric - Adjusted Price
            ' // PSITM 195      (Output) Data Structure - Item Attributes

            ' Input Parameters
            parameters.Append("PSLITM", cwbx.cwbrcParameterTypeEnum.cwbrcInput, 25)
            stringConverter.Length = 25
            parameters("PSLITM").Value = stringConverter.ToBytes(itemId.PadRight(25, " "c))

            packedConverter.DecimalPosition = 0
            packedConverter.Digits = 8
            parameters.Append("PSSHAN", cwbx.cwbrcParameterTypeEnum.cwbrcInput, 8)
            parameters("PSSHAN").Value = packedConverter.ToBytes(customerId)

            'Output Parameters
            parameters.Append("PSUPRC", cwbx.cwbrcParameterTypeEnum.cwbrcOutput, 15)
            ' I tried passing a zero value here because the RPG guy told me it might work - it didn't
            'parameters("PSUPRC").Value = floatConverter.ToBytes(0)

            parameters.Append("PSITM", cwbx.cwbrcParameterTypeEnum.cwbrcOutput, 195)
            ' Same here - passed empty
            'parameters("PSITM").Value = stringConverter.ToBytes(" ")

            Try
                    ' ** Below line causes hang condition **
                    program.Call(parameters)
            Catch ex As Exception
                If as400.Errors.Count > 0 Then
                    Dim error400 As cwbx.Error
                    For Each error400 In as400.Errors
                        Throw New Exception("An error occured while attempting to call the program " & sProgram & " on the AS/400 - see stack trace for details.", ex)
                    Next
                End If

                If program.Errors.Count > 0 Then
                    Dim errorPgm As cwbx.Error
                    For Each errorPgm In program.Errors
                        Throw New Exception("An execution error occured while attempting to execute the program " & sProgram & " on the AS/400 - see stack trace for details.", ex)
                    Next
                End If
            End Try

            ' Lets return values from the 400 in the order they appear in the catalog, shall we?
            Dim itemStruc As New cwbx.Structure
            Dim i As Integer

            itemStruc.Bytes = parameters("PSITM").Value

            Dim byteLength As Integer
            byteLength = itemStruc.Length

            itemStruc.Fields.Append("SIITM", 8)
            itemStruc.Fields.Append("SILITM", 25)
            itemStruc.Fields.Append("SIITSZ", 15)
            itemStruc.Fields.Append("SIITUN", 15)
            itemStruc.Fields.Append("SIUNWT", 15)
            itemStruc.Fields.Append("SIUNPL", 15)
            itemStruc.Fields.Append("SIPLWT", 15)
            itemStruc.Fields.Append("SIGCLR", 25)
            itemStruc.Fields.Append("SIIUPC", 20)
            itemStruc.Fields.Append("SICUPC", 20)
            itemStruc.Fields.Append("SIPUPC", 20)
            itemStruc.Fields.Append("SIAMCR", 1)
            itemStruc.Fields.Append("SIGRGD", 1)

            '' Eventually I will return everything in an array but I am just testing a couple values below.
            Dim returnArr() As Object

            ReDim returnArr(0)

            stringConverter.Length = 15
            'returnArr(0) = stringConverter.FromBytes(itemStruc("SIITSZ").Value)

            returnArr(0) = packedConverter.FromBytes(parameters("PSUPRC").Value)
            ''returnArr(2) = byteLength.ToString

            Return returnArr
        End Function
#End Region
    End Class

End Namespace

[/code]


Calling like so:


[code]
        Dim talkTo400 As New InfoWebCore.GetItemData
        talkTo400.HostName = ConfigurationSettings.AppSettings("priceBookServer").ToString
        talkTo400.Library = ConfigurationSettings.AppSettings("priceBookLibrary").ToString
        talkTo400.UserID = ConfigurationSettings.AppSettings("priceBookUser").ToString
        talkTo400.Password = ConfigurationSettings.AppSettings("priceBookPassword").ToString
        talkTo400.CLProgram = ConfigurationSettings.AppSettings("priceBookProgram").ToString

        talkTo400.Connect()

        Dim outArray(0) As String
        Try
                    outArray = talkTo400.RunProgram("0253-0050-21", 148267)
        Catch f As Exception
                    Throw New Exception("An error has occured while attempting to gather necessary data. This is most likely due to high server load at this time. Please try again later. Error was: ", f)
        End Try


        ' Disconnect from the 400
        talkTo400.Disconnect()
[/code]


Regards,
Ken
Update - The ASP.Net worker process is not using an excessive amount of CPU (approx 0% in fact) nor does there seem to be a memory leak. I'm assuming this means the process is waiting for some type of response from the 400 or the 400 is waiting for a response from .Net. Not sure how to check if this is the case on the 400 - I have access to the 5250 emulator or whatever and have listed some kind of display log with the help of our RPG guy before - not sure if it captures all possible job hangs though. I'm a n00b when it comes to the 400.

Regards,
Ken
I found this post earlier but came back to it in light of recent occurances:
https://www.experts-exchange.com/questions/20123182/Calling-a-program-on-the-AS-400.html

By checking the job log I successfully determined that the program is not running during the hanging of my vb app.

In this post, the author found that remote program execution needed to be enabled on the 400 lest his program call would hang his VB app. I wonder if this is the magic bullet?

Unfortunately our AS/400 guy can't find the Remote Execution Server setting that he mentions in his last post - perhaps because we are running V5R3 and it looks like he is running something less than V5R1.

That being said - the expert who can tell us how to turn this setting on in this new rev of OS/400 gets the points and a respectful bow!

Thanks,
Ken
Evidently everyone was stumped on this one. I found a better way of doing the above.
would you care to share?
iboutchkine gets the points for his tips.

Turns out the AS/400 guy writes his programs without any kind of error handling and there were several SKUs being passed to it as parameters which were invalid in the JDEdwards system. As a result, the 400 threw no exceptions and would simply hang if this condition were encountered. Generally it will be rare on a going forward basis that we would be passing invalid SKUs but in the event we do, the only thing I could do is attempt to detect a timeout... pretty sloppy.

Thank you all for your help! I hope this aids someone else in their quest!

Here is the code I ended up using (fully working):

[code]
Imports System
Imports System.IO
Imports System.Data
Imports System.Configuration

Namespace InfoWebCore
    ''' -----------------------------------------------------------------------------
    ''' <summary>
    ''' This class is a wrapper for the Client Access Express API and  
    ''' P55ADVP program object for use in the PriceBook application
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks>
    ''' </remarks>
    ''' <history>
    '''       [KRT]      8/1/2006      Created
    ''' </history>
    ''' -----------------------------------------------------------------------------

    Public Class GetItemData

        Dim sServerName As String
        Dim sUserID As String
        Dim sPassword As String
        Dim sLibrary As String
        Dim sProgram As String
        Dim as400 As cwbx.AS400System = New cwbx.AS400SystemClass
        Dim program As cwbx.Program = New cwbx.Program

#Region "Properties"
        Public Property HostName() As String
            Get
                Return sServerName
            End Get
            Set(ByVal Value As String)
                sServerName = Value
            End Set
        End Property

        Public Property UserID() As String
            Get
                Return sUserID
            End Get
            Set(ByVal Value As String)
                sUserID = Value
            End Set
        End Property

        Public Property Password() As String
            Get
                Return sPassword
            End Get
            Set(ByVal Value As String)
                sPassword = Value
            End Set
        End Property

        Public Property Library() As String
            Get
                Return sLibrary
            End Get
            Set(ByVal Value As String)
                sLibrary = Value
            End Set
        End Property

        Public Property CLProgram() As String
            Get
                Return sProgram
            End Get
            Set(ByVal Value As String)
                sProgram = Value
            End Set
        End Property

#End Region

#Region "Methods"
        Public Function Connect()
            If sServerName Is Nothing Then
                Throw New Exception("HostName property must be set to AS/400 IP or hostname prior to calling Connect method.")
            End If
            If sUserID Is Nothing Then
                Throw New Exception("UserID property must be set to AS/400 username prior to calling Connect method.")
            End If
            If sPassword Is Nothing Then
                Throw New Exception("Password property must be set to AS/400 user's password prior to calling Connect method.")
            End If
            If sLibrary Is Nothing Then
                Throw New Exception("Library property must be set to AS/400 library prior to calling Connect method.")
            End If

            ' Grab the library, username, password, etc from the properties
            as400.Define(sServerName)
            program.system = as400
            program.system.UserID = sUserID
            program.system.Password = sPassword
            program.system.PromptMode = cwbx.cwbcoPromptModeEnum.cwbcoPromptNever
            program.system.DefaultUserMode = cwbx.cwbcoDefaultUserModeEnum.cwbcoDefaultUserIgnore
            program.LibraryName = sLibrary
            program.ProgramName = sProgram
            program.system.UseSecureSockets = False

            as400.Signon()
            ErrorHandling(as400, "signing on to the AS/400")

            ' Try to connect to 400
            as400.Connect(cwbx.cwbcoServiceEnum.cwbcoServiceRemoteCmd)
            ErrorHandling(as400, "connecting to the AS/400")
        End Function

        Private Function ErrorHandling(ByRef as400 As Object, ByVal op As String)
            If as400.Errors.Count > 0 Then
                Dim i As Integer
                Dim errText As String
                For i = 0 To as400.Errors.Count
                    errText &= as400.Errors.Item(i).Text & " "
                Next
                Throw New Exception("Error(s) were encountered while " & op & ": " & errText)
            End If
        End Function

        Private Function ProgErrorHandling(ByRef program As Object, ByVal op As String)
            If program.Errors.Count > 0 Then
                Dim i As Integer
                Dim errText As String
                For i = 0 To program.Errors.Count
                    errText &= program.Errors.Item(i).Text & " "
                Next
                Throw New Exception("Error(s) were encountered while " & op & ": " & errText)
            End If
        End Function

        Public Function Disconnect()
            If as400.IsConnected(cwbx.cwbcoServiceEnum.cwbcoServiceAll) Then
                as400.Disconnect(cwbx.cwbcoServiceEnum.cwbcoServiceAll)
            End If
            as400 = Nothing
        End Function

        Public Function RunProgram(ByVal itemId As String, ByVal customerId As Integer) As Array
            ' Check that required properties have been set
            If sProgram Is Nothing Then
                Throw New Exception("CLProgram property must be set to AS/400 program to call prior to calling this method.")
            End If

            ' Check that connection set
            If as400 Is Nothing Or as400.HasSignedOn = False Then
                Throw New Exception("Connect() method must be called before calling this method.")
            End If

            ' Prepare for call
            Dim stringConverter As cwbx.StringConverter = New cwbx.StringConverterClass
            Dim packedConverter As cwbx.PackedConverter = New cwbx.PackedConverterClass
            packedConverter.DecimalPosition = 0
            packedConverter.Digits = 8

            Dim floatConverter As cwbx.FloatConverter = New cwbx.FloatConverterClass

            Dim parameters As cwbx.ProgramParameters = New cwbx.ProgramParametersClass

            ' // ********************************************************
            ' // P55ADVP Program Parameters
            ' // ********************************************************

            ' // Parameter list for P55ADVP:
            ' //
            ' // Name   Size    Desc
            ' //
            ' // PSLITM 25,0    (Input) Alpha - Long Item Number
            ' // PSSHAN 8,0     (Input) Numeric - Customer Shipping ID
            ' // PSUPRC 15,4    (Output) Numeric - Adjusted Price
            ' // PSITM 195      (Output) Data Structure - Item Attributes

            ' Input Parameters
            parameters.Clear()

            parameters.Append("PSLITM", cwbx.cwbrcParameterTypeEnum.cwbrcInput, 25)
            stringConverter.Length = 25
            parameters("PSLITM").Value = stringConverter.ToBytes(itemId.PadRight(25, " "c))

            parameters.Append("PSSHAN", cwbx.cwbrcParameterTypeEnum.cwbrcInput, 8)
            parameters("PSSHAN").Value = packedConverter.ToBytes(customerId)

            'Output Parameters
            parameters.Append("PSUPRC", cwbx.cwbrcParameterTypeEnum.cwbrcOutput, 15)
            parameters.Append("PSITM", cwbx.cwbrcParameterTypeEnum.cwbrcOutput, 195)

            program.Call(parameters)

            ' Handle program-specific errors
            ProgErrorHandling(program, "calling remote program " & sProgram & " (program error)")

            ' Handle system errors
            ErrorHandling(as400, "calling remote program " & sProgram & " (system error)")

            ' Lets return values from the 400 in the order they appear in the catalog, shall we?
            Dim itemStruc As New cwbx.Structure
            Dim i As Integer

            itemStruc.Bytes = parameters("PSITM").Value

            Dim byteLength As Integer
            byteLength = itemStruc.Length

            itemStruc.Fields.Append("SIITM", 8)
            itemStruc.Fields.Append("SILITM", 25)
            itemStruc.Fields.Append("SIITSZ", 15)
            itemStruc.Fields.Append("SIITUN", 15)
            itemStruc.Fields.Append("SIUNWT", 15)
            itemStruc.Fields.Append("SIUNPL", 15)
            itemStruc.Fields.Append("SIPLWT", 15)
            itemStruc.Fields.Append("SIGCLR", 25)
            itemStruc.Fields.Append("SIIUPC", 20)
            itemStruc.Fields.Append("SICUPC", 20)
            itemStruc.Fields.Append("SIPUPC", 20)
            itemStruc.Fields.Append("SIAMCR", 1)
            itemStruc.Fields.Append("SIGRGD", 1)

            Dim returnArr(6) As String

            stringConverter.Length = 15
            returnArr(0) = stringConverter.FromBytes(itemStruc("SIITSZ").Value)
            returnArr(1) = stringConverter.FromBytes(itemStruc("SIITUN").Value)
            returnArr(2) = stringConverter.FromBytes(itemStruc("SIUNWT").Value)
            returnArr(3) = stringConverter.FromBytes(itemStruc("SIUNPL").Value)
            returnArr(4) = stringConverter.FromBytes(itemStruc("SIPLWT").Value)

            stringConverter.Length = 25
            returnArr(5) = stringConverter.FromBytes(itemStruc("SIGCLR").Value)

            packedConverter.DecimalPosition = 4
            packedConverter.Digits = 15
            returnArr(6) = packedConverter.FromBytes(parameters.Item("PSUPRC").Value)

            'stringConverter.Length = 20
            'returnArr(6) = stringConverter.FromBytes(itemStruc("SIIUPC").Value)
            'returnArr(7) = stringConverter.FromBytes(itemStruc("SICUPC").Value)
            'returnArr(8) = stringConverter.FromBytes(itemStruc("SIPUPC").Value)
            'returnArr(9) = stringConverter.FromBytes(itemStruc("SIAMCR").Value)
            'returnArr(10) = stringConverter.FromBytes(itemStruc("SIGRGD").Value)

            Return returnArr
        End Function
#End Region
    End Class

End Namespace

[/code]

I am calling all of this by first instantiating a dynamic VPN connection to our corporate HQ (shady, but this is the best we can do for now):

[code]
        ' Connect to HQ VPN
        Dim pbEntry As Ras.PhoneBookEntry = Ras.PhoneBook.Open.Entries.Item("HQ")
        pbEntry.Dial()

        ' After successful connection, grab acquired IP and add to require route statement
        While Not pbEntry.Connected
            ' Wait for successful connection
        End While

        Dim pptpAddr As String

        'This doesn't work correctly for some reason - blaming the wrapper programmer!
        'pptpAddr = pbEntry.IpAddress.ToString

        Dim objSearcher As ManagementObjectSearcher = New ManagementObjectSearcher("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = 'TRUE'")
        Dim objCollection As ManagementObjectCollection = objSearcher.Get()
        Dim obj As ManagementObject

        For Each obj In objCollection
            ' Iterate through all IP addresses of the current network interface
            If obj.Item("Description") = "WAN (PPP/SLIP) Interface" Then
                Dim AddressList() As String = CType(obj("IPAddress"), Array)

                Dim Address As String
                For Each Address In AddressList
                    ' Grab the primary IP of the PPTP connection
                    pptpAddr = Address
                Next
            End If
        Next

        ' Have to add a static route each time so that we can map the 400
        Dim sRoute As String = "add " & ConfigurationSettings.AppSettings("priceBookServer").ToString & " mask 255.255.255.255 " & _
            pptpAddr

        System.Diagnostics.Process.Start("route", sRoute)

        Call buildDoc()

        ' Disconnect the VPN tunnel
        ' Lets ensure that nobody else is using the connection before killing it..
        If pbEntry.Connected Then
            pbEntry.Close()
        End If
[/code]

[code]
    Private Sub buildDoc()
        ' Setup the PDF template and start reading fields
        Dim outStream As MemoryStream = New MemoryStream
        Dim inForm As Form = New Form(Server.MapPath(ConfigurationSettings.AppSettings("priceBookTemplate-FL").ToString), outStream)
        Dim tableField As String

        ' Instantiate connection to 400 through encrypted tunnel
        Dim talkTo400 As New InfoWebCore.GetItemData
        talkTo400.HostName = ConfigurationSettings.AppSettings("priceBookServer").ToString
        talkTo400.Library = ConfigurationSettings.AppSettings("priceBookLibrary").ToString
        talkTo400.UserID = ConfigurationSettings.AppSettings("priceBookUser").ToString
        talkTo400.Password = ConfigurationSettings.AppSettings("priceBookPassword").ToString
        talkTo400.CLProgram = ConfigurationSettings.AppSettings("priceBookProgram").ToString

        Try
            talkTo400.Connect()
        Catch ex As Exception
            Throw New Exception("An error occured when attempting to connect to the ERP System.", ex)
        End Try

        ' For each field, determine if data from 400 is required
        ' Now iterate through each form field - we're interested in the prefix right now (item SKU)
        Dim a As Decimal
        Dim totalFields As Decimal = inForm.FieldsNames.Length

        For Each tableField In inForm.FieldsNames
            ' If user cancels creation, abort.
            If Application("cancelbuild_" & Session.SessionID) = True Then
                talkTo400.Disconnect()
                talkTo400 = Nothing
                Response.Redirect("default.aspx")
            End If

            Dim sData As String

            ' Field names should look something like "0253-0025-22-1_ITEMNO"
            If Not (Left(tableField, 6) = "HEADER") Then
                Dim itemSku As String = Split(tableField, "_")(0)
                Dim tableColumn As String = Split(tableField, "_")(1)

                ' If so, grab it
                Dim outArray(0) As String
                Dim errorArray(0) As String

                Try
                    outArray = talkTo400.RunProgram(itemSku, 148267)
                Catch ex As Exception
                    Throw New Exception("An error occured while attempting to get item data for SKU: " & itemSku, ex)
                    ' Instead of throwing an exception we should probably just put "Item Error" in the fields and continue
                    'sData = "Item Error"
                End Try

                Select Case tableColumn
                    Case "SIZE"
                        If sData <> "Item Error" Then
                            sData = outArray(0).ToString
                            If Trim(sData) = "" Then
                                sData = "No Data"
                            End If
                        End If
                        inForm.FillField(tableField, sData)

                        ' Make this field un-editable
                        inForm.FlattenField(tableField)
                    Case "UNIT"
                        If sData <> "Item Error" Then
                            sData = outArray(1).ToString
                            If Trim(sData) = "" Then
                                sData = "No Data"
                            End If
                        End If
                        inForm.FillField(tableField, sData)

                        ' Make this field un-editable
                        inForm.FlattenField(tableField)
                    Case "UNITWT"
                        If sData <> "Item Error" Then
                            sData = outArray(2).ToString
                            If Trim(sData) = "" Then
                                sData = "No Data"
                            End If
                        End If
                        inForm.FillField(tableField, sData)

                        ' Make this field un-editable
                        inForm.FlattenField(tableField)
                    Case "UNITPALLET"
                        If sData <> "Item Error" Then
                            sData = CInt(outArray(3)).ToString
                            If Trim(sData) = "0" Then
                                sData = "No Data"
                            End If
                        End If
                        inForm.FillField(tableField, sData)

                        ' Make this field un-editable
                        inForm.FlattenField(tableField)
                    Case "PALLETWT"
                        If sData <> "Item Error" Then
                            sData = outArray(4).ToString
                            If Trim(sData) = "" Then
                                sData = "No Data"
                            End If
                        End If
                        inForm.FillField(tableField, sData)

                        ' Make this field un-editable
                        inForm.FlattenField(tableField)
                    Case "COLOR"
                        If sData <> "Item Error" Then
                            sData = outArray(5).ToString
                            If Trim(sData) = "" Then
                                sData = "N/A"
                            End If
                        End If
                        inForm.FillField(tableField, sData)

                        ' Make this field un-editable
                        inForm.FlattenField(tableField)
                    Case "ITEMNO"
                        inForm.FillField(tableField, itemSku)

                        ' Make this field un-editable
                        inForm.FlattenField(tableField)
                    Case "PRICE"
                        ' Output the final price in USD with the specified GPM applied
                        'sData = FormatCurrency(Session("dGpm") * (0.0001 * CDec(outArray(1))))
                        If sData <> "Item Error" Then
                            sData = FormatCurrency(CDec(outArray(6)))
                            If Trim(sData) = "$0.00" Then
                                sData = "No Data"
                            End If
                        End If
                        inForm.FillField(tableField, sData)
                End Select
            Else
                ' We will assume this is a front page field and fill as such
                Dim addressField As String = Split(tableField, "_")(1)

            End If

            ' Update progressbar
            a += (100 / totalFields)
            Application("progress_" & Session.SessionID) = CInt(a)
            sData = Nothing
        Next

        ' Tell progressbar we are done
        Application("complete_" & Session.SessionID) = True

        Response.ClearContent()
        Response.Buffer() = True
        Response.AddHeader("content-disposition", "inline; filename=" + "Pricebook.pdf")
        Response.ContentType = "application/pdf"
        inForm.Save()

        Response.BinaryWrite(outStream.GetBuffer())
        outStream.Close()

        ' Disconnect from the 400
        talkTo400.Disconnect()
        talkTo400 = Nothing
    End Sub
[/code]