5722WDS V5R3M0  030905                  SEU SOURCE LISTING                            08/10/08 22:08:30    WARI04D      PAGE    1

  SOURCE FILE . . . . . . .  LIBHTTP/QRPGLESRC
  MEMBER  . . . . . . . . .  CR2

  SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
    100       *  This example is identical to EXAMPLE18 except that it                                                  09/18/06
    200       *  passes the SOAPAction using an "additonal header callback"                                             09/18/06
    300       *  this makes it possible to pass much longer SOAPAction                                                  09/18/06
    400       *  strings.                                                                                               09/18/06
    500       *                                                                                                         09/18/06
    600       *  This sample calls the Currency Exchange Rate Web service                                               09/18/06
    700       *  provided by WebserviceX.net. For more info, search for it                                              09/18/06
    800       *  at   http://www.WebserviceX.net                                                                        09/18/06
    900       *                                                                                                         09/18/06
   1000       *  To Compile (requires V5R1):                                                                            09/18/06
   1100       *     CRTBNDRPG PGM(EXAMPLE20) SRCFILE(libhttp/QRPGLESRC)                                                 09/18/06
   1200       *                                                                                                         09/18/06
   1300       *  To Run:                                                                                                09/18/06
   1400       *     CALL EXAMPLE20 PARM('USD' 'JPY' 12.00)                                                              09/18/06
   1500       *                                                                                                         09/18/06
   1600       *  (This shows the value of USD 12.00 in Japanese currency.)                                              09/18/06
   1700       *                                                                                                         09/18/06
   1800      H DFTACTGRP(*NO) BNDDIR('HTTPAPI':'QC2LE')                                                                 09/18/06
   1900                                                                                                                 09/18/06
   2000      D EXAMPLE20       PR                  ExtPgm('EXAMPLE20')                                                  09/18/06
   2100      D   Country1                     3A   const                                                                09/18/06
   2200      D   Country2                     3A   const                                                                09/18/06
   2300      D   Amount                      15P 5 const                                                                09/18/06
   2400      D EXAMPLE20       PI                                                                                       09/18/06
   2500      D   Country1                     3A   const                                                                09/18/06
   2600      D   Country2                     3A   const                                                                09/18/06
   2700      D   Amount                      15P 5 const                                                                09/18/06
   2800                                                                                                                 09/18/06
   2900       /copy httpapi_h                                                                                           09/18/06
   3000                                                                                                                 09/18/06
   3100      D Incoming        PR                                                                                       09/18/06
   3200      D   rate                         8F                                                                        09/18/06
   3300      D   depth                       10I 0 value                                                                09/18/06
   3400      D   name                      1024A   varying const                                                        09/18/06
   3500      D   path                     24576A   varying const                                                        09/18/06
   3600      D   value                    65535A   varying const                                                        09/12/07
   3700      D   attrs                         *   dim(32767)                                                           09/18/06
   3800      D                                     const options(*varsize)                                              09/18/06
   3900      D Add_SOAPACTION  PR                                                                                       09/18/06
   4000      D   Header                    1024A   varying                                                              09/18/06
   4100      D   UserData                      *   value                                                                09/18/06
   4200                                                                                                                 09/18/06
   4300      D SOAP            s          32767A   varying                                                              09/18/06
   4400      D rc              s             10I 0                                                                      09/18/06
   4500      D rate            s              8F                                                                        09/18/06
   4501      D resp            s           1024A   varying                                                              08/10/08
   4600      D Result          s             12P 2                                                                      09/18/06
   4700                                                                                                                 09/18/06
   4800       /free                                                                                                     09/18/06
   4900        SOAP =                                                                                                   09/18/06
   4902         '<soapenv:Envelope'                                                                                     08/10/08
   4903        +'    xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/"'                                         08/10/08
   4904        +'    xmlns:q0="http://ep.twg.com"'                                                                      08/10/08

  5722WDS V5R3M0  030905                  SEU SOURCE LISTING                            08/10/08 22:08:30    WARI04D      PAGE    2

  SOURCE FILE . . . . . . .  LIBHTTP/QRPGLESRC
  MEMBER  . . . . . . . . .  CR2

  SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
   4905        +'    xmlns:xsd="http://www.w3.org/2001/XMLSchema"'                                                      08/10/08
   4906        +'    xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">'                                            08/10/08
   4907        +'<soapenv:Body>'                                                                                        08/10/08
   4908        +'  <q0:ProcessAuthorization>'                                                                           08/10/08
   4909        +'      <q0:FUNCTION_TYPE>PAYMENT</q0:FUNCTION_TYPE>'                                                    08/10/08
   4910        +'      <q0:PAYMENT_TYPE>CREDIT</q0:PAYMENT_TYPE>'                                                       08/10/08
   4911        +'      <q0:COMMAND>SALE</q0:COMMAND>'                                                                   08/10/08
   4912        +'      <q0:CLIENT_ID>200010001</q0:CLIENT_ID>'                                                          08/10/08
   4913        +'      <q0:ACCT_NUM>4444444444444448</q0:ACCT_NUM>'                                                     08/10/08
   4914        +'      <q0:EXP_YEAR>12</q0:EXP_YEAR>'                                                                   08/10/08
   4915        +'      <q0:EXP_MONTH>12</q0:EXP_MONTH>'                                                                 08/10/08
   4916        +'      <q0:CVV2/>'                                                                                      08/10/08
   4917        +'      <q0:CV_PRESENCE_IND/>'                                                                           08/10/08
   4918        +'      <q0:CUSTOMER_FULLNAME>TEST TEST</q0:CUSTOMER_FULLNAME>'                                          08/10/08
   4919        +'      <q0:CUSTOMER_STREET>100 main street</q0:CUSTOMER_STREET>'                                        08/10/08
   4920        +'      <q0:CUSTOMER_ZIP>60601</q0:CUSTOMER_ZIP>'                                                        08/10/08
   4921        +'      <q0:INVOICE>srm-2</q0:INVOICE>'                                                                  08/10/08
   4922        +'      <q0:TAX_AMOUNT />'                                                                               08/10/08
   4923        +'      <q0:TRANS_AMOUNT>1.02</q0:TRANS_AMOUNT>'                                                         08/10/08
   4924        +'      <q0:TROUTD />'                                                                                   08/10/08
   4925        +'      <q0:XID>123</q0:XID>'                                                                            08/10/08
   4926        +'  </q0:ProcessAuthorization>'                                                                          08/10/08
   4927        +'</soapenv:Body>'                                                                                       08/10/08
   4928        +'</soapenv:Envelope>';                                                                                  08/10/08
   4929                                                                                                                 08/10/08
   6100                                                                                                                 09/18/06
   6200        http_debug(*ON);                                                                                         09/18/06
   6300                                                                                                                 09/18/06
   6400        //  This tells HTTPAPI to call our subprocedure (in this example,                                        09/18/06
   6500        //  the subprocedure is name ADD_SOAPACTION) when assembling the                                         09/18/06
   6600        //  HTTP headers to send to the remote server.                                                           09/18/06
   6700                                                                                                                 09/18/06
   6800        http_xproc( HTTP_POINT_ADDL_HEADER                                                                       09/18/06
   6900                  : %paddr(Add_SOAPACTION) );                                                                    09/18/06
   7000                                                                                                                 09/18/06
   7100        rc = http_url_post_xml(                                                                                  09/18/06
   7200        'http://gld.epayment.thewg.com/EPaymentWS/services/listServices'                                         08/10/08
   7300                          : %addr(SOAP) + 2                                                                      09/18/06
   7400                          : %len(SOAP)                                                                           09/18/06
   7500                          : *NULL                                                                                09/18/06
   7600                          : %paddr(Incoming)                                                                     09/18/06
   7700                          : %addr(resp)                                                                          08/10/08
   7800                          : HTTP_TIMEOUT                                                                         09/18/06
   7900                          : HTTP_USERAGENT                                                                       09/18/06
   8000                          : 'text/xml' );                                                                        09/18/06
   8100                                                                                                                 09/18/06
   8200        if (rc <> 1);                                                                                            09/18/06
   8300           http_crash();                                                                                         09/18/06
   8400        else;                                                                                                    09/18/06
   8500           Result = %dech(Amount * rate: 12: 2);                                                                 09/18/06
   8600           http_comp(%trim(Country1) + ' ' + %char(%dec(Amount:12:2))                                            09/18/06
   8700                     + ' = ' + %trim(Country2) + ' '+ %char(Result));                                            09/18/06
   8800        endif;                                                                                                   09/18/06

  5722WDS V5R3M0  030905                  SEU SOURCE LISTING                            08/10/08 22:08:30    WARI04D      PAGE    3

  SOURCE FILE . . . . . . .  LIBHTTP/QRPGLESRC
  MEMBER  . . . . . . . . .  CR2

  SEQNBR*...+... 1 ...+... 2 ...+... 3 ...+... 4 ...+... 5 ...+... 6 ...+... 7 ...+... 8 ...+... 9 ...+... 0
   8900                                                                                                                 09/18/06
   9000        *inlr = *on;                                                                                             09/18/06
   9100                                                                                                                 09/18/06
   9200       /end-free                                                                                                 09/18/06
   9300                                                                                                                 09/18/06
   9400      P Incoming        B                                                                                        09/18/06
   9500      D Incoming        PI                                                                                       09/18/06
   9600      D   rate                         8F                                                                        09/18/06
   9700      D   depth                       10I 0 value                                                                09/18/06
   9800      D   name                      1024A   varying const                                                        09/18/06
   9900      D   path                     24576A   varying const                                                        09/18/06
  10000      D   value                    65535A   varying const                                                        09/12/07
  10100      D   attrs                         *   dim(32767)                                                           09/18/06
  10200      D                                     const options(*varsize)                                              09/18/06
  10300                                                                                                                 09/18/06
  10400      D atof            PR             8F   extproc('atof')                                                      09/18/06
  10500      D   string                        *   value options(*string)                                               09/18/06
  10600                                                                                                                 09/18/06
  10700       /free                                                                                                     09/18/06
  10800           if (name = 'ConversionRateResult');                                                                   09/18/06
  10900              rate = atof(value);                                                                                09/18/06
  11000           endif;                                                                                                09/18/06
  11100       /end-free                                                                                                 09/18/06
  11200      P                 E                                                                                        09/18/06
  11300                                                                                                                 09/18/06
  11400       *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++                                            09/18/06
  11500       * HTTPAPI will call this (because we set it with http_xproc)                                              09/18/06
  11600       * just before sending the HTTP headers to the remote server.                                              09/18/06
  11700       * This procedure lets us add any header we like to the                                                    09/18/06
  11800       * HTTP request.                                                                                           09/18/06
  11900       *                                                                                                         09/18/06
  12000       * In this example, I'll use it to supply the SoapAction:                                                  09/18/06
  12100       * header.  This way, I can supply a SOAPAction that's up to                                               09/18/06
  12200       * 1024 characters long.                                                                                   09/18/06
  12300       *                                                                                                         09/18/06
  12400       * NOTE: Make sure you leave off the SOAPAction header on the                                              09/18/06
  12500       *       HTTP_url_post_xml, above, otherwise you'll send two                                               09/18/06
  12600       *       of them!                                                                                          09/18/06
  12700       *+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++                                            09/18/06
  12800      P Add_SOAPACTION  B                                                                                        09/18/06
  12900      D Add_SOAPACTION  PI                                                                                       09/18/06
  13000      D   Header                    1024A   varying                                                              09/18/06
  13100      D   UserData                      *   value                                                                09/18/06
  13200       /free                                                                                                     09/18/06
  13300          Header = 'SOAPAction: '                                                                                09/18/06
  13400        + 'http://gld.epayment.thewg.com/EPaymentWS/services/ProcessCreditCard'                                  08/10/08
  13500                 + x'0d25';                                                                                      09/18/06
  13600       /end-free                                                                                                 09/18/06
  13700      P                 E                                                                                        09/18/06
                                  * * * *  E N D  O F  S O U R C E  * * * *