运行 IBM i / AS400 是否可以通过 HTTP 或其他外部方式发出命令？
Is it possible to run IBM i / AS400 commands from HTTP or some other external means?
我想从某些外部 API 或 REST 端点调用 AS400 上的 IBM 命令。 IBM i / AS400 是否提供类似的东西？
他们有 API's for that, and jtOpen on sourceforge. You might also want to look at Ublu.
有一个名为 XMLSERVICE 的服务程序包含在任何相当新的 IBM i 中，它是任何客户端与 i 通信的相当简单的方法，包括发出 IBM i 命令和从 IBM i 接收返回的参数程式。它接受多种 "transport" 方法，包括 HTTP 和 ODBC。
有各种编程语言的 XMLSERVICE 包装器，例如 Python, JavaScript (Node.js), PHP, and Ruby。如果您对这些语言中的任何一种感到满意，或者可以找到适合您选择的语言的 itoolkit 版本，它就非常容易使用。
如果您无法选择在客户端使用哪种方法，并且希望在 IBM i 上设置一些非常标准化的东西，例如 RESTful HTTP 接口，那么您可以轻松地做到这一点使用 之一，再次包括 Python 和 Node.js，两者均已由 IBM 打包并提供免费且易于安装。
除了 http，IBM i 上的 FTP 服务器知道一个 rcmd 命令。
如果您从 Windows 服务器进行此远程调用，IBM System i Access ActiveX 对象库 (cwdx.dll) 是调用内置 IBM i 命令的好方法以及用 RPG、CL、C 或 C++ 编写的 ILE 程序。
下面的示例代码是用 VB6/VBA 编写的，但同样的技术可用于任何 COM 兼容 Windows 语言（C++、C#、VB.Net、Delphi).有趣的是，此 ActiveX 调用有时可以在其他远程 SQL 调用被阻止的系统上允许 SQL 到 运行。例如，如果我尝试通过 ODBC、OLE DB 或 JDBC (IBM Data Studio) 运行 SQL DELETE 命令；它会被阻止，因为关联的服务器作业使用 'RMTFIL' 和 'RMTOBJ'（强制对象版本 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
我想从某些外部 API 或 REST 端点调用 AS400 上的 IBM 命令。 IBM i / AS400 是否提供类似的东西？
他们有 API's for that, and jtOpen on sourceforge. You might also want to look at Ublu.
有一个名为 XMLSERVICE 的服务程序包含在任何相当新的 IBM i 中，它是任何客户端与 i 通信的相当简单的方法，包括发出 IBM i 命令和从 IBM i 接收返回的参数程式。它接受多种 "transport" 方法，包括 HTTP 和 ODBC。
有各种编程语言的 XMLSERVICE 包装器，例如 Python, JavaScript (Node.js), PHP, and Ruby。如果您对这些语言中的任何一种感到满意，或者可以找到适合您选择的语言的 itoolkit 版本，它就非常容易使用。
如果您无法选择在客户端使用哪种方法，并且希望在 IBM i 上设置一些非常标准化的东西，例如 RESTful HTTP 接口，那么您可以轻松地做到这一点使用
除了 http，IBM i 上的 FTP 服务器知道一个 rcmd 命令。
如果您从 Windows 服务器进行此远程调用，IBM System i Access ActiveX 对象库 (cwdx.dll) 是调用内置 IBM i 命令的好方法以及用 RPG、CL、C 或 C++ 编写的 ILE 程序。
下面的示例代码是用 VB6/VBA 编写的，但同样的技术可用于任何 COM 兼容 Windows 语言（C++、C#、VB.Net、Delphi).有趣的是，此 ActiveX 调用有时可以在其他远程 SQL 调用被阻止的系统上允许 SQL 到 运行。例如，如果我尝试通过 ODBC、OLE DB 或 JDBC (IBM Data Studio) 运行 SQL DELETE 命令；它会被阻止，因为关联的服务器作业使用 'RMTFIL' 和 'RMTOBJ'（强制对象版本 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