|
FYI, David Gibbs doesn't allow attachments to the -L list server emails. The other RPG list at rpgiv@yahoogroups.com does allow attachments. Go to www.rpgiv.com and subscribe to that list, then you can send it. Otherwise, you'll have to email it directly. Bob Cozzi cozzi@rpgiv.com Visit the on-line Midrange Developer forum at: http://www.rpgiv.com > -----Original Message----- > From: rpg400-l-admin@midrange.com [mailto:rpg400-l-admin@midrange.com] On > Behalf Of Tom Daly > Sent: Friday, December 21, 2001 2:48 PM > To: 'rpg400-l@midrange.com' > Subject: RE: socket problem > > 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*====================================================================== ====== > ========================= > > _______________________________________________ > This is the RPG programming on the AS400 / iSeries (RPG400-L) mailing list > To post a message email: RPG400-L@midrange.com > To subscribe, unsubscribe, or change list options, > visit: http://lists.midrange.com/cgi-bin/listinfo/rpg400-l > or email: RPG400-L-request@midrange.com > Before posting, please take a moment to review the archives > at http://archive.midrange.com/rpg400-l.
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
