|
Jeffrey, I just happened to snag that one into my "tips" folder. Here's a repost: hth, Eric DeLong -----Original Message----- From: Jeffrey Silberberg [mailto:jsilberberg@mindspring.com] Sent: Thursday, April 26, 2001 10:37 AM To: midrange-l@midrange.com Subject: Seen It, But can"t find it now. Morning, Had someone ask me this morning for sample ILE/RPG code to do a Post/Get to a remote Web site for the purpose of exchanging data. I know I have seen a sample piece of code somewhere to do this I just can not seem to locate it today. Does anyone else happen to have a bookmark to this information ? Thks, Jeffrey M. Silberberg Independent Consultant CompuDesigns, Inc. (770) 399-9464 AS SOON AS I KNOW THE ANSWERS THEY CHANGE THE QUESTIONS +--- | This is the Midrange System Mailing List! | To submit a new message, send your mail to MIDRANGE-L@midrange.com. | To subscribe to this list send email to MIDRANGE-L-SUB@midrange.com. | To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com. | Questions should be directed to the list owner/operator: david@midrange.com +---
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.
