Можно ли запускать команды IBM i / AS400 из HTTP или других внешних средств?

Question

Я хотел бы вызывать команды IBM на AS400 из какого-либо внешнего API или конечной точки REST. Предоставляет ли IBM i / AS400 что-нибудь подобное?

Answer 1

Если вы выполняете этот удаленный вызов с сервера Windows, библиотека объектов ActiveX IBM System i Access (cwdx.dll) может быть хорошим способом вызова встроенных команд IBM i, а также написанных программ ILE. в RPG, CL, C или C ++.

Пример кода ниже написан на VB6 / VBA, но эту же технику можно использовать на любом COM-совместимом Windows языке (C ++, C#, VB. Net, Delphi). Интересно, что этот вызов ActiveX может иногда позволить SQL работать в системе, где другие удаленные вызовы SQL заблокированы. Например, если я попытаюсь выполнить команду SQL DELETE, показанную ниже, через ODB C, OLE DB или JDB C (IBM Data Studio); оно будет заблокировано, потому что соответствующее задание сервера использует «RMTFIL» и «RMTOBJ» (Enforcive Objects Ver 8.3.0.0) для управления доступом SQL. Задание сервера, связанное с удаленной командой ActiveX, не имеет этих ограничений и может запускать любую команду, на которую у пользователя есть права, как в командной строке.

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

Answer 2

Существует сервисная программа, называемая XMLSERVICE, которая входит в состав любого достаточно свежего IBM i, и для любого клиента это довольно простой способ связи с i, включая выдачу команд IBM i и получение параметров обратно из программ IBM i. Он принимает несколько «транспортных» методов, включая HTTP и ODB C.

. Существуют оболочки для XMLSERVICE на различных языках программирования, таких как Python, JavaScript (Node.js) , PHP и Ruby. Если вы знакомы с любым из этих языков или можете найти версию itoolkit для выбранного вами языка, его довольно просто использовать.

Если вы не можете выбрать, какой метод будет использоваться на на стороне клиента, и вы хотите настроить что-то очень стандартизированное, например, HTTP-интерфейс RESTful в IBM i, тогда вы можете легко сделать это, используя один из многочисленных доступных вариантов , включая снова Python и Node.js Оба они были упакованы IBM и предоставлены для бесплатной и простой установки.

Answer 3

Помимо http, FTP-сервер в IBM i знает команду rcmd.

Answer 4

У них есть API для этого и jtOpen на sourceforge. Вы также можете посмотреть на Ublu .