• Subject: RE: Seen It, But can"t find it now.
  • From: "DeLong, Eric" <EDeLong@xxxxxxxxxxxxxxx>
  • Date: Thu, 26 Apr 2001 10:48:27 -0500

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
+---

     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
      *----------------------------------------------------------------

This thread ...


Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2020 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].