*================================================================ * To compile: * * CRTBNDRPG PGM(XXX/OPSNAVR1) SRCFILE(XXX/QRPGLESRC) * * **************************************************************** * Function Prototypes. **************************************************************** H DFTACTGRP(*NO) BNDDIR('QC2LE':'QUSAPIBD') FOpsnavd1 CF E WORKSTN * 5250 Display ** *------------------------------------------------------------------ * Prototype for $$Errno(). *------------------------------------------------------------------ D $$Errno PR * ExtProc('__errno') *------------------------------------------------------------------ * Prototype for Socket(). *------------------------------------------------------------------ D Socket PR 10i 0 ExtProc('socket') D AF_NET 10i 0 Value D SOCK_STREAM 10i 0 Value D UNUSED 10i 0 Value *------------------------------------------------------------------ * Prototype for Write(). *------------------------------------------------------------------ D Write PR 10i 0 ExtProc('write') D SocketDId 10i 0 Value D PtrToBuffer * Value D SizeToRead 10i 0 Value *------------------------------------------------------------------ *------------------------------------------------------------------ * Prototype for Connect(). *------------------------------------------------------------------ D Connect PR 10i 0 ExtProc('connect') D SocketDId 10i 0 Value D PtrToSAddr * Value D SizeOfAddr 10u 0 Value *------------------------------------------------------------------ * Prototype for Close(). *------------------------------------------------------------------ D Close PR 10i 0 ExtProc('close') D SocketDId 10i 0 Value *------------------------------------------------------------------ * Prototype for StrError(). *------------------------------------------------------------------ D StrError PR * ExtProc('strerror') D Errno 10i 0 Value *------------------------------------------------------------------ * Prototype for Internet Address procedure *------------------------------------------------------------------ D RtvNetAds PR 20A D Device 10A CONST *------------------------------------------------------------------ * Prototype to convert dotted IP Address *------------------------------------------------------------------ D addrCvtr PR 10U 0 extproc('inet_addr') D 15A options(*varsize) const * D sockaddr DS D sa_family 5u 0 D sa_data 14a D serveraddr DS D sin_family 5i 0 D sin_port 5u 0 D sin_addr 10u 0 D sin_addrA 4a OVERLAY(sin_addr) D sin_zero 8a **************************************************************** * MISCELLANEOUS DATA STRUCTURES. ***************************************************************** D Miscellaneous DS D DspError 4S 0 INZ D DspErrorA 4A OVERLAY(DspError) ***************************************************************** * C MACROS (CONSTANTS) ***************************************************************** D AF_INET C Const(2) D SOCK_STREAM C Const(1) D UNUSED C Const(0) ***************************************************************** * STANDALONE - Miscellaneous Standalone fields. ***************************************************************** D Buffer S 500A INZ D BufferLen S 10 0 INZ D Cnct_Attempt S 4 0 INZ(0) D ConnectError S 40A INZ('**Error on Connect') D DataLen S 5P 0 INZ D Errno S 10i 0 Based(perrno) D First S 1a INZ('Y') D I_Net_Adr S 20a Inz D Message S 40a Based(pMessage) D MsgToDsply S 52A Based(pMessage) D Pos S 4 0 INZ(0) D pMessage S * D rc S 10i 0 INZ(0) D Request S 500A D ServerMsg S 52A D svaddrlen S 10u 0 INZ D SdId S 10i 0 INZ D SockError S 40A INZ('**Error on Socket create') D TotCnt S 10i 0 INZ D Wait S 1A D XLateTable S 10A INZ D XLateTblLib S 10A INZ * D SDS D Device 244 253 * C Dow *In03 = *Off C Exfmt S1 * * If user presses F3 key... C If *In03 = *On C Eval *Inlr = *On C Return C Endif * * If user presses F5 key... C If *In05 = *On C Exsr ShowOpsNav C Endif * C Enddo * *---------------------------------------------------------------------- * ShowOpsNav - Connect to Socket Listener on PC and display Ops Nav *---------------------------------------------------------------------- C ShowOpsNav Begsr *-- Create a socket descriptor C EVAL SdId = Socket(AF_INET:SOCK_STREAM:UNUSED) C If (SdId < 0 ) C Eval Cnct_Attempt = 1 C Exsr Dsply_Error C Endif * Set up Connect values C EVAL sin_family = AF_INET C Eval sin_port = 4050 C Eval sin_zero = X'0000000000000000' * Retrieve IP Address of PC running Socket Server C Eval I_Net_Adr = RtvNetAds(Device) C Eval I_Net_Adr = %trim(I_Net_Adr) C Eval sin_addr = addrCvtr(I_Net_Adr) * Connect to command server on PC C Eval svaddrlen = %SIZE(serveraddr) C Eval rc = Connect(SdId:%ADDR(serveraddr): C svaddrlen) C If (rc < 0 ) C Eval Cnct_Attempt = 2 C Exsr Dsply_Error C Endif * Since we are not moving any data to the pc, set the buffer to blanks C Eval Buffer = *BLANKS * Determine length of buffer string C ' ' Scan Buffer DataLen C Eval DataLen = DataLen - 1 * Convert buffer string to ASCII C Exsr Convert * Write buffer to socket C If *In68 = *Off C Eval rc = Write(SdId:%ADDR(Buffer):DataLen) C Endif C Eval rc = Close(Sdid) * C Endsr *------------------------------------------------------------------- * Convert - Convert Data from EBCDIC to ASCII or ASCII To EBCDIC *------------------------------------------------------------------- C Convert Begsr C Call 'QDCXLATE' 68 C Parm DataLen C Parm Buffer C Parm 'QASCII' XLateTable C Parm 'QSYS' XLateTblLib C Endsr *--------------------------------------------------------- * Dsply_Error - Display Socket Error *--------------------------------------------------------- C Dsply_Error Begsr C Eval perrno = $$Errno C Eval DspError = Errno C Eval pMessage = StrError(Errno) C Eval MsgToDsply = DspErrorA + ' ' + Message C MsgToDsply Dsply C If Cnct_Attempt = 1 C SockError Dsply C Else C ConnectError DSPLY C Endif C Eval *INLR = *ON C Return C Endsr *--------------------------------------------------------- * RtvNetAds - Subprocedure To Retrieve PC's IP Address *--------------------------------------------------------- P RtvNetAds B Export D RtvNetAds PI 20A D Inp_Device 10A Const D Apierr DS D Bytprv 1 4B 0 Inz(216) D Bytavl 5 8B 0 Inz D Errid 9 15A Inz D Rsvd 16 16A Inz D Errdta 17 216A Inz D Net_Address S 20A INZ D Format S 8A Inz('DEVD0600') D Rcvar S 5000A Inz D Varlen S 4B 0 Inz(5000) C Eval Device = Inp_Device C Call 'QDCRDEVD' C Parm Rcvar C Parm Varlen C Parm Format C Parm Device C Parm Apierr C If BytAvl = 0 C Eval Net_Address = %Subst(Rcvar:877:16) C Endif C Return Net_Address P RtvNetAds E