SMTPService Example

Refer to shipped RPG source file QRPGLRSRC and CRTDEMO program source in QCLSRC source file.

This example requires the code to be adjusted and server and email address values to be supplied.

     H OPTION(*SRCSTMT : *NODEBUGIO) DFTACTGRP(*NO) ACTGRP(*CALLER)

     H BNDDIR('JSMBNDDIR')

      *

      * V6R1 - Limits

      * Maximum data structure size is 16,773,104 bytes

      * Data structure size = element size * occurrence

      *

     D ListDef1        S             60A   DIM(2) CTDATA

     D ListDefSize     S             10I 0 INZ(0)

     D ListEntSize     S             10I 0 INZ(0)

     D ListCount       S             10I 0 INZ(0)

     D ListMaxCount    S             10I 0 INZ(0)

      *

     D JSMHDL          S              4A   INZ(*BLANKS)

     D JSMSRV          S             50A   INZ(*BLANKS)

     D JSMSTS          S             20A   INZ(*BLANKS)

     D JSMMSG          S            512A   INZ(*BLANKS)

     D JSMCMD          S            512A   INZ(*BLANKS)

     D ZEROLENGTH      S             10I 0 INZ(0)

      *

     D TO              S             80A

     D FROM            S             80A

     D SUBJECT         S             80A

      *

     D LST1            DS                  OCCURS(10)

     D  TEXT                         80A

     D  CNTRL                         1A

      *

      * JSMX_BEGIN

      *

     C                   CALLB(D)  'JSMX_BEGIN'

     C                   PARM                    *OMIT

     C                   PARM                    ZEROLENGTH

      *

      * JSMX_OPEN - USE JSMCLTDTA FOR SERVER

      *

     C                   CLEAR                   JSMSRV

     C                   EVAL      JSMSRV = ''

     C                   CALLB(D)  'JSMX_OPEN'

     C                   PARM                    JSMHDL

     C                   PARM                    JSMSRV

     C                   PARM                    JSMSTS

     C                   PARM                    JSMMSG

     C                   CALLP     checkSTS(JSMSTS:JSMMSG)

      *

      * SERVICE_LOAD

      *

     C                   CLEAR                   JSMCMD

     C                   EVAL      JSMCMD = 'SERVICE_LOAD' +

     C                                      ' SERVICE(SMTPMailService)' +

     C                                      ' TRACE(*YES)'

     C                   CALLB(D)  'JSMX_COMMAND'

     C                   PARM                    JSMHDL

     C                   PARM                    JSMCMD

     C                   PARM                    JSMSTS

     C                   PARM                    JSMMSG

     C                   CALLP     checkSTS(JSMSTS:JSMMSG)

      *

      * SET SERVER

      *

     C                   CLEAR                   JSMCMD

     C                   EVAL      JSMCMD = 'SET' +

     C                                      ' SERVER(10.2.0.200)' +

     C                                      ' USER(testuser)' +

     C                                      ' PASSWORD(testuser)'

     C                   CALLB(D)  'JSMX_COMMAND'

     C                   PARM                    JSMHDL

     C                   PARM                    JSMCMD

     C                   PARM                    JSMSTS

     C                   PARM                    JSMMSG

     C                   CALLP     checkSTS(JSMSTS:JSMMSG)

      *

      * SET ADDRESS

      *

     C                   EVAL      TO   = '[email protected]'

     C                   EVAL      FROM = '[email protected]'

     C                   EVAL      SUBJECT = 'Test subject'

      *

     C                   CLEAR                   JSMCMD

     C                   EVAL      JSMCMD = 'SET' +

     C                                      ' TO(' + TO + ')' +

     C                                      ' FROM(' + FROM + ')' +

     C                                      ' SUBJECT(' + SUBJECT + ')'

     C                   CALLB(D)  'JSMX_COMMAND'

     C                   PARM                    JSMHDL

     C                   PARM                    JSMCMD

     C                   PARM                    JSMSTS

     C                   PARM                    JSMMSG

     C                   CALLP     checkSTS(JSMSTS:JSMMSG)

      *

      * SEND - BIND LIST

      *

     C     1             OCCUR     LST1

     C                   EVAL      TEXT   = 'Line 1'

     C                   EVAL      CNTRL  = ' '

     C     2             OCCUR     LST1

     C                   EVAL      TEXT   = 'Line 2'

     C                   EVAL      CNTRL  = ' '

      *

      * Reset list to beginning

     C     1             OCCUR     LST1

     C                   EVAL      ListDefSize  = %SIZE(ListDef1:*ALL)

     C                   EVAL      ListEntSize  = %SIZE(LST1)

     C                   EVAL      ListCount    = 2

     C                   EVAL      ListMaxCount = %ELEM(LST1)

     C                   CALLB(D)  'JSMX_BINDLST'

     C                   PARM                    JSMHDL

     C                   PARM                    ListDef1

     C                   PARM                    ListDefSize

     C                   PARM                    LST1

     C                   PARM                    ListEntSize

     C                   PARM                    ListCount

     C                   PARM                    ListMaxCount

     C                   PARM                    JSMSTS

     C                   PARM                    JSMMSG

     C                   CALLP     checkSTS(JSMSTS:JSMMSG)

      *

      * SEND

      *

     C                   CLEAR                   JSMCMD

     C                   EVAL      JSMCMD = 'SEND'

     C                   CALLB(D)  'JSMX_COMMAND'

     C                   PARM                    JSMHDL

     C                   PARM                    JSMCMD

     C                   PARM                    JSMSTS

     C                   PARM                    JSMMSG

     C                   CALLP     checkSTS(JSMSTS:JSMMSG)

      *

      * SERVICE_UNLOAD

      *

     C                   CLEAR                   JSMCMD

     C                   EVAL      JSMCMD = 'SERVICE_UNLOAD'

     C                   CALLB(D)  'JSMX_COMMAND'

     C                   PARM                    JSMHDL

     C                   PARM                    JSMCMD

     C                   PARM                    JSMSTS

     C                   PARM                    JSMMSG

     C                   CALLP     checkSTS(JSMSTS:JSMMSG)

      *

      * JSMX_CLOSE

      *

     C                   CALLB(D)  'JSMX_CLOSE'

     C                   PARM                    JSMHDL

     C                   PARM                    JSMSTS

     C                   PARM                    JSMMSG

     C                   CALLP     checkSTS(JSMSTS:JSMMSG)

      *

      * JSMX_END

      *

     C                   CALLB(D)  'JSMX_END'

      *

     C                   SETON                                        LR

 

      ********************************

      * Procedure to check JSM status

      ********************************

     P checkSTS        B

     D checkSTS        PI              N

     D  csJSMSTS                           CONST LIKE(JSMSTS)

     D  csJSMMSG                           CONST LIKE(JSMMSG)

     D  csMSGTXT       S            512A

     C                   IF        csJSMSTS <> 'OK'

     C                   EVAL      csMSGTXT = %TRIM(csJSMSTS) + ' ' +

     C                                        %TRIM(csJSMMSG)

     C                   CALLP     sendMSG(csMSGTXT)

     C                   RETURN    *OFF

     C                   ENDIF

     C                   RETURN    *ON

     P                 E

 

      **************************************

      * Procedure to send a program message

      **************************************

     P sendMSG         B

     D sendMSG         PI

     D smMSGTXT                     512A   VALUE

     D smMSGT          S             10A   INZ('*DIAG')

     D smMSGI          S              7A   INZ('CPF9897')

     D smMSGF          S             20A   INZ('QCPFMSG   *LIBL     ')

     D smMSGL          S             10I 0 INZ(%SIZE(smMSGTXT))

     D smSTKE          S             10A   INZ('*')

     D smSTKC          S             10I 0 INZ(1)

     D smMSGK          S              4A   INZ(*BLANK)

     D smERRC          S             10I 0 INZ(0)

     C                   CALL      'QMHSNDPM'

     C                   PARM                    smMSGI

     C                   PARM                    smMSGF

     C                   PARM                    smMSGTXT

     C                   PARM                    smMSGL

     C                   PARM                    smMSGT

     C                   PARM                    smSTKE

     C                   PARM                    smSTKC

     C                   PARM                    smMSGK

     C                   PARM                    smERRC

     P                 E

 

**CTDATA ListDef1

TEXT                                              A000008000

CNTRL                                             A000000100