|
midrange.com
Below is a sample that I wrote that demo's Retreiving an IP address & start
pc app via RUNRMTCMD
/********************************************************************/
/* */
/* STRCODE400- STR CODE 400 FROM AS/400 VIA TCP/IP */
/* */
/* THIS IS A CL PROGRAM THAT WILL USE THE API QDCRDEVD */
/* TO OBTAIN INFORMATION FROM A DEVICE AND START */
/* CODE 400 */
/* */
/* NOTE: "OFFSET" IS DOCUMENTED BASED ON THE FIRST BYTE BEING */
/* AT OFFSET=0. SUBSTRING IS DONE SUCH THAT THE FIRST BYTE */
/* IS AT %SST(&VAR 1 1). */
/* */
/* INPUT TO QDCRDEVD: */
/* RECEIVING RECORD CHAR(*) */
/* RECORD FORMAT LENGTH HEX(01F4) */
/* RECORD FORMAT NAME CHAR(8) VALUE(DEVD0600) */
/* DEVICE NAME CHAR(10) VALUE(&WSID) */
/* ERROR RETURN CODE CHAR(16) */
/* */
/* THE RECORD FORMAT NAME MAY BE CHANGED TO DEVD0100. THIS */
/* FORMAT WILL ONLY RETURN A SUBSET OF DEVD0600. */
/* */
/* OUTPUT FROM QDCRDEVD: (DEVD0100) */
/* DEVICE NAME OFFSET (021) CHAR(10) */
/* DEVICE CATEGORY OFFSET (031) CHAR(10) */
/* ONLINE AT IPL OFFSET (041) CHAR(10) */
/* */
/* OUTPUT FROM QDCRDEVD: (DEVD0600) */
/* DEVICE NAME OFFSET (021) CHAR(10) */
/* CONTROLLER NAME OFFSET (204) CHAR(10) */
/* PRINT DEVICE OFFSET (244) CHAR(10) */
/* REMOTE LOCATION NAME OFFSET (254) CHAR(10) */
/* LOCAL LOCATION NAME OFFSET (264) CHAR(10) */
/* REMOTE NETWORK ID. OFFSET (274) CHAR(10) */
/* CONTROL SESSION DEVICE DESCRIPTION OFFSET (284) CHAR(10) */
/* ASSOCIATED PRINTER OFFSET (294) CHAR(10) */
/* ASSOCIATED PRINTER REMOTE NET. ID. OFFSET (304) CHAR(10) */
/* ALTERNATE PRINTER OFFSET (314) CHAR(10) */
/* ALTERNATE PRINTER REMOTE NET. ID. OFFSET (324) CHAR(10) */
/* APPLICATION TYPE OFFSET (404) CHAR(10) */
/* IP ADDRESS OFFSET (874) CHAR(15) */
/* */
/********************************************************************/
CREATEPRT: PGM
DECLARES:
/********************************************************************/
/* PARAMETER VALUES */
/********************************************************************/
DCL VAR(&RECNAME) TYPE(*CHAR) LEN(2000)
DCL VAR(&RECLNTH) TYPE(*CHAR) LEN(4) +
VALUE(X'000007D0') /* API DATA LENGTH: +
2000 */
DCL VAR(&FORMAT) TYPE(*CHAR) LEN(8) VALUE('DEVD0600')
DCL VAR(&DEVNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&ERRORCD) TYPE(*CHAR) LEN(16) VALUE(' ')
DCL VAR(&ERRID) TYPE(*CHAR) LEN(7) VALUE(' ')
/********************************************************************/
/* WORKSTATION VALUE */
/********************************************************************/
DCL VAR(&WSID) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGTXT) TYPE(*CHAR) LEN(70)
/********************************************************************/
/* RETURNED VALUES */
/********************************************************************/
DCL VAR(&DEVNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&IPADDRES) TYPE(*CHAR) LEN(15)
CONSTANTS:
DCL VAR(&BLANKS) TYPE(*CHAR) LEN(10) VALUE(' ')
/********************************************************************/
/* START OF EXECUTABLE CODE */
/********************************************************************/
STARTPGM:
/***************************************************************/
/* SET UP */
/***************************************************************/
RTVJOBA JOB(&WSID)
CHGVAR %SST(&ERRORCD 1 4) X'00000010' /* +
BYTES TO BE RETURNED IF AN ERROR +
OCCURS */
/***************************************************************/
/* THIS IS FOR THE API ERROR PROCESSING. A VALUE OF 16 */
/* (X'00000010') WILL JUST GIVE BACK A CPF MESSAGE ID */
/***************************************************************/
CHGVAR VAR(&DEVNAME) VALUE(&WSID) /* TAKE THE WORK +
STATION NAME */
/********************************************************************/
/* CALL QDCRDEVD API (APPLICATION PROGRAM INTERFACE) */
/********************************************************************/
CALL PGM(QSYS/QDCRDEVD) PARM(&RECNAME &RECLNTH +
&FORMAT &DEVNAME &ERRORCD)
/********************************************************************/
/* PARSE RETURNED INFORMATION */
/********************************************************************/
CHGVAR &ERRID %SST(&ERRORCD 9 7) /* +
ERROR MESSAGE ID */
IF COND(&ERRID ª= ' ') THEN(GOTO +
CMDLBL(ERRORMSG))
/* IF INFORMATION WAS NOT EXTRACTED +
DO NOT TRY TO USE IT */
CHGVAR VAR(&IPADDRES) VALUE(%SST(&RECNAME 878 15)) +
/* DEVICE NAME */
RUNRMTCMD CMD('C:\adtswin\CODEEDIT.EXE') +
RMTLOCNAME(&IPADDRES *IP)
RUNRMTCMD CMD('C:\adtswin\system\EVFCTCPD.EXE /N') +
RMTLOCNAME(&IPADDRES *IP)
STRCODE RMTLOCNAME(&IPADDRES) CMNTYPE(*TCPIP)
GOTO CMDLBL(ENDPGM) /* END OF PROGRAM */
/********************************************************************/
/* ERROR OCCURRED DURING EXECUTION OF QDCRDEVD API. */
/********************************************************************/
ERRORMSG:
CHGVAR VAR(&MSGTXT) VALUE('AN ERROR HAS OCCURRED. ' +
*CAT &ERRID *CAT ' HAS BEEN ISSUED. ') +
/* AN ERROR HAS OCCURRED AND PROCESSING +
HAS STOPPED */
SNDPGMMSG MSG(&MSGTXT) TOMSGQ(*TOPGMQ) MSGTYPE(*INFO) +
/* SEND MESSAGE TO THE USER ON STATUS OF +
REQUEST */
/********************************************************************/
/* END-OF-PROGRAM FOR CREATEPRT */
/********************************************************************/
ENDPGM: ENDPGM
+---
| This is the Midrange System Mailing List!
| To submit a new message, send your mail to MIDRANGE-L@midrange.com.
| To subscribe to this list send email to MIDRANGE-L-SUB@midrange.com.
| To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
