|
midrange.com
I need to write a socket program that will receive data from a probe when a
button is pressed and save the information in an AS400 db2 database. I've
created a program that creates the socket, binds, listens then translates
the data. The problem is that I don't receive consistant data from the
buffer. Should I be using a UDP server to acheive the desired results?
Here is the current program; any help would be appreciated. I used one of
Scott Klement's examples.
400 H DFTACTGRP(*NO) ACTGRP(*NEW)
07/10/01
1500 Ffmeltmst if a e k disk
04/21/06
1600 Ffmelterr if a e k disk
04/28/06
1700
07/10/01
1800 D Open_Session pr
05/20/05
1900 D End_Session pr
05/20/05
2000 D DsplyLine pr
05/20/05
2100 D Talk pr
05/20/05
2200
05/20/05
2300 D getservbyname PR * ExtProc('getservbyname')
07/10/01
2400 D service_name * value options(*string)
07/10/01
2500 D protocol_name * value options(*string)
07/10/01
2600
07/10/01
2700 D p_servent S *
07/10/01
2800 D servent DS based(p_servent)
07/10/01
2900 D s_name *
07/10/01
3000 D s_aliases *
07/10/01
3100 D s_port 10I 0
07/10/01
3200 D s_proto *
07/10/01
3300
07/10/01
3400 D inet_addr PR 10U 0 ExtProc('inet_addr')
07/10/01
3500 D address_str * value options(*string)
07/10/01
3600
07/10/01
3700 D INADDR_NONE C CONST(4294967295)
07/10/01
3800
07/10/01
3900 D inet_ntoa PR * ExtProc('inet_ntoa')
07/10/01
4000 D internet_addr 10U 0 value
07/10/01
4100
07/10/01
4200 D p_hostent S *
07/10/01
4300 D hostent DS Based(p_hostent)
07/10/01
4400 D h_name *
07/10/01
4500 D h_aliases *
07/10/01
4600 D h_addrtype 10I 0
07/10/01
4700 D h_length 10I 0
07/10/01
4800 D h_addr_list *
07/10/01
4900 D p_h_addr S * Based(h_addr_list)
07/10/01
5000 D h_addr S 10U 0 Based(p_h_addr)
07/10/01
5100
07/10/01
5200 D gethostbyname PR * extproc('gethostbyname')
07/10/01
5300 D host_name * value options(*string)
07/10/01
5400
07/10/01
5500 D socket PR 10I 0 ExtProc('socket')
07/09/01
5600 D addr_family 10I 0 value
07/09/01
5700 D type 10I 0 value
07/09/01
5800 D protocol 10I 0 value
07/09/01
5900
07/09/01
6000 D SOCK_SEQPACKET C CONST(5)
05/20/05
6100 D AF_INET C CONST(2)
07/09/01
6200 D SOCK_STREAM C CONST(1)
07/09/01
6300 D IPPROTO_IP C CONST(0)
07/09/01
6400
07/09/01
6500 D connect PR 10I 0 ExtProc('connect')
07/09/01
6600 D sock_desc 10I 0 value
07/09/01
5722WDS V5R3M0 030905 SEU PARTIAL SOURCE LISTING
05/04/06 12:11:35 NEWPORT PAGE 2
SOURCE FILE . . . . . . . SRCOBJ/QRPGLESRC
MEMBER . . . . . . . . . FMELT0
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+...
7 ...+... 8 ...+... 9 ...+... 0
6700 D dest_addr * value
07/09/01
6800 D addr_len 10I 0 value
07/09/01
6900
07/09/01
7000 D p_sockaddr S *
07/09/01
7100 D sockaddr DS based(p_sockaddr)
07/09/01
7200 D sa_family 5I 0
07/09/01
7300 D sa_data 14A
07/09/01
7400 D sockaddr_in DS based(p_sockaddr)
07/09/01
7500 D sin_family 5I 0
07/09/01
7600 D sin_port 5U 0
07/09/01
7700 D sin_addr 10U 0
07/09/01
7800 D sin_zero 8A
07/09/01
7900
07/10/01
8000 D send PR 10I 0 ExtProc('send')
07/10/01
8100 D sock_desc 10I 0 value
07/10/01
8200 D buffer * value
07/10/01
8300 D buffer_len 10I 0 value
07/10/01
8400 D flags 10I 0 value
07/10/01
8500
07/10/01
8600 D recv PR 10I 0 ExtProc('recv')
07/10/01
8700 D sock_desc 10I 0 value
07/10/01
8800 D buffer * value
07/10/01
8900 D buffer_len 10I 0 value
07/10/01
9000 D flags 10I 0 value
07/10/01
9100
07/10/01
9200 D close PR 10I 0 ExtProc('close')
07/10/01
9300 D sock_desc 10I 0 value
07/10/01
9400
07/10/01
9500 D translate PR ExtPgm('QDCXLATE')
07/10/01
9600 D length 5P 0 const
07/10/01
9700 D data 32766A options(*varsize)
07/10/01
9800 D table 10A const
07/10/01
9900
07/10/01
10000 D msg S 50A
05/03/06
10100 D sock S 10I 0
07/10/01
10200 D port S 5U 0
07/10/01
10300 D addrlen S 10I 0
07/10/01
10400 D ch S 1A
07/10/01
10500 D host s 32A
07/10/01
10600 D file s 32A
07/10/01
10700 D IP s 10U 0
07/10/01
10800 D p_Connto S *
07/10/01
10900 D RC S 10I 0
07/10/01
11000 D Request S 94A
04/28/06
11100 D ReqLen S 10I 0
07/10/01
11200 D RecBuf S 91A
05/02/06
11300 D RecLen S 10I 0
07/10/01
11400
07/10/01
11500 D cnt s 1 0
04/28/06
11600 D cr s 1 inz(X'0D')
04/28/06
11700 D esc s 1 inz(X'27')
04/28/06
11800 D end s 1 0
05/19/05
11900 D i s 3s 0
04/28/06
5722WDS V5R3M0 030905 SEU PARTIAL SOURCE LISTING
05/04/06 12:11:35 NEWPORT PAGE 3
SOURCE FILE . . . . . . . SRCOBJ/QRPGLESRC
MEMBER . . . . . . . . . FMELT0
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+...
7 ...+... 8 ...+... 9 ...+... 0
12000 D wwerr s n
04/28/06
12100 D wwdesc s 91a
04/28/06
12200 D wwlen s 4s 0
04/28/06
12300 D wwtest s 3s 0
04/28/06
12400 D wwtotal s 10I 0
07/15/05
12500 D WWCMDSTR C CONST('ALCOBJ OBJ((MELT_0
*DTAARA - 05/04/06
12600 D *EXCL)) WAIT(0)')
05/04/06
12700 D WCMDLNGTH S 15 5 INZ(80)
05/04/06
12800 D wwcmdstr1 s 80a
05/04/06
12900 C*************************************************
07/10/01
13000 C* The user will supply a hostname and file
07/10/01
13100 C* name as parameters to our program...
07/10/01
13200 C*************************************************
07/10/01
13300 c eval wwcmdstr1 = wwcmdstr
05/04/06
13400 C CALL 'QCMDEXC'
05/04/06
13500 C PARM WWCMDSTR1
05/04/06
13600 C PARM WCMDLNGTH
05/04/06
13700 C callp Open_Session
05/02/06
13800 C callp Talk
05/20/05
13900 C callp End_Session
05/02/06
14000
05/13/05
14100
07/10/01
14200
*******************************************************************
05/20/05
14300 * Procedure to Close socket
05/20/05
14400 * Input parms: none
05/20/05
14500 * Return value: none
05/20/05
14600
*******************************************************************
05/20/05
14700 C*************************************************
05/20/05
14800 C* We're done, so close the socket.
05/20/05
14900 C* do a dsply with input to pause the display
05/20/05
15000 C* and then end the program
05/20/05
15100 C*************************************************
05/20/05
15200 P End_Session b
05/20/05
15300 D End_Session pi
05/20/05
15400 c callp close(sock)
04/28/06
15500 c eval *inlr = *on
05/03/06
15600 c return
05/03/06
15700 P End_Session e
05/20/05
15800
*******************************************************************
05/20/05
15900 * Procedure to Connect to socket
05/20/05
16000 * Input parms: none
05/20/05
16100 * Return value: none
05/20/05
16200
*******************************************************************
05/20/05
16300 P Open_Session b
05/20/05
16400 D Open_Session pi
05/20/05
16500 C*************************************************
07/10/01
16600 C* what port is the service located on?
04/28/06
16700 C*************************************************
07/10/01
16800 C monitor
08/04/05
16900 C eval port = %dec(2000:5:0)
04/21/06
17000 C on-error *all
08/04/05
17100 c eval p_servent =
getservbyname('MELTING0' 04/21/06
17200 c :'tcp')
04/21/06
5722WDS V5R3M0 030905 SEU PARTIAL SOURCE LISTING
05/04/06 12:11:35 NEWPORT PAGE 4
SOURCE FILE . . . . . . . SRCOBJ/QRPGLESRC
MEMBER . . . . . . . . . FMELT0
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+...
7 ...+... 8 ...+... 9 ...+... 0
17300 c if p_servent = *NULL
08/04/05
17400 c callp End_Session
04/21/06
17500 c return
07/19/05
17600 C endif
07/19/05
17700
07/10/01
17800 c eval port = s_port
07/19/05
17900 C endmon
08/04/05
18000
07/10/01
18100 C*************************************************
07/10/01
18200 C* Get the 32-bit network IP address for the host
07/10/01
18300 C* that was supplied by the user:
07/10/01
18400 C*************************************************
07/10/01
18500 c eval IP = inet_addr('MELTING0')
04/21/06
18600 c if IP = INADDR_NONE
07/18/05
18700 c eval p_hostent =
gethostbyname('MELTING0') 04/21/06
18800 c if p_hostent = *NULL
07/18/05
18900 c eval fedesc= 'Unable to find that
host!' 04/28/06
19000 c eval fmdate = %date()
04/21/06
19100 c eval fmtime = %time()
04/21/06
19200 c write rfmelterr
04/28/06
19300 C eval *inlr = *on
05/02/06
19400 c return
07/18/05
19500 c endif
07/18/05
19600 c eval IP = h_addr
07/18/05
19700 c endif
07/18/05
19800
07/10/01
19900 C*************************************************
07/10/01
20000 C* Create a socket
07/10/01
20100 C*************************************************
07/10/01
20200 c eval sock = socket(AF_INET:
SOCK_STREAM: 05/20/05
20300 c IPPROTO_IP)
07/10/01
20400 c if sock < 0
07/10/01
20500 c eval fedesc = %editc(sock:'X') + ' '+
04/28/06
20600 c 'Error calling socket()!'
07/15/05
20700 c eval fedate = %date()
04/28/06
20800 c eval fetime = %time()
04/28/06
20900 c write rfmelterr
04/28/06
21000 c return
07/10/01
21100 c endif
07/10/01
21200
07/10/01
21300 C*************************************************
07/10/01
21400 C* Create a socket address structure that
07/10/01
21500 C* describes the host & port we wanted to
07/10/01
21600 C* connect to
07/10/01
21700 C*************************************************
07/10/01
21800 c eval addrlen = %size(sockaddr)
07/10/01
21900 c alloc addrlen p_connto
07/10/01
22000
07/10/01
22100 c eval p_sockaddr = p_connto
07/10/01
22200 c eval sin_family = AF_INET
07/10/01
22300 c eval sin_addr = IP
07/10/01
22400 c eval sin_port = port
07/10/01
22500 c eval sin_zero = *ALLx'00'
07/10/01
5722WDS V5R3M0 030905 SEU PARTIAL SOURCE LISTING
05/04/06 12:11:35 NEWPORT PAGE 5
SOURCE FILE . . . . . . . SRCOBJ/QRPGLESRC
MEMBER . . . . . . . . . FMELT0
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+...
7 ...+... 8 ...+... 9 ...+... 0
22600
07/10/01
22700 C*************************************************
07/10/01
22800 C* Connect to the requested host
07/10/01
22900 C*************************************************
07/10/01
23000 C if connect(sock: p_connto: addrlen)
< 0 07/10/01
23100 c eval fedesc= 'unable to connect to
server!' 04/28/06
23200 c eval fedate = %date()
04/28/06
23300 c eval fetime = %time()
04/28/06
23400 c write rfmelterr
04/28/06
23500 c callp close(sock)
07/10/01
23600 c return
07/10/01
23700 c endif
07/10/01
23800
07/10/01
23900 P Open_Session e
05/20/05
24000
*******************************************************************
05/20/05
24100 * Procedure to Receive requests
04/28/06
24200 * Input parms: none
05/20/05
24300 * Return value: none
05/20/05
24400
*******************************************************************
05/20/05
24500 P Talk b
05/20/05
24600 D Talk pi
05/20/05
24700
07/10/01
24800 C*************************************************
07/10/01
24900 C* Get back the server's response
07/10/01
25000 C*************************************************
07/10/01
25100 C eval cnt = 0
05/19/05
25200 C callp DsplyLine
05/20/05
25300
07/10/01
25400
07/10/01
25500 P Talk e
05/20/05
25600
*******************************************************************
05/20/05
25700 * Procedure to Receive text from server
05/20/05
25800 * Input parms: none
05/20/05
25900 * Return value: none
05/20/05
26000
*******************************************************************
05/20/05
26100 P DsplyLine b
05/20/05
26200 D DsplyLine pi
05/20/05
26300
C*===============================================================
07/10/01
26400 C* This subroutine receives one line of text from a server and
07/10/01
26500 C*
04/28/06
26600
C*===============================================================
07/10/01
26700 C* Receive information from buffer
04/28/06
26800 C*************************************************
07/10/01
26900
07/10/01
27000 c eval reclen = 0
05/20/05
27100 c eval recbuf = *blanks
05/20/05
27200
05/20/05
27300 c eval rc = recv(sock:
%addr(recbuf):512:8) 05/02/06
27400
07/10/01
27500 C*************************************************
07/10/01
27600 C* translate the line of text into EBCDIC
07/10/01
27700 C* (to make it readable) and display it
07/10/01
27800 C*************************************************
07/10/01
5722WDS V5R3M0 030905 SEU PARTIAL SOURCE LISTING
05/04/06 12:11:35 NEWPORT PAGE 6
SOURCE FILE . . . . . . . SRCOBJ/QRPGLESRC
MEMBER . . . . . . . . . FMELT0
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+...
7 ...+... 8 ...+... 9 ...+... 0
27900 c eval rc = recv(sock:
%addr(recbuf):512:0) 05/02/06
28000 C eval reclen = rc
07/15/05
28100 c callp Translate(reclen: recbuf:
'QTCPEBC') 07/15/05
28200
04/28/06
28300 c eval wwerr = *off
04/28/06
28400
04/28/06
28500 C eval wwdesc = %trim(wwdesc) + recbuf
04/28/06
28600
04/28/06
28700 c eval wwlen = %len(%trim(wwdesc))
04/28/06
28800 * look for wand to send us error
04/28/06
28900 c eval wwtest =
%scan(%trim(wwdesc):'ERROR') 04/28/06
29000
04/28/06
29100 c select
04/28/06
29200 c when wwtest > 0
04/28/06
29300 c eval wwerr = *on
04/28/06
29400
04/28/06
29500 c when wwlen < 50
05/04/06
29600 c eval wwerr = *on
04/28/06
29700
04/28/06
29800 c when wwdesc = *blanks
04/28/06
29900 c eval wwerr = *on
04/28/06
30000
04/28/06
30100 c other
04/28/06
30200 * extract heat field from string if error write to error file
04/28/06
30300 c monitor
04/28/06
30400 c eval fmheat =
%dec(%subst(wwdesc:15:5):4:0) 04/28/06
30500 c on-error *all
04/28/06
30600 c eval wwerr = *on
04/28/06
30700 c endmon
04/28/06
30800 * extract heat field from string if error write to error file
04/28/06
30900 c eval wwlen = %scan('Number
':wwdesc:19) 04/28/06
31000 c eval wwlen = wwlen + 8
04/28/06
31100 c monitor
04/28/06
31200 c eval fmunit =
%dec(%subst(wwdesc:wwlen:2):2:0) 04/28/06
31300 c on-error *all
04/28/06
31400 c eval wwerr = *on
04/28/06
31500 c endmon
04/28/06
31600 * extract heat field from string if error write to error file
04/28/06
31700 c eval wwlen = %scan('Temp ':wwdesc:46)
04/28/06
31800 c eval wwlen = wwlen + 6
04/28/06
31900 c monitor
04/28/06
32000 c eval fmtemp =
%dec(%subst(wwdesc:wwlen:4):4:0) 04/28/06
32100 c on-error *all
04/28/06
32200 c eval wwerr = *on
04/28/06
32300 c endmon
04/28/06
32400 c endsl
04/28/06
32500
04/28/06
32600 c if wwerr = *on
04/28/06
32700 c eval fedate = %date()
04/28/06
32800 c eval fetime = %time()
04/28/06
32900 c eval fedesc = wwdesc
04/28/06
33000 c write rfmelterr
04/28/06
33100 c else
04/28/06
5722WDS V5R3M0 030905 SEU PARTIAL SOURCE LISTING
05/04/06 12:11:35 NEWPORT PAGE 7
SOURCE FILE . . . . . . . SRCOBJ/QRPGLESRC
MEMBER . . . . . . . . . FMELT0
SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+...
7 ...+... 8 ...+... 9 ...+... 0
33200 c eval fmdate = %date()
04/28/06
33300 c eval fmtime = %time()
04/28/06
33400
04/28/06
33500 c write rfmelt
04/28/06
33600 c endif
04/28/06
33700 P DsplyLine e
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.
