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.c wbcoPrompt Never
program.system.DefaultUser Mode = cwbx.cwbcoDefaultUserModeE num.cwbcoD efaultUser Ignore
program.LibraryName = sLibrary
program.ProgramName = sProgram
program.system.UseSecureSo ckets = 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.cwbcoSe rviceEnum. cwbcoServi ceRemoteCm d)
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.DecimalPos ition = 0
packedConverter.Digits = 8
Dim floatConverter As cwbx.FloatConverter = New cwbx.FloatConverterClass
Dim parameters As cwbx.ProgramParameters = New cwbx.ProgramParametersClas s
' // ************************** ********** ********** **********
' // 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.cwbrcParameterTypeEnu m.cwbrcInp ut, 25)
stringConverter.Length = 25
parameters("PSLITM").Value = stringConverter.ToBytes(it emId.PadRi ght(25, " "c))
parameters.Append("PSSHAN" , cwbx.cwbrcParameterTypeEnu m.cwbrcInp ut, 8)
parameters("PSSHAN").Value = packedConverter.ToBytes(cu stomerId)
'Output Parameters
parameters.Append("PSUPRC" , cwbx.cwbrcParameterTypeEnu m.cwbrcOut put, 15)
' I tried passing a zero value here because the RPG guy told me it might work - it didn't
'parameters("PSUPRC").Valu e = floatConverter.ToBytes(0)
parameters.Append("PSITM", cwbx.cwbrcParameterTypeEnu m.cwbrcOut put, 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("S IITM", 8)
itemStruc.Fields.Append("S ILITM", 25)
itemStruc.Fields.Append("S IITSZ", 15)
itemStruc.Fields.Append("S IITUN", 15)
itemStruc.Fields.Append("S IUNWT", 15)
itemStruc.Fields.Append("S IUNPL", 15)
itemStruc.Fields.Append("S IPLWT", 15)
itemStruc.Fields.Append("S IGCLR", 25)
itemStruc.Fields.Append("S IIUPC", 20)
itemStruc.Fields.Append("S ICUPC", 20)
itemStruc.Fields.Append("S IPUPC", 20)
itemStruc.Fields.Append("S IAMCR", 1)
itemStruc.Fields.Append("S IGRGD", 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.DecimalPos ition = 4
packedConverter.Digits = 15
returnArr(1) = packedConverter.FromBytes( parameters ("PSUPRC") .Value)
returnArr(2) = byteLength.ToString
' Finally, disconnect
as400.Disconnect(cwbx.cwbc oServiceEn um.cwbcoSe rviceAll)
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.AppS ettings("p riceBookSe rver").ToS tring
talkTo400.Library = ConfigurationSettings.AppS ettings("p riceBookLi brary").To String
talkTo400.UserID = ConfigurationSettings.AppS ettings("p riceBookUs er").ToStr ing
talkTo400.Password = ConfigurationSettings.AppS ettings("p riceBookPa ssword").T oString
talkTo400.Program = ConfigurationSettings.AppS ettings("p riceBookPr ogram").To String
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.cwbrcParameterTypeEnu m 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!
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.c
program.system.DefaultUser
program.LibraryName = sLibrary
program.ProgramName = sProgram
program.system.UseSecureSo
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.cwbcoSe
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.DecimalPos
packedConverter.Digits = 8
Dim floatConverter As cwbx.FloatConverter = New cwbx.FloatConverterClass
Dim parameters As cwbx.ProgramParameters = New cwbx.ProgramParametersClas
' // **************************
' // 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"
stringConverter.Length = 25
parameters("PSLITM").Value
parameters.Append("PSSHAN"
parameters("PSSHAN").Value
'Output Parameters
parameters.Append("PSUPRC"
' I tried passing a zero value here because the RPG guy told me it might work - it didn't
'parameters("PSUPRC").Valu
parameters.Append("PSITM",
' Same here - passed empty
'parameters("PSITM").Value
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("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
' 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(
packedConverter.DecimalPos
packedConverter.Digits = 15
returnArr(1) = packedConverter.FromBytes(
returnArr(2) = byteLength.ToString
' Finally, disconnect
as400.Disconnect(cwbx.cwbc
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.AppS
talkTo400.Library = ConfigurationSettings.AppS
talkTo400.UserID = ConfigurationSettings.AppS
talkTo400.Password = ConfigurationSettings.AppS
talkTo400.Program = ConfigurationSettings.AppS
talkTo400.UseSSL = False
Dim outArray() As String
Dim tidbit As String
Try
outArray = talkTo400.RunProgram("0253
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.cwbrcParameterTypeEnu
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!
ASKER
I've increased the point total as this does deal with some esoteric subject matter!
- Ken
- Ken
ASKER
Another point increase - let's spice things up.
- Ken
- Ken
ASKER
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)
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)
ASKER
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
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
ASKER
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=I BMDA400;DA TA 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. CreatePara meter("PSL ITM", DataTypeEnum.adChar, ParameterDirectionEnum.adP aramInputO utput, 25))
AS400Pgm.Parameters.Append (AS400Pgm. CreatePara meter("PSS HAN", DataTypeEnum.adChar, ParameterDirectionEnum.adP aramInputO utput, 8))
AS400Pgm.Parameters.Append (AS400Pgm. CreatePara meter("PSU PRC", DataTypeEnum.adChar, ParameterDirectionEnum.adP aramInputO utput, 15))
AS400Pgm.Parameters.Append (AS400Pgm. CreatePara meter("PSI TM", DataTypeEnum.adChar, ParameterDirectionEnum.adP aramInputO utput, 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(GetTy pe(Object) , 3)
Parms.Initialize()
Parms.SetValue(itemId.PadR ight(25, " "c), 0)
Parms.SetValue(CInt(custom erId), 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").Va lue
returnArr(0) = AS400Pgm.Parameters.Item(" PSUPRC").V alue
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.AppS ettings("p riceBookSe rver").ToS tring
talkTo400.Library = ConfigurationSettings.AppS ettings("p riceBookLi brary").To String
talkTo400.UserID = ConfigurationSettings.AppS ettings("p riceBookUs er").ToStr ing
talkTo400.Password = ConfigurationSettings.AppS ettings("p riceBookPa ssword").T oString
talkTo400.Program = ConfigurationSettings.AppS ettings("p riceBookPr ogram").To String
talkTo400.Connect()
Dim outArray(0) As String
Try
outArray = talkTo400.RunProgram(itemS ku, 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
[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=I
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.Parameters.Append
AS400Pgm.Parameters.Append
AS400Pgm.Parameters.Append
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(GetTy
Parms.Initialize()
Parms.SetValue(itemId.PadR
Parms.SetValue(CInt(custom
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("
returnArr(0) = AS400Pgm.Parameters.Item("
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.AppS
talkTo400.Library = ConfigurationSettings.AppS
talkTo400.UserID = ConfigurationSettings.AppS
talkTo400.Password = ConfigurationSettings.AppS
talkTo400.Program = ConfigurationSettings.AppS
talkTo400.Connect()
Dim outArray(0) As String
Try
outArray = talkTo400.RunProgram(itemS
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
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
ASKER
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
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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
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
ASKER
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.
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
ASKER
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
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
ASKER
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.c wbcoPrompt Never
program.system.DefaultUser Mode = cwbx.cwbcoDefaultUserModeE num.cwbcoD efaultUser Ignore
program.LibraryName = sLibrary
program.ProgramName = sProgram
program.system.UseSecureSo ckets = 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.cwbcoSe rviceEnum. cwbcoServi ceRemoteCm d)
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.cwbc oServiceEn um.cwbcoSe rviceAll)
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.ProgramParametersClas s
' // ************************** ********** ********** **********
' // 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.cwbrcParameterTypeEnu m.cwbrcInp ut, 25)
stringConverter.Length = 25
parameters("PSLITM").Value = stringConverter.ToBytes(it emId.PadRi ght(25, " "c))
packedConverter.DecimalPos ition = 0
packedConverter.Digits = 8
parameters.Append("PSSHAN" , cwbx.cwbrcParameterTypeEnu m.cwbrcInp ut, 8)
parameters("PSSHAN").Value = packedConverter.ToBytes(cu stomerId)
'Output Parameters
parameters.Append("PSUPRC" , cwbx.cwbrcParameterTypeEnu m.cwbrcOut put, 15)
' I tried passing a zero value here because the RPG guy told me it might work - it didn't
'parameters("PSUPRC").Valu e = floatConverter.ToBytes(0)
parameters.Append("PSITM", cwbx.cwbrcParameterTypeEnu m.cwbrcOut put, 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("S IITM", 8)
itemStruc.Fields.Append("S ILITM", 25)
itemStruc.Fields.Append("S IITSZ", 15)
itemStruc.Fields.Append("S IITUN", 15)
itemStruc.Fields.Append("S IUNWT", 15)
itemStruc.Fields.Append("S IUNPL", 15)
itemStruc.Fields.Append("S IPLWT", 15)
itemStruc.Fields.Append("S IGCLR", 25)
itemStruc.Fields.Append("S IIUPC", 20)
itemStruc.Fields.Append("S ICUPC", 20)
itemStruc.Fields.Append("S IPUPC", 20)
itemStruc.Fields.Append("S IAMCR", 1)
itemStruc.Fields.Append("S IGRGD", 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.AppS ettings("p riceBookSe rver").ToS tring
talkTo400.Library = ConfigurationSettings.AppS ettings("p riceBookLi brary").To String
talkTo400.UserID = ConfigurationSettings.AppS ettings("p riceBookUs er").ToStr ing
talkTo400.Password = ConfigurationSettings.AppS ettings("p riceBookPa ssword").T oString
talkTo400.CLProgram = ConfigurationSettings.AppS ettings("p riceBookPr ogram").To String
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
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.c
program.system.DefaultUser
program.LibraryName = sLibrary
program.ProgramName = sProgram
program.system.UseSecureSo
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.cwbcoSe
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.cwbc
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.ProgramParametersClas
' // **************************
' // 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"
stringConverter.Length = 25
parameters("PSLITM").Value
packedConverter.DecimalPos
packedConverter.Digits = 8
parameters.Append("PSSHAN"
parameters("PSSHAN").Value
'Output Parameters
parameters.Append("PSUPRC"
' I tried passing a zero value here because the RPG guy told me it might work - it didn't
'parameters("PSUPRC").Valu
parameters.Append("PSITM",
' Same here - passed empty
'parameters("PSITM").Value
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("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
'' 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(
returnArr(0) = packedConverter.FromBytes(
''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.AppS
talkTo400.Library = ConfigurationSettings.AppS
talkTo400.UserID = ConfigurationSettings.AppS
talkTo400.Password = ConfigurationSettings.AppS
talkTo400.CLProgram = ConfigurationSettings.AppS
talkTo400.Connect()
Dim outArray(0) As String
Try
outArray = talkTo400.RunProgram("0253
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
ASKER
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
Regards,
Ken
ASKER
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
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
ASKER
Evidently everyone was stumped on this one. I found a better way of doing the above.
would you care to share?
ASKER
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.c wbcoPrompt Never
program.system.DefaultUser Mode = cwbx.cwbcoDefaultUserModeE num.cwbcoD efaultUser Ignore
program.LibraryName = sLibrary
program.ProgramName = sProgram
program.system.UseSecureSo ckets = False
as400.Signon()
ErrorHandling(as400, "signing on to the AS/400")
' Try to connect to 400
as400.Connect(cwbx.cwbcoSe rviceEnum. cwbcoServi ceRemoteCm d)
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).Tex t & " "
Next
Throw New Exception("Error(s) were encountered while " & op & ": " & errText)
End If
End Function
Public Function Disconnect()
If as400.IsConnected(cwbx.cwb coServiceE num.cwbcoS erviceAll) Then
as400.Disconnect(cwbx.cwbc oServiceEn um.cwbcoSe rviceAll)
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.DecimalPos ition = 0
packedConverter.Digits = 8
Dim floatConverter As cwbx.FloatConverter = New cwbx.FloatConverterClass
Dim parameters As cwbx.ProgramParameters = New cwbx.ProgramParametersClas s
' // ************************** ********** ********** **********
' // 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.cwbrcParameterTypeEnu m.cwbrcInp ut, 25)
stringConverter.Length = 25
parameters("PSLITM").Value = stringConverter.ToBytes(it emId.PadRi ght(25, " "c))
parameters.Append("PSSHAN" , cwbx.cwbrcParameterTypeEnu m.cwbrcInp ut, 8)
parameters("PSSHAN").Value = packedConverter.ToBytes(cu stomerId)
'Output Parameters
parameters.Append("PSUPRC" , cwbx.cwbrcParameterTypeEnu m.cwbrcOut put, 15)
parameters.Append("PSITM", cwbx.cwbrcParameterTypeEnu m.cwbrcOut put, 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("S IITM", 8)
itemStruc.Fields.Append("S ILITM", 25)
itemStruc.Fields.Append("S IITSZ", 15)
itemStruc.Fields.Append("S IITUN", 15)
itemStruc.Fields.Append("S IUNWT", 15)
itemStruc.Fields.Append("S IUNPL", 15)
itemStruc.Fields.Append("S IPLWT", 15)
itemStruc.Fields.Append("S IGCLR", 25)
itemStruc.Fields.Append("S IIUPC", 20)
itemStruc.Fields.Append("S ICUPC", 20)
itemStruc.Fields.Append("S IPUPC", 20)
itemStruc.Fields.Append("S IAMCR", 1)
itemStruc.Fields.Append("S IGRGD", 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.DecimalPos ition = 4
packedConverter.Digits = 15
returnArr(6) = packedConverter.FromBytes( parameters .Item("PSU PRC").Valu e)
'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_NetworkAdapterConfig uration 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.AppS ettings("p riceBookSe rver").ToS tring & " mask 255.255.255.255 " & _
pptpAddr
System.Diagnostics.Process .Start("ro ute", 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(Config urationSet tings.AppS ettings("p riceBookTe mplate-FL" ).ToString ), outStream)
Dim tableField As String
' Instantiate connection to 400 through encrypted tunnel
Dim talkTo400 As New InfoWebCore.GetItemData
talkTo400.HostName = ConfigurationSettings.AppS ettings("p riceBookSe rver").ToS tring
talkTo400.Library = ConfigurationSettings.AppS ettings("p riceBookLi brary").To String
talkTo400.UserID = ConfigurationSettings.AppS ettings("p riceBookUs er").ToStr ing
talkTo400.Password = ConfigurationSettings.AppS ettings("p riceBookPa ssword").T oString
talkTo400.CLProgram = ConfigurationSettings.AppS ettings("p riceBookPr ogram").To String
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(itemS ku, 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(tableFiel d, sData)
' Make this field un-editable
inForm.FlattenField(tableF ield)
Case "UNIT"
If sData <> "Item Error" Then
sData = outArray(1).ToString
If Trim(sData) = "" Then
sData = "No Data"
End If
End If
inForm.FillField(tableFiel d, sData)
' Make this field un-editable
inForm.FlattenField(tableF ield)
Case "UNITWT"
If sData <> "Item Error" Then
sData = outArray(2).ToString
If Trim(sData) = "" Then
sData = "No Data"
End If
End If
inForm.FillField(tableFiel d, sData)
' Make this field un-editable
inForm.FlattenField(tableF ield)
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(tableFiel d, sData)
' Make this field un-editable
inForm.FlattenField(tableF ield)
Case "PALLETWT"
If sData <> "Item Error" Then
sData = outArray(4).ToString
If Trim(sData) = "" Then
sData = "No Data"
End If
End If
inForm.FillField(tableFiel d, sData)
' Make this field un-editable
inForm.FlattenField(tableF ield)
Case "COLOR"
If sData <> "Item Error" Then
sData = outArray(5).ToString
If Trim(sData) = "" Then
sData = "N/A"
End If
End If
inForm.FillField(tableFiel d, sData)
' Make this field un-editable
inForm.FlattenField(tableF ield)
Case "ITEMNO"
inForm.FillField(tableFiel d, itemSku)
' Make this field un-editable
inForm.FlattenField(tableF ield)
Case "PRICE"
' Output the final price in USD with the specified GPM applied
'sData = FormatCurrency(Session("dG pm") * (0.0001 * CDec(outArray(1))))
If sData <> "Item Error" Then
sData = FormatCurrency(CDec(outArr ay(6)))
If Trim(sData) = "$0.00" Then
sData = "No Data"
End If
End If
inForm.FillField(tableFiel d, 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("conten t-disposit ion", "inline; filename=" + "Pricebook.pdf")
Response.ContentType = "application/pdf"
inForm.Save()
Response.BinaryWrite(outSt ream.GetBu ffer())
outStream.Close()
' Disconnect from the 400
talkTo400.Disconnect()
talkTo400 = Nothing
End Sub
[/code]
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.c
program.system.DefaultUser
program.LibraryName = sLibrary
program.ProgramName = sProgram
program.system.UseSecureSo
as400.Signon()
ErrorHandling(as400, "signing on to the AS/400")
' Try to connect to 400
as400.Connect(cwbx.cwbcoSe
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).Tex
Next
Throw New Exception("Error(s) were encountered while " & op & ": " & errText)
End If
End Function
Public Function Disconnect()
If as400.IsConnected(cwbx.cwb
as400.Disconnect(cwbx.cwbc
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.DecimalPos
packedConverter.Digits = 8
Dim floatConverter As cwbx.FloatConverter = New cwbx.FloatConverterClass
Dim parameters As cwbx.ProgramParameters = New cwbx.ProgramParametersClas
' // **************************
' // 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"
stringConverter.Length = 25
parameters("PSLITM").Value
parameters.Append("PSSHAN"
parameters("PSSHAN").Value
'Output Parameters
parameters.Append("PSUPRC"
parameters.Append("PSITM",
program.Call(parameters)
' Handle program-specific errors
ProgErrorHandling(program,
' 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("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
itemStruc.Fields.Append("S
Dim returnArr(6) As String
stringConverter.Length = 15
returnArr(0) = stringConverter.FromBytes(
returnArr(1) = stringConverter.FromBytes(
returnArr(2) = stringConverter.FromBytes(
returnArr(3) = stringConverter.FromBytes(
returnArr(4) = stringConverter.FromBytes(
stringConverter.Length = 25
returnArr(5) = stringConverter.FromBytes(
packedConverter.DecimalPos
packedConverter.Digits = 15
returnArr(6) = packedConverter.FromBytes(
'stringConverter.Length = 20
'returnArr(6) = stringConverter.FromBytes(
'returnArr(7) = stringConverter.FromBytes(
'returnArr(8) = stringConverter.FromBytes(
'returnArr(9) = stringConverter.FromBytes(
'returnArr(10) = stringConverter.FromBytes(
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
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("
Dim objCollection As ManagementObjectCollection
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.AppS
pptpAddr
System.Diagnostics.Process
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(Config
Dim tableField As String
' Instantiate connection to 400 through encrypted tunnel
Dim talkTo400 As New InfoWebCore.GetItemData
talkTo400.HostName = ConfigurationSettings.AppS
talkTo400.Library = ConfigurationSettings.AppS
talkTo400.UserID = ConfigurationSettings.AppS
talkTo400.Password = ConfigurationSettings.AppS
talkTo400.CLProgram = ConfigurationSettings.AppS
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_"
talkTo400.Disconnect()
talkTo400 = Nothing
Response.Redirect("default
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(itemS
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(tableFiel
' Make this field un-editable
inForm.FlattenField(tableF
Case "UNIT"
If sData <> "Item Error" Then
sData = outArray(1).ToString
If Trim(sData) = "" Then
sData = "No Data"
End If
End If
inForm.FillField(tableFiel
' Make this field un-editable
inForm.FlattenField(tableF
Case "UNITWT"
If sData <> "Item Error" Then
sData = outArray(2).ToString
If Trim(sData) = "" Then
sData = "No Data"
End If
End If
inForm.FillField(tableFiel
' Make this field un-editable
inForm.FlattenField(tableF
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(tableFiel
' Make this field un-editable
inForm.FlattenField(tableF
Case "PALLETWT"
If sData <> "Item Error" Then
sData = outArray(4).ToString
If Trim(sData) = "" Then
sData = "No Data"
End If
End If
inForm.FillField(tableFiel
' Make this field un-editable
inForm.FlattenField(tableF
Case "COLOR"
If sData <> "Item Error" Then
sData = outArray(5).ToString
If Trim(sData) = "" Then
sData = "N/A"
End If
End If
inForm.FillField(tableFiel
' Make this field un-editable
inForm.FlattenField(tableF
Case "ITEMNO"
inForm.FillField(tableFiel
' Make this field un-editable
inForm.FlattenField(tableF
Case "PRICE"
' Output the final price in USD with the specified GPM applied
'sData = FormatCurrency(Session("dG
If sData <> "Item Error" Then
sData = FormatCurrency(CDec(outArr
If Trim(sData) = "$0.00" Then
sData = "No Data"
End If
End If
inForm.FillField(tableFiel
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("conten
Response.ContentType = "application/pdf"
inForm.Save()
Response.BinaryWrite(outSt
outStream.Close()
' Disconnect from the 400
talkTo400.Disconnect()
talkTo400 = Nothing
End Sub
[/code]
ASKER
Just a thought :)