|
This message is in MIME format. Since your mail reader does not understand this format, some or all of this message may not be legible. -- For some reason the attachment got stripped off. Let's see if it goes this time. Tom ps - I've since taken Scott's suggestion to handle the return code on the select() - unforunately to no affect. Still looking at it.... | -----Original Message----- | From: PatrickConner@parkdalemills.com | [mailto:PatrickConner@parkdalemills.com] | Sent: Friday, December 21, 2001 15:48 | To: rpg400-l@midrange.com | Subject: RE: socket problem | | | | Did the code come through? I never saw it. | | Patrick Conner | www.ConnecTown.com | (828) 244-0822 -- D*===================================================================================================== D* Definitions relating to the select() function. Includes the typedef for fd_set and the macros D* needed to manipulate variables of type fd_set. D* D* fd_set is a minimum of 7 integers (up to 224 bits) for compatibility with previous releases. D* It may be larger, depending on the value of FD_SETSIZE. D* D* from: QSYSINC/SYS.TYPES D* D* #ifndef FD_SETSIZE D* #define FD_SETSIZE 200 /* Maximum descriptors in set */ D* #endif D* D* typedef struct fd_set{ D* unsigned int fdes[((FD_SETSIZE) <= 224) ? (7) : D* ((((FD_SETSIZE)-1)/(8*sizeof(int)))+1)]; D* } fd_set; D* D* D* This is the RPG equivalent for FDSET structure: D* D*FDSET DS D* fdes 10U 0 DIM(7) D* D* To use the procedures you will need to pass a pointer to a structure of this type. D* D*--------------- D* prototypes for RPG procedures duplicating fd_set C macros D D FD_ZERO PR D p_FDSET * value D D FD_SET PR D FD 10i 0 D p_FDSET * value D D FD_CLR PR D FD 10i 0 D p_FDSET * value D D FD_ISSET PR 1 D FD 10i 0 D p_FDSET * value D D* define an fdset structure DFDSET DS D fdes 10U 0 DIM(7) D DpFDSET S * INZ(%addr(FDSET)) D D*===================================================================================================== D* prototypes for bit manipulation procedures. these are used by the FD_SET macros D* D* ---- D* logical NOT a byte D $NOT PR 1 D byte 1 value D* D* ---- D* logical AND two bytes D $AND PR 1 D byte1 1 value D byte2 1 value D* D* ---- D* logical OR two bytes D $OR PR 1 D byte1 1 value D byte2 1 value D* D* ---- D* logical NOT a 4 byte binary fields D #NOT PR 10U 0 D int 10U 0 value D* D* ---- D* logical AND two 4 byte binary fields D #AND PR 10U 0 D int1 10U 0 value D int2 10U 0 value D* D* ---- D* logical OR two 4 byte binary fields D #OR PR 10U 0 D int1 10U 0 value D int2 10U 0 value D* D* ---- D* Shift bits left 4 byte binary field D #ShiftLeft PR 10U 0 D int 10U 0 value D NumBits2Shift 10U 0 value D* D* ---- D* Shift bits right 4 byte binary field D #ShiftRight PR 10U 0 D int 10U 0 value D NumBits2Shift 10U 0 value DMI_Time PR ExtProc('mitime') D p_MI_TimeVal * Value D MITimeValHours 10i 0 Value hours D MITimeValMins 10i 0 Value minutes D MITimeValSecs 10i 0 Value seconds D MITimeValHsec 10i 0 Value 100's of a second D* D* D MI_TimeVal S 8 D* D p_MI_TimeVal S * D* D MITimeValHours S 10i 0 hours D MITimeValMins S 10i 0 minutes D MITimeValSecs S 10i 0 seconds D MITimeValHsec S 10i 0 100's of a second D* D*===================================================================================================== D* D* Buffers for reading and writing to the socket D* D* ---- D* Output buffer D* D BufferOut S 1034A D pBufferOut S * INZ(%ADDR(BufferOut)) D* D BufferOutSz S 10I 0 INZ(%Len(BufferOut)) D* D* ---- D* Input buffer D* D BufferIn S 3072a D pBufferIn S * INZ(%ADDR(BufferIn)) D* D BufferInSz S 10I 0 INZ(%Len(BufferIn)) D* D* ---- D* Work buffer D* D WorkBuffer S 3072a D pWorkBuffer S * INZ(%ADDR(WorkBuffer)) D* D WorkBufferSz S 10I 0 INZ(%Len(WorkBuffer)) D*===================================================================================================== D* . . . C* ---- C* Retreive SMDR C DoW 0 = 0 DO FOREVER C* C* - Check for TCM Collector Start/Stop or ProgramEnd request C Eval RC = ProgramControl C If RC < 0 end the pgm C Leave C EndIf C* C MOVEL *ALLx'00' GET10 8 C EVAL Get10 = x'534E523A31300D0A' ascii: 'SNR:10' + CRLF C MOVEL Get10 BufferOut C EVAL RC = Write( SdId C : pBufferOut C : 8 C ) C* C* - Read 'n' number of RECORDS from socket C Do 5 C Eval RC = ReadSocketRec( SdId socket descriptor C : pBufferIn point to BufferIn C : 3000 max chars C ) C If RC > 0 C Leave C EndIf C EndDo C C If RC = 0 tried 5 times & still nothing C Leave C EndIf C* - translate to EBCDIC C CALL 'QDCXLATE' 68 C PARM 3000 DataLen C PARM BufferIn C PARM 'QTCPEBC' XLateTable C PARM 'QUSRSYS' XLateTblLib C* C* place a sentinal to mark the end of the received data C X'0D0000' SCAN BufferIn X 99 C 99 EVAL %SUBST( BufferIn : X : 1) = '~' C N99 MOVE '~' BufferIn C* C* - extract and process each record from the returned data - records are delimted by the tilde C* C Z-ADD 1 I 5 0 C* C DOW I < 3000 C '~' SCAN BufferIn:I Z 5 0 99 C N99 LEAVE C EVAL TDATA = %SUBST(BufferIn : I : Z - I) C* C IF %SUBST(TDATA : 1 : 40) <= *BLANKS C OR C %SUBST(TDATA : 1 : 2) = 'OK' C EVAL I = Z + 1 C ITER C ENDIF C* C* - Write data to DATA QUEUE and 'PBXDUMP' C* C* date/time stamp C TIME TIMESTAMP 12 0 C MOVE TIMESTAMP TDATA 150 C* C IF TNDBOK = 'Y' C EVAL pRIOFB = Rwrite( pFile C : %addr(TDATA) C : 150 C ) C ENDIF C* C IF TNDQOK = 'Y' C* C MOVEL TNDQNM QNAME C MOVEL TNDQLB QLIB C Z-ADD 150 QLEN C* C CALL 'QSNDDTAQ' C PARM QNAME 10 C PARM QLIB 10 C PARM QLEN 5 0 C PARM TDATA C* C ENDIF C* C EVAL I = Z + 1 C ENDDO C C EndDo DO FOREVER C* C*===================================================================================================== PReadSocketRec B D ReadSocketRec Pr 10i 0 D SD 10I 0 Value D SockData@ * Value D MaxDataLen 10I 0 Value D ReadSocketRec PI 10i 0 D SD 10I 0 Value D SockData@ * Value D MaxDataLen 10I 0 Value D DataLeft S 10I 0 D TotChars S 10i 0 Inz(0) # of chars received thus far D CharsRead S 10I 0 Inz(0) # of chars on this read() D RC S 10I 0 C* Clear buffers and initialize fields C Eval WorkBuffer = *allx'00' C Eval BufferIn = *allx'00' C Eval CharsRead = 0 C Eval TotChars = 0 C Eval DataLeft = MaxDataLen C* C* read until MaxDataLen chars have been received or end of record char encountered C DoW TotChars < MaxDataLen C* C**** Eval CharsRead = ReadSocket( SD used for non blocking reads C**** : pWorkBuffer C**** : DataLeft C**** : 5 C**** ) C Z-ADD 3 TimeValSec C Z-ADD *zeros TimeValMsec C Do 5 C CALLP FD_ZERO(pFDSET) C CALLP FD_SET(SD : pFDSET) C EVAL RC = Select( SD + 1 C : pFDSET read set C : *NULL write set C : *NULL error set C : %addr(TimeVal) C ) C EVAL *IN99 = FD_ISSET(SD : pFDSET) C If *IN99 = *ON C Eval CharsRead = Read( SD used for blocking reads C : pWorkBuffer C : DataLeft C ) C Leave C Else C Iter timed out, retry C EndIf C EndDo C If CharsRead < 0 C Eval ErrNo@ = GetErrNo C Eval ErrMsg@ = StrError(ErrNo) C leave C EndIf C C* move the data from the work buffer to the input buffer we're building C Eval %Subst(BufferIn : TotChars + 1 : CharsRead) C = %Subst(WorkBuffer : 1 : CharsRead) C* C* Increase the number of bytes received thus far C Eval TotChars = TotChars + CharsRead C* C* Decrease the number of bytes needed to reach MaxDataLen C Eval DataLeft = DataLeft - CharsRead C* C* check if EOR has been read yet C x'0D00' SCAN BufferIn 99 remember: ASCII C 99 LEAVE C* C EndDo C* C Return TotChars C* PReadSocketRec E C*===================================================================================================== P FD_ZERO B D* zero out an FDSET D PI D p_FDSET * value * * set all 0 * * #define FD_ZERO(fds) (memset(fds,0,sizeof(fd_set))) * DFDSET DS BASED(p_FDSET) D fdes 10U 0 DIM(7) C Z-ADD *ZEROS FDES P FD_ZERO E *------------ P FD_SET B D* add an SD to an FDSET D PI D FD 10i 0 D p_FDSET * value * * set bits * * #define FD_SET(fd, fds) \ * ((fds)->fdes[(fd)/32] |= (1 << ((fd)%32))) * D index S 10U 0 DFDSET DS BASED(p_FDSET) D fdes 10U 0 DIM(7) C EVAL index = ( %DIV(FD : 32) + 1 ) C EVAL fdes(index) = C #OR( C fdes(index) : C #ShiftLeft(1 : %rem(FD : 32) ) C ) P FD_SET E *------------ P FD_CLR B D* clear an SD from an FDSET D PI D FD 10i 0 D p_FDSET * value * * clear bits * * #define FD_CLR(fd, fds) \ * ((fds)->fdes[(fd)/32] &= ~(1 << ((fd)%32))) * D index S 10U 0 DFDSET DS BASED(p_FDSET) D fdes 10U 0 DIM(7) C EVAL index = ( %DIV(FD : 32) + 1 ) C EVAL fdes( index ) = C #AND( C fdes(index) : C #NOT( C #ShiftLeft(1 : %rem(fd : 32) ) C ) C ) P FD_CLR E *------------ P FD_ISSET B D* check if an SD is in an FDSET D PI 1 D FD 10i 0 D p_FDSET * value * * check bits * * #define FD_ISSET(fd, fds) \ * (((fds)->fdes[(fd)/32] & (1 << ((fd)%32)))? 1 : 0) * D RETVAL S 1 D index S 10U 0 D integer S 10U 0 DFDSET DS BASED(p_FDSET) D fdes 10U 0 DIM(7) * C EVAL RETVAL = *OFF C EVAL index = ( %DIV(FD : 32) + 1 ) C EVAL integer = C #AND( C fdes( index ) : C #ShiftLeft(1 : %rem(fd : 32) ) C ) C IF INTEGER > *ZERO C EVAL RETVAL = *ON C ENDIF C RETURN RETVAL * P FD_ISSET E *------------ *========================================================================= P $AND B D* bitwise AND two bytes D PI 1 D byte_in1 1 value D byte_in2 1 value D ReturnValue S 1 C BitOn x'FF' ReturnValue C Eval byte_in1 = $NOT(byte_in1) C Eval byte_in2 = $NOT(byte_in2) C BitOff byte_in1 ReturnValue C BitOff byte_in2 ReturnValue C Return ReturnValue P $AND E *------------ P $OR B D* bitwise OR two bytes D PI 1 D byte_in1 1 value D byte_in2 1 value D ReturnValue S 1 C BitOff x'FF' ReturnValue C BitOn byte_in1 ReturnValue C BitOn byte_in2 ReturnValue C Return ReturnValue P $OR E *------------ P $NOT B D* bitwise NOT a single byte D PI 1 D byte_in 1 value D ReturnValue S 1 C BitOn x'FF' ReturnValue C BitOff byte_in ReturnValue C Return ReturnValue P $NOT E *------------ P #AND B D* bitwise AND two integers D PI 10U 0 D int_in1 10U 0 value D int_in2 10U 0 value D index S 10U 0 D DS D integer1 10U 0 D ar1 1 Dim(4) overlay(integer1) D integer2 10U 0 D ar2 1 Dim(4) overlay(integer2) D result 10U 0 D ar3 1 Dim(4) overlay(result) D ReturnValue S 10U 0 C Eval integer1 = int_in1 C Eval integer2 = int_in2 C Do 4 INDEX C Eval ar3(INDEX) = $AND(AR1(INDEX):AR2(INDEX)) C EndDo C Eval ReturnValue = result C Return ReturnValue P #AND E *------------ P #OR B D* bitwise OR two integers D PI 10U 0 D int_in1 10U 0 value D int_in2 10U 0 value D index S 10U 0 D DS D integer1 10U 0 D ar1 1 Dim(4) overlay(integer1) D integer2 10U 0 D ar2 1 Dim(4) overlay(integer2) D result 10U 0 D ar3 1 Dim(4) overlay(result) D ReturnValue S 10U 0 C Eval integer1 = int_in1 C Eval integer2 = int_in2 C Do 4 INDEX C Eval ar3(INDEX) = $OR(AR1(INDEX):AR2(INDEX)) C EndDo C Eval ReturnValue = result C Return ReturnValue P #OR E *------------ P #NOT B D* bitwise NOT an integer D PI 10U 0 D int_in1 10U 0 value D index S 10U 0 D DS D integer1 10U 0 D ar1 1 Dim(4) overlay(integer1) D result 10U 0 D ar2 1 Dim(4) overlay(result) D ReturnValue S 10U 0 C Eval integer1 = int_in1 C Do 4 INDEX C Eval ar2(INDEX) = $NOT(AR1(INDEX)) C EndDo C Eval ReturnValue = result C Return ReturnValue P #NOT E *------------ P #ShiftLeft B D* bitwise shift left D PI 10U 0 D int_in 10U 0 value D BitsToShift 10U 0 value D index S 10U 0 D DS D result 10U 0 D ar1 1 Dim(4) overlay(result) D ReturnValue S 10U 0 C Eval result = int_in C Do BitsToShift INDEX C BitOff '0' ar1(1) C Eval Result = Result * 2 C EndDo C Eval ReturnValue = result C Return ReturnValue P #ShiftLeft E *------------ P #ShiftRight B D* bitwise shift right D PI 10U 0 D int_in 10U 0 value D BitsToShift 10U 0 value D index S 10U 0 D DS D result 10U 0 D ar1 1 Dim(4) overlay(result) D ReturnValue S 10U 0 C Eval result = int_in C Do BitsToShift INDEX C BitOff '7' ar1(4) C Eval Result = Result / 2 C EndDo C Eval ReturnValue = result C Return ReturnValue P #ShiftRight E *------------ C*=====================================================================================================
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 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.
midrange.com
