0

I would like to call IBM commands on the AS400 from either some external API or REST endpoint. Does IBM i / AS400 provide anything like this?

secondbreakfast
  • 4,194
  • 5
  • 47
  • 101

4 Answers4

2

There is a service program called XMLSERVICE which is included with any reasonably recent IBM i, and it is a fairly simple way for any client to communicate with the i, including issuing IBM i commands and receiving parameters back from IBM i programs. It accepts multiple "transport" methods, including HTTP and ODBC.

There are wrappers for XMLSERVICE in various programming languages, such as Python, JavaScript (Node.js), PHP, and Ruby. If you are comfortable with any of these languages, or can find a version of itoolkit for the language of your choice, it is quite easy to use.

If you cannot choose what method is going to be used on the client side, and are looking to set up something very standardized like a RESTful HTTP interface on the IBM i, then you can easily do that using one of numerous available options, including again Python and Node.js, both of which have been packaged by IBM and provided for free and easy installation.

John Y
  • 14,123
  • 2
  • 48
  • 72
2

If you are making this remote call from a Windows server, the IBM System i Access ActiveX Object Library (cwdx.dll) can be a good way to call the built-in IBM i commands as well as ILE programs written in RPG, CL, C, or C++.

The example code below is written in VB6/VBA, but this same technique can be used in any COM compatible Windows language (C++, C#, VB.Net, Delphi). Interestingly, this ActiveX call can sometimes allow SQL to run on a system where other remote SQL calls are blocked. For example, if I try to run the SQL DELETE command shown below via ODBC, OLE DB, or JDBC (IBM Data Studio); it would be blocked because the associated server job uses 'RMTFIL' and 'RMTOBJ' (Enforcive Objects Ver 8.3.0.0) to control SQL access. The server job associated with the remote ActiveX command does not have those limitations and can run any command that the user has rights to, just like on the command line.

Option Explicit

Sub Test_Run_RPG_Program()

    On Error Resume Next
    Dim system As AS400System
    Set system = ConnectToSystem
    If Err Then
        MsgBox "Could not connect to system." & vbCrLf & Err.Description
        Exit Sub
    End If

    Dim prog As Program
    Set prog = New Program
    prog.LibraryName = "MYLIB"
    prog.ProgramName = "MYPROG"
    Set prog.system = system

    On Error Resume Next
    prog.Call
    If Err Then
        MsgBox Err.Description
    End If
    system.Disconnect cwbcoServiceRemoteCmd

End Sub


Sub Test_Run_RPG_Program_Fail()

    On Error Resume Next
    Dim system As AS400System
    Set system = ConnectToSystem
    If Err Then
        MsgBox "Could not connect to system." & vbCrLf & Err.Description
        Exit Sub
    End If

    Dim prog As Program
    Set prog = New Program
    prog.LibraryName = "MYLIB"
    prog.ProgramName = "MYPROGXXX"
    Set prog.system = system

    On Error Resume Next
    prog.Call
    If Err Then
        '-2147467259  &H80004005        "MCH3401 - Cannot resolve to object MYPROGXXX. Type and Subtype X'0201' Authority X'0000'."
        MsgBox Err.Description
    End If
    system.Disconnect cwbcoServiceRemoteCmd

End Sub


Sub Test_Run_Command()

    On Error Resume Next
    Dim system As AS400System
    Set system = ConnectToSystem
    If Err Then
        MsgBox "Could not connect to system." & vbCrLf & Err.Description
        Exit Sub
    End If

    Dim comm As cwbx.Command
    Set comm = New cwbx.Command
    Set comm.system = system
    comm.Run "DSPLIB MYLIB"       'prints output file like in batch mode
    If Err Then
        MsgBox comm.errors.Count
        MsgBox Err.Description
    End If
    system.Disconnect cwbcoServiceRemoteCmd     'Does disconnect do anything?  Active Job remains until AS400System destructor runs

End Sub


Sub Test_Run_Command_Fail()

    On Error Resume Next
    Dim system As AS400System
    Set system = ConnectToSystem
    If Err Then
        MsgBox "Could not connect to system." & vbCrLf & Err.Description
        Exit Sub
    End If

    Dim comm As cwbx.Command
    Set comm = New cwbx.Command
    Set comm.system = system
    comm.Run "DSPF"
    If Err Then
       MsgBox Err.Description & vbCrLf & vbCrLf & FormatError(comm.errors)
        'Error occurred in IBM i Access Library. Command failed.
        'CPF0001 - Error found on DSPF command.
        'CPD0031 - Command DSPF not allowed in this setting.
    End If
    system.Disconnect cwbcoServiceRemoteCmd     'Does disconnect do anything?  Active Job remains until AS400System destructor runs

End Sub



Sub Test_Run_RUNSQL_Delete()           'Succeeded, no Err

    On Error Resume Next
    Dim system As AS400System
    Set system = ConnectToSystem
    If Err Then
        MsgBox "Could not connect to system." & vbCrLf & Err.Description
        Exit Sub
    End If

    Dim comm As cwbx.Command
    Set comm = New cwbx.Command
    Set comm.system = system
    Dim commandStr As String
    commandStr = "RUNSQL SQL('DELETE FROM MYLIB.MYFILE WHERE MYFIELD = ''ABCDEFG''') COMMIT(*NONE) NAMING(*SQL)"
    comm.Run commandStr
    If Err Then
       MsgBox Err.Description & vbCrLf & vbCrLf & FormatError(comm.errors)
    End If
    system.Disconnect cwbcoServiceRemoteCmd     'Does disconnect do anything?  Active Job remains until AS400System destructor runs
End Sub

Sub Test_Run_RUNSQL_Insert()           'Succeeded, no Err

    On Error Resume Next
    Dim system As AS400System
    Set system = ConnectToSystem
    If Err Then
        MsgBox "Could not connect to system." & vbCrLf & Err.Description
        Exit Sub
    End If

    Dim comm As cwbx.Command
    Set comm = New cwbx.Command
    Set comm.system = system
    Dim commandStr As String
    commandStr = "RUNSQL SQL('INSERT INTO MYLIB.MYFILE (FIELD1, FIELD2, FIELD3) VALUES (''ABCDEFG'', 6000, 10.34)') COMMIT(*NONE) NAMING(*SQL)"
    comm.Run commandStr
    If Err Then
       MsgBox Err.Description & vbCrLf & vbCrLf & FormatError(comm.errors)
    End If
    system.Disconnect cwbcoServiceRemoteCmd
End Sub


Sub Test_Run_RUNSQL_SELECT_Fail()

'Fails because SELECT statement not supported by RUNSQL.
'Would fail on command line too with status message of 'RUNSQLSTM or RUNSQL command failed.'

    On Error Resume Next
    Dim system As AS400System
    Set system = ConnectToSystem
    If Err Then
        MsgBox "Could not connect to system." & vbCrLf & Err.Description
        Exit Sub
    End If

    Dim comm As cwbx.Command
    Set comm = New cwbx.Command
    Set comm.system = system
    Dim commandStr As String
    commandStr = "RUNSQL SQL('SELECT REGEXP_MATCH_COUNT(S,''^([F][W])|([L][F])[0-9]{4}[Y,N]$'') FROM (SELECT ''LF7002N'' AS S FROM SYSIBM.SYSDUMMY1) AS A') COMMIT(*NONE) NAMING(*SQL)"
    comm.Run commandStr
    If Err Then
       MsgBox Err.Description & vbCrLf & vbCrLf & FormatError(comm.errors)
    End If
    system.Disconnect cwbcoServiceRemoteCmd     'Does disconnect do anything?  Active Job remains until AS400System destructor runs
End Sub


Private Function ConnectToSystem() As AS400System

    On Error Resume Next
    Dim system As AS400System
    Set system = New AS400System
    system.Define "xxx.xxx.xxx.xxx"    'an IP address usually goes here
    system.Connect cwbcoServiceRemoteCmd
    Set ConnectToSystem = system
End Function



Private Function FormatError(ByVal errorList As cwbx.errors) As String

    If errorList Is Nothing Then
        FormatError = ""
        Exit Function
    End If

    Dim errItem As cwbx.Error
    Dim errMsg As String

    errMsg = Build_ProgramCommand_ReturnCode_Message(errorList.ReturnCode) & vbCrLf
    For Each errItem In errorList
        errMsg = errMsg & errItem.Text & vbCrLf
    Next
    'Debug.Print Mid$(errMsg, 1, Len(errMsg) - 2)
    FormatError = Mid$(errMsg, 1, Len(errMsg) - 2)
End Function



Private Function Build_ProgramCommand_ReturnCode_Message(ByVal return_code As Long)

    'Program and Command Return Code Constants

    Dim errMsg As String
    errMsg = "Error occurred in IBM i Access Library. "
    Select Case return_code
        Case Is = cwbrcInvalidSystemHandle: Build_ProgramCommand_ReturnCode_Message = errMsg & "Invalid system handle."      '6000
        Case Is = cwbrcInvalidProgram:      Build_ProgramCommand_ReturnCode_Message = errMsg & "Invalid program."            '6001
        Case Is = cwbrcSystemName:          Build_ProgramCommand_ReturnCode_Message = errMsg & "Bad System Name."            '6002
        Case Is = cwbrcCommandString:       Build_ProgramCommand_ReturnCode_Message = errMsg & "Bad command string."         '6003
        Case Is = cwbrcProgramName:         Build_ProgramCommand_ReturnCode_Message = errMsg & "Bad program name."           '6004
        Case Is = cwbrcLibraryName:         Build_ProgramCommand_ReturnCode_Message = errMsg & "Bad library name."           '6005
        Case Is = cwbrcInvalidType:         Build_ProgramCommand_ReturnCode_Message = errMsg & "Invalid data type"           '6006
        Case Is = cwbrcInvalidParmLength:   Build_ProgramCommand_ReturnCode_Message = errMsg & "Invalid parameter length."   '6007
        Case Is = cwbrcInvalidParm:         Build_ProgramCommand_ReturnCode_Message = errMsg & "Invalid parameter."          '6008
        Case Is = cwbrcTooManyParms:        Build_ProgramCommand_ReturnCode_Message = errMsg & "Too many parameters."        '6009
        Case Is = cwbrcIndexRangeError:     Build_ProgramCommand_ReturnCode_Message = errMsg & "Index out of range."         '6010
        Case Is = cwbrcRejectedUserExit:    Build_ProgramCommand_ReturnCode_Message = errMsg & "User rejected."              '6011
        Case Is = cwbrcUserExitError:       Build_ProgramCommand_ReturnCode_Message = errMsg & "User error."                 '6012
        Case Is = cwbrcCommandFailed:       Build_ProgramCommand_ReturnCode_Message = errMsg & "Command failed."             '6013
        Case Is = cwbrcProgramNotFound:     Build_ProgramCommand_ReturnCode_Message = errMsg & "Program not found."          '6014
        Case Is = cwbrcProgramError:        Build_ProgramCommand_ReturnCode_Message = errMsg & "Program error."              '6015
        Case Is = cwbrcCommandTooLong:      Build_ProgramCommand_ReturnCode_Message = errMsg & "Command too long."           '6016
        Case Is = cwbrcUnexpectedError:     Build_ProgramCommand_ReturnCode_Message = errMsg & "Unexpected error."           '6099
        Case Else:                          Build_ProgramCommand_ReturnCode_Message = errMsg & "Unrecognised error."
    End Select
End Function



'    Dim hostMessageLibraryName As Variant   'Upon successful completion, contains the name of the library containing the system message file.
'    Dim hostMessageFileName As Variant      'Upon successful completion, contains the name of the system message file.
'    Dim hostSubstitutionText As Variant     'Upon successful completion, contains the message substitution text.
'                                            'The substitution text is the data inserted into the substitution variable fields defined for the message.
'                                            'This information is returned in the host code page. This is the format required by the QMHRTVM API.
'
'    errItem.GetHostMessageInfo hostMessageLibraryName, hostMessageFileName, hostSubstitutionText
Mike
  • 1,274
  • 10
  • 24
  • I really appreciate you taking the time to answer this even after there was already an accepted answer. Thank you for you knowledge! – secondbreakfast Feb 10 '20 at 02:12
  • @zero01alpha You are welcome. This was just pasted from some experimenting with the `cwdx.dll` that I did a few years ago with the real names and IP address changed. If it helps someone out, I am happy to share it since these things are not that well documented. – Mike Feb 10 '20 at 16:08
1

They have API's for that, and jtOpen on sourceforge. You might also want to look at Ublu.

jmarkmurphy
  • 11,030
  • 31
  • 59
1

Besides http, the FTP server on IBM i knowns a rcmd command.

PoC
  • 521
  • 3
  • 13