|
Jason, Here's what I do. -----Original Message----- From: Jason@solcominc.com [mailto:Jason@solcominc.com] Sent: Friday, April 20, 2001 1:00 AM To: RPG400-L@midrange.com Subject: http client Has anyone been able to create a http client in rpg? I need to send some data to a http server and am not quite sure how to start. +--- | This is the RPG/400 Mailing List! | To submit a new message, send your mail to RPG400-L@midrange.com. | To subscribe to this list send email to RPG400-L-SUB@midrange.com. | To unsubscribe from this list send email to RPG400-L-UNSUB@midrange.com. | Questions should be directed to the list owner/operator: david@midrange.com +--- This communication is confidential and may be legally privileged. If it is not addressed to you, you are on notice of its status. Please immediately contact us at our cost and destroy it. Please do not use, disclose, copy, distribute or retain any of it without our authority - to do so could be a breach of confidence. Thank you for your co-operation. Please contact us on (09) 356 5800 if you need assistance.
midrange.com
H*----------------------------------------------------------------*
H* PROGRAM :
H*
H* AUTHOR : Peter Connell
H*
H* OBJECTIVE : Return IP address for a URL
H*
*----------------------------------------------------------------*
* Prototype Definitions
D opn_tcp pr 10i 0
D con_tcp pr 10i 0
D socket 10i 0 Const
D host 50
D hostlen 2 0 Const
D port 4 0 Const
D snd_tcp pr 10i 0
D socket 10i 0 Const
D data like(sbuffer)
D rcv_tcp pr 10i 0
D socket 10i 0 Const
D data like(rbuffer)
D cls_tcp pr 10i 0
D socket 10i 0 Const
D get_host PR 10U 0
D host 50
D inet_ntoa PR * extproc('inet_ntoa')
D 10U 0 value
* variables
D host S 50
D ipaddr S 15
D rmthost S 50
D $ip S 10U 0
D url S 50
D retSd s 10i 0
D retCd s 10i 0
D hostlen s 2 0
D port s 4 0
D null c x'00'
D path S 50
D sbuffer S 1024
D rbuffer S 32767
D CRLF C x'0D25'
D n S 5 0
D*----------------------------------------------------------------*
C *Entry Plist
C Parm url
C Parm ipaddr
* Extract host
C Eval n = %scan('/':url)
C If n > *zero
C Eval host =%subst(url:1:n-1)
C Eval path =%subst(url:n+1)
C Else
C Eval host =url
C Endif
C Eval ipaddr = *blanks
C Eval rmthost = %trim(host) + null
* Check for host by name
C Eval $ip = get_host(rmthost)
C If $ip > *zero
C Eval ipaddr = %str(inet_ntoa($ip))
C Endif
C If ipaddr <> *blanks
C Exsr GetPage
* rbuffer should now contain contents of requested page as a data
* stream for web browser, i.e. http header followed by html page.
* If page is valid then header should contain '200 Document follows'
C Eval n = %scan('200 Document follows':rbuffer)
C If n = *zero
C Eval ipaddr = *blanks
C Endif
C Endif
C Eval *inLR = *on
*----------------------------------------------------------------
C *Inzsr Begsr
C*
C XLPRM1 Plist
C Parm length 5 0
C Parm sbuffer
C Parm 'QASCII' Table 10
C Parm 'QSYS' Library 10
C XLPRM2 Plist
C Parm length 5 0
C Parm Rbuffer
C Parm 'QEBCDIC' Table 10
C Parm 'QSYS' Library 10
C Endsr
*----------------------------------------------------------------
C GetPage Begsr
* Open TCP socket *
C Eval hostlen = %len(%trim(rmthost))
C Eval port = 80
C Eval retSd = opn_tcp
C Eval retCd = con_tcp(retSd:host
C :hostlen:port)
* Send URL request
C Eval sbuffer = 'GET /' + %trim(path)
C + ' HTTP/1.0' + CRLF + CRLF
C eval length = %LEN(%trim(sbuffer))
C CALL 'QDCXLATE' XLPRM1
C Eval retCd = snd_tcp(retSd:sbuffer)
* Receive HTTP response
C Eval retCd = rcv_tcp(retSd:rbuffer)
C Eval LENGTH = retCD
C CALL 'QDCXLATE' XLPRM2
* Close TCP socket *
C Eval retCd = cls_tcp(retSd)
C Endsr
*----------------------------------------------------------------
* Get host IP address
*----------------------------------------------------------------
P get_host B export
D get_host PI 10U 0
D rmthost 50
D gethost PR * extproc('gethostbyname')
D * value
D hostent DS based(ptrTohostent)
D h_name *
D h_alias *
D h_addrtype 10i 0
D h_length 10i 0
D h_addr_list *
D Addr DS Align based(ptrToAddr)
D addrArr@ * Dim(101)
D hname S 50 based(ptrTohname)
D HostIP S 10U 0 based(ptrToHostIP)
C Eval ptrTohostent = gethost(%addr(rmthost))
C If ptrTohostent <> *Null
C Eval ptrToAddr = h_addr_list
C Eval ptrToHostIP = addrArr@(1)
C Return HostIP
C Else
C Return *zero
C Endif
P get_host E
*----------------------------------------------------------------
* Open Socket
*----------------------------------------------------------------
P opn_tcp B export
D opn_tcp PI 10i 0
D retSd S 10i 0
D opnskt PR 10i 0 extproc('socket')
D 10i 0 value
D 10i 0 value
D 10i 0 value
C Eval retSd = opnskt(2:1:0)
C Return retSd
Popn_tcp E
*----------------------------------------------------------------
* End - Open Socket
*----------------------------------------------------------------
*----------------------------------------------------------------
* Connect socket
*----------------------------------------------------------------
P con_tcp B export
D con_tcp PI 10i 0
D retSd 10i 0 Const
D rmthost 50
D rmthlen 2 0 Const
D rmtport 4 0 Const
D retCd S 10i 0
D size S 10i 0
D addr S *
D addr1 DS
D $family 5i 0
D $port 5u 0
D $ip 10u 0
D $zero 8
D connect PR 10i 0 extproc('connect')
D 10i 0 value
D * value
D 10i 0 value
D inet_addr PR 10u 0 extproc('inet_addr')
D * value
C eval rmthost = %trim(rmthost) + Null
C Eval $ip = get_host(rmthost)
C If $ip = *zero
C eval $ip = inet_addr(%addr(rmthost))
C Endif
C eval $port = rmtport
C move *allx'00' $zero
C eval $family = 2
C eval addr = %addr(addr1)
C eval size = %size(addr)
C eval retCd=connect(retSd:addr:size)
C Return retCd
P con_tcp E
*----------------------------------------------------------------
* End - Connect socket
*----------------------------------------------------------------
*----------------------------------------------------------------
* Close Socket
*----------------------------------------------------------------
P cls_tcp B export
D cls_tcp PI 10i 0
D retSd 10i 0 Const
D retCd S 10i 0
D closkt PR 10i 0 extproc('close')
D 10i 0 value
* Close
C eval retCd = closkt(retsd)
C Return retCd
P cls_tcp E
*----------------------------------------------------------------
* End - Close
*----------------------------------------------------------------
*----------------------------------------------------------------
* Send
*----------------------------------------------------------------
P snd_tcp B export
D snd_tcp PI 10i 0
D retSd 10i 0 Const
D Sndstr like(sbuffer)
D retCd S 10i 0
D flag S 10i 0
D Sndstrlen S 10i 0
D addr S *
D send PR 10i 0 extproc('send')
D 10i 0 value
D * value
D 10i 0 value
D 10i 0 value
C eval flag = 0
C eval sndstr = %trim(sndstr) + null
C null scan sndstr sndstrlen
C eval addr = %addr(Sndstr)
C eval retCd=send(retSd:addr:Sndstrlen:flag)
C return retCd
P snd_tcp E
*----------------------------------------------------------------
* End - Send
*----------------------------------------------------------------
*----------------------------------------------------------------
* Receive
*----------------------------------------------------------------
P rcv_tcp B export
D rcv_tcp PI 10i 0
D retSd 10i 0 Const
D Rcvstr Like(rbuffer)
D retCd S 10i 0
D Rcvstrlen S 10i 0
D addr S *
D flag S 10i 0
D recv PR 10i 0 extproc('recv')
D 10i 0 value
D * value
D 10i 0 value
D 10i 0 value
C eval flag = 0
C eval addr = %addr(Rcvstr)
C eval Rcvstrlen = 32767
C eval retCd=recv(retSd:addr:Rcvstrlen:flag)
C return retCd
P rcv_tcp E
*----------------------------------------------------------------
* End - Receive
*----------------------------------------------------------------
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.
