- SMTP Configuration Checklist
- Configuration of the IBM i SMTP Client to Relay Email to Office365 and Gmail
- How To Migrate SMTP on IBM i from *SDD to *SMTP/*SMTPMSF
- Configuring TLS Between IBM i and Remote Mail Router WITHOUT Authentication
- How To Configure the SMTP Client To Use SMTP Authentication with a SMTP Relay
星期一, 10月 21, 2024
IBM i SMTP
星期四, 11月 09, 2023
2015-06-05 如何監控系統中執行狀態為 MSGW 的工作，並傳送訊息至 MSGQ 或 Email？(Command CHKJOBMSGW -- Check Job Message Wait with QGYOLJOB Open list of jobs API)
如何監控系統中執行狀態為 MSGW 的工作，並傳送訊息至 MSGQ 或 Email？(Command CHKJOBMSGW -- Check Job Message Wait with QGYOLJOB Open list of jobs API)
File : QRPGLESRC
Member: CHKJOBMSGW
Usage : CRTBNDRPG PGM(CHKJOBMSGW)
**
** Program . . : CHKJOBMSGW
** Description : Check job msgw and send msgw info to msgq or mail
** Author . . : Vengoal Chang
** Published . : AS400ePaper
** Date . . . : June 5, 2015
**
**
** Program summary
** ---------------
**
** Work management APIs:
** QGYOLJOB Open list of jobs Lists jobs on the system based on
** the specified selection criteria.
**
** Optionally a sort order for the
** returned jobs can be specified -
** in this case the jobname first
**
** QWVRCSTK Retrieve Call Stack Lists the program call stack for
** the specified job or thread.
** The current invocation level is
** returned first.
**
** Message handling API:
** QMHSNDM Send message Sends a message to the specified
** non-program message queue - here
** an informational message is sent
** to the current user running this
** program.
**
** QMHRTVM Retrieve Message Retrieves the message description
** of a predefined message.
**
** Open list APIs:
** QGYGTLE Get list entries To retrieve open lists entries
** from an already open list the
** QGYGTLE (Get List Entries) API
** is available.
**
** QGYCLST Close list This API closes the previously
** opened list identified by the
** request handle parameter.
** Storage allocated is freed.
**
** MI builtins:
** _MEMMOVE Copy memory Copies a string from one pointer
** specified location to another.
**
** Unix Type - Signal APIs:
** Sleep Suspends program processing for
** the specified number of seconds.
**
**
** Sequence of events:
** 1. The list jobs API input parameters are initialized
**
** 2. The open list of jobs API is called
**
** 3. For each job get key data
** 101 Active job status
** 305 Current user profile
** 1307 Message reply
** 1308 Message key, when active job waiting for a message
** 1309 Message queue name - qualified, when active job waiting for a message
** 1906 Subsystem description name - qualified
**
** List job name and check whether job waiting message or not.
** If job wait for a reply to a message, send message to user
** which run the CHKJOBMSGW program.
**
** 4. The job list resources are cleaned up.
**
** 5. Sleep wakeup interval, then go to step 2. lsit msgw job
**
**
**
** Programmer's notes:
** To retrieve another job's call stack *JOBCTL special authority is
** required.
**
**
** Compile options:
**
** CrtBndPgm Pgm( CHKJOBMSGW )
**
**-- Control spec: -----------------------------------------------------**
H Option( *SrcStmt ) DecEdit( *JobRun ) BndDir( 'QC2LE' )
H DftActGrp(*NO) Debug
**-- System information: -----------------------------------------------**
D PgmSts SDs
D PsPgmNam *Proc
D PsSts 5a Overlay( PgmSts: 11 )
D PsCurJob 10a Overlay( PgmSts: 244 )
D PsUsrPrf 10a Overlay( PgmSts: 254 )
D PsJobNbr 6a Overlay( PgmSts: 264 )
D PsCurUsr 10a Overlay( PgmSts: 358 )
**-- API error data structure: -----------------------------------------**
D ApiError Ds
D AeBytPrv 10i 0 Inz( %Size( ApiError ))
D AeBytAvl 10i 0
D AeExcpId 7a
D 1a
D AeExcpDta 128a
**-- API parameters: ---------------------------------------------------**
D JlRtnRcdNbr s 10i 0 Inz( 1 )
D JlNbrFldRtn s 10i 0 Inz( %Elem( JlKeyFld ))
D JlKeyFld s 10i 0 Dim( 6 )
**-- Job information OLJB0300:
D*JlJobInf0300 Ds 512
D* JbJobId 26a
D* JbJobUsd 10a Overlay( JbJobId: 1 )
D* JbUsrUsd 10a Overlay( JbJobId: *Next )
D* JbNbrUsd 6a Overlay( JbJobId: *Next )
D* JbActSts 4a
D* JbJobTyp 1a
D* JbJobSubTyp 1a
D* JbDtaLen 10i 0
D* 4a
D* JbDta 256a
**-- Job information OLJB0200:
D JlJobInf Ds 512
D JbJobId 26a
D JbJobUsd 10a Overlay( JbJobId: 1 )
D JbUsrUsd 10a Overlay( JbJobId: *Next )
D JbNbrUsd 6a Overlay( JbJobId: *Next )
D JbJobIntId 16a
D JbJobSts 10a
D JbJobTyp 1a
D JbJobSubTyp 1a
D 2a
D JbJobInfoSts 1a
D 3a
D JbDta 256a
**-- Key information:
D JlKeyInf Ds
D KiFldNbrRtn 10i 0
D KiKeyInf 20a Dim( %Elem( JlKeyFld ))
D KiFldInfLen 10i 0 Overlay( KiKeyInf : 1 )
D KiKeyFld 10i 0 Overlay( KiKeyInf : 5 )
D KiDtaTyp 1a Overlay( KiKeyInf : 9 )
D 3a Overlay( KiKeyInf : 10 )
D KiDtaLen 10i 0 Overlay( KiKeyInf : 13 )
D KiDtaOfs 10i 0 Overlay( KiKeyInf : 17 )
**-- Sort information:
D JlSrtInf Ds
D SiNbrKeys 10i 0 Inz( 1 )
D SiSrtInf 12a Dim( 10 )
D SiKeyFldOfs 10i 0 Overlay( SiSrtInf : 1 )
D SiKeyFldLen 10i 0 Overlay( SiSrtInf : 5 )
D SiKeyFldTyp 5i 0 Overlay( SiSrtInf : 9 )
D SiSrtOrd 1a Overlay( SiSrtInf : 11 )
D SiRsv 1a Overlay( SiSrtInf : 12 )
**-- List information:
D JlLstInf Ds
D LiRcdNbrTot 10i 0
D LiRcdNbrRtn 10i 0
D LiHandle 4a
D LiRcdLen 10i 0
D LiInfSts 1a
D LiDts 13a
D LiLstSts 1a
D 1a
D LiInfLen 10i 0
D LiRcd1 10i 0
D 40a
**-- Selection information:
D JlSltInf Ds
D SiJobNam 10a Inz( '*ALL' )
D SiUsrNam 10a Inz( '*ALL' )
D SiJobNbr 6a Inz( '*ALL' )
D* SiJobTyp 1a Inz( 'I' )
D SiJobTyp 1a Inz( '*' )
D 1a
D SiOfsPriSts 10i 0 Inz(108 )
D SiNbrPriSts 10i 0 Inz( 1 )
D SiOfsActSts 10i 0 Inz(118 )
D SiNbrActSts 10i 0 Inz( 1 )
D SiOfsJbqSts 10i 0 Inz(126 )
D SiNbrJbqSts 10i 0 Inz( 0 )
D SiOfsJbqNam 10i 0 Inz(136 )
D SiNbrJbqNam 10i 0 Inz( 0 )
D SiOfsCurUsr 10i 0 Inz(156 )
D SiNbrCurUsr 10i 0 Inz( 0 )
D SiOfsSvrTyp 10i 0 Inz(166 )
D SiNbrSvrTyp 10i 0 Inz( 0 )
D SiOfsActSbs 10i 0 Inz(196 )
D SiNbrActSbs 10i 0 Inz( 0 )
D SiOfsMemPol 10i 0 Inz(206 )
D SiNbrMemPol 10i 0 Inz( 0 )
D SiOfsJobTypE 10i 0 Inz(210 )
D SiNbrJobTypE 10i 0 Inz( 0 )
D SiOfsQualJob 10i 0 Inz(214 )
D SiNbrQualJob 10i 0 Inz( 0 )
**
D SiPriSts 10a Dim( 1 )
D SiActSts 4a Dim( 2 )
D SiJbqSts 10a Dim( 1 )
D SiJbqNam 20a Dim( 1 )
D SiCurUsr 10a Dim( 1 )
D SiSvrTyp 30a Dim( 1 )
D SiActSbs 10a Dim( 1 )
D SiMemPol 10i 0 Dim( 1 )
D SiJobTypEn 10i 0 Dim( 1 )
D SiQualJob 26 Dim( 1 )
**-- Job information key fields:
D JbKeyDta Ds
D JbCurUSr 10
D JbMsgRpy 1
D JbMsgKeyRpy 4
D JbMsgQRpy 20
D JbQualSbs 20
**-- General return data:
D JlGenDta Ds
D GdBytRtn 10i 0
D GdBytAvl 10i 0
D GdElpTim 20u 0
D 16a
**-- API constants: ----------------------------------------------------**
D JOB_RESET_STAT c '1'
D JOB_KEEP_STAT c '0'
**-- Open list of jobs: ------------------------------------------------**
D LstJobs Pr ExtPgm( 'QGYOLJOB' )
D LjRcvVar 65535a Options( *VarSize )
D LjRcvVarLen 10i 0 Const
D LjFmtNam 8a Const
D LjRcvVarDfn 65535a Options( *VarSize )
D LjRcvDfnLen 10i 0 Const
D LjLstInf 80a
D LjNbrRcdRtn 10i 0 Const
D LjSrtInf 1024a Const Options( *VarSize )
D LjJobSltInf 1024a Const Options( *VarSize )
D LjJobSltLen 10i 0 Const
D LjNbrFldRtn 10i 0 Const
D LjKeyFldRtn 10i 0 Const Options( *VarSize ) Dim( 32 )
D LjError 1024a Options( *VarSize )
**
D LjJobSltFmt 8a Const Options( *NoPass )
**
D LjResStc 1a Const Options( *NoPass )
D LjGenRtnDta 32a Options( *NoPass: *VarSize )
D LjGenRtnDtaLn 10i 0 Const Options( *NoPass )
**-- Get list entry: ---------------------------------------------------**
D GetLstEnt Pr ExtPgm( 'QGYGTLE' )
D GlRcvVar 65535a Options( *VarSize )
D GlRcvVarLen 10i 0 Const
D GlHandle 4a Const
D GlLstInf 80a
D GlNbrRcdRtn 10i 0 Const
D GlRtnRcdNbr 10i 0 Const
D GlError 1024a Options( *VarSize )
**-- Close list: -------------------------------------------------------**
D CloseLst Pr ExtPgm( 'QGYCLST' )
D ClHandle 4a Const
D ClError 1024a Options( *VarSize )
**-- Send message: -----------------------------------------------------**
D SndMsg Pr ExtPgm( 'QMHSNDM' )
D SmMsgId 7a Const
D SmMsgFq 20a Const
D SmMsgDta 512a Const Options( *VarSize )
D SmMsgDtaLen 10i 0 Const
D SmMsgTyp 10a Const
D SmMsgQq 1000a Const Options( *VarSize )
D SmMsgQnbr 10i 0 Const
D SmMsgQrpy 20a Const
D SmMsgKey 4a
D SmError 10i 0 Const
**
D SmCcsId 10i 0 Const Options( *NoPass )
**-- Copy memory: ------------------------------------------------------**
D memcpy Pr * ExtProc( '_MEMMOVE' )
D outmem * Value
D inpmem * Value
D memsiz 10u 0 Value
**-- Delay job: --------------------------------------------------------**
D sleep Pr 10i 0 ExtProc( 'sleep' )
D seconds 10u 0 Value
**-- Get top stack entry: ----------------------------------------------**
D GetTopStkE Pr 20a
D GtJobId 26a Const
*** Prototypes for external subprocedures:
D Cmd PR ExtPgm('QCMDEXC')
D command 4096A OPTIONS(*VARSIZE) CONST
D length 15P 5 const
D tmpnam PR * extproc('_C_IFS_tmpnam')
D string 39A options(*omit)
D filename S 40A Varying
D fd S 10I 0
D CRLF S 2 INZ(X'0D25')
**-- Receive non-program message:
D RcvMsg Pr ExtPgm( 'QMHRCVM' )
D RcvVar 65535a Options( *VarSize )
D RcvVarLen 10i 0 Const
D FmtNam 10a Const
D MsgQueQ 20a Const
D MsgTyp 10a Const
D MsgKey 4a Const
D Wait 10i 0 Const
D MsgAct 10a Const
D Error 32767a Options( *VarSize )
D CcsId 10i 0 Const Options( *NoPass )
D AlwDftRpyRjt 10i 0 Const Options( *NoPass )
**-- Message information structure:
D RCVM0200 Ds Qualified
D BytRtn 10i 0
D BytAvl 10i 0
D MsgSev 10i 0
D MsgId 7a
D MsgTyp 2s 0
D MsgKey 4a
D MsgFilNam 10a
D MsgFilLib_s 10a
D MsgFilLib_u 10a
D SndJobNam 10a
D SndJobUsr 10a
D SndJobNbr 6a
D SndPgmNam 12a
D 4a
D DatSnt 7s 0
D TimSnt 6s 0
D TimSntMs 6s 0
D SndUsrPrf 10a
D 1a
D CcsIdStsTxt 10i 0
D CcsIdStsDta 10i 0
D AlrOpt 9a
D CcsIdMsgTxt 10i 0
D CcsIdMsgDta 10i 0
D DtaLenRtn 10i 0
D DtaLenAvl 10i 0
D MsgLenRtn 10i 0
D MsgLenAvl 10i 0
D HlpLenRtn 10i 0
D HlpLenAvl 10i 0
D VarDta 32767a
**
**
D MsqNam_q Ds
D ObjNam 10a
D LibNam 10a
D DateSentC S 19
D DateSent Ds 13
D DateSnt 7s 0
D TimeSnt 6s 0
D SentYY 2 overlay(DateSent:2)
D SentMM 2 overlay(DateSent:4)
D SentDD 2 overlay(DateSent:6)
D SentHH 2 overlay(DateSent:8)
D SentMin 2 overlay(DateSent:10)
D Sentss 2 overlay(DateSent:12)
**-- Global variables: -------------------------------------------------**
D PgmNam s 20a
D MsgDta s 256a Varying
D MsgKey s 4a
D MsgTyp s 10a
D Subject s 60a
D PgmJob s 100a
D MsgTxt s 1024a Varying
D MsgHlpTxt s 1024a Varying
D SecLvlMsgTxt s 2048a Varying
D SecLvl s 4096a Varying
D MailText s 2048a Varying
D tempText s 2048a
D Ix s 5i 0
D Offset s 5i 0
D Pos s 5i 0
D CmdStr S 4096
D QualMsgQ S 20
D SecLvlFmt s 78a Dim( 64 )
D MsgTxtFmt s 78a Dim( 64 )
D NbrLinMsg s 5i 0
D NbrLinSec s 5i 0
D LinIdx s 5i 0
D SysDts s z
D Idx s 5i 0
D IfsCcsid s 10U 0
**-- Global constants:
D OFS_MSGDTA c 16
D JOB_CCSID c 0
D RPY_SENT c '2'
D TYP_INQ c 5
D TYP_RPY c 21
D MSG_TXT c '&N Message . . . . : '
D RPY_DTA c 'Reply . . . . . : '
D NO_WAIT c 0
D KEEP_STS c '*SAME'
D NULL c ''
D WAIT_MAX c -1
D OLD_STS c '*OLD'
D QUOTE C X'7D'
D* Flags for use in open()
D O_RDWR C 4
D* Create File if not exist
D O_CREAT C 8
D* Exclusively create
D O_EXCL C 16
D* Assign a CCSID
D O_CCSID C 32
D* Truncate File to 0 bytes
D O_TRUNC C 64
D* Writing Only
D O_WRONLY C 2
D O_TEXTDATA C 16777216
D* Note: O_TEXT_CREAT requires all of the following flags to work:
D* O_CREAT+O_TEXTDATA+(O_CODEPAGE or O_CCSID)
D O_TEXT_CREAT C 33554432
D* owner authority
D S_IRUSR C 256
D S_IWUSR C 128
D*--------------------------------------------------------------------
D* Open a File
D open PR 10I 0 ExtProc('open')
D filename * value options(*string)
D openflags 10I 0 value
D mode 10U 0 value options(*nopass)
D codepage 10U 0 value options(*nopass)
D txtcreatid 10U 0 value options(*nopass)
D*--------------------------------------------------------------------
D* Close a file
D close PR 10I 0 ExtProc('close')
D handle 10I 0 value
D*--------------------------------------------------------------------
D* Remove Link to File.
D unlink PR 10I 0 ExtProc('unlink')
D path * Value options(*string)
D*--------------------------------------------------------------------
D* Write to a file
D write PR 10I 0 ExtProc('write')
D handle 10I 0 value
D buffer * value
D bytes 10U 0 value
**-- Retrieve message:
D RtvMsg Pr ExtPgm( 'QMHRTVM' )
D RcvVar 32767a Options( *VarSize )
D RcvVarLen 10i 0 Const
D FmtNam 10a Const
D MsgId 7a Const
D MsgFil_q 20a Const
D MsgDta 512a Const Options( *VarSize )
D MsgDtaLen 10i 0 Const
D RplSubVal 10a Const
D RtnFmtChr 10a Const
D Error 32767a Options( *VarSize )
D RtvOpt 10a Const Options( *NoPass )
D CvtCcsId 10i 0 Const Options( *NoPass )
D RplCcsId 10i 0 Const Options( *NoPass )
**-- Retrieve second level help text:
D RtvSecLvl Pr 4096a Varying
D PxMsgFil_q 20a Const
D PxMsgId 7a Const
D PxMsgDta 4096a Const Varying
**-- Format message string:
D FmtMsgStr Pr 78a Dim( 64 )
D PxMsgStr 4096a Value Varying
D PxNbrLin 5i 0
**-- Format message line:
D FmtMsgLin Pr 78a
D PxMsgLin 82a Const Varying
D PxPrcLen 5i 0
D PxInzInd n Options( *NoPass )
**-- Find format instruction:
D FndFmtIns Pr 5u 0
D PxMsgLin 82a Const Varying
D PxOffSet 5u 0 Const Options( *NoPass )
**-- Get indent positions:
D GetIndPos Pr 5u 0
D PxFmtIns 2a Const
D PxInxNxt 5u 0
**-- Scan reverse:
D ScanR Pr 5u 0
D PxArg 128a Const Varying
D PxString 4096a Const Varying
D PxOfs 5u 0 Const Options( *NoPass )
**-- Check AS400 Object exist ?
D As400ObjFound PR N
D QlObjName 20 Value
D ObjType 10 Value
**-- Send escape message:
D SndEscMsg Pr 10i 0
D PxMsgId 7a Const
D PxMsgF 10a Const
D PxMsgDta 512a Const Varying
**-- Send program message:
D SndPgmMsg Pr ExtPgm( 'QMHSNDPM' )
D MsgId 7a Const
D MsgFq 20a Const
D MsgDta 128a Const
D MsgDtaLen 10i 0 Const
D MsgTyp 10a Const
D CalStkE 10a Const Options( *VarSize )
D CalStkCtr 10i 0 Const
D MsgKey 4a
D Error 1024a Options( *VarSize )
**
**-- Mainline: ---------------------------------------------------------**
**
C *Entry Plist
C Parm WakeUp 5 0
C Parm Mail 4
C Parm MsgQ 4
C Parm ToMail 32
C IfsCcsid Parm CltCCSID 5 0
C Parm ToMsgQ 20
C If MsgQ = '*YES'
C CallP As400ObjFound( ToMsgQ : '*MSGQ' )
C EndIf
C Eval SiPriSts(1) = '*ACTIVE'
C Eval SiActSts(1) = 'MSGW'
**-- Job information return fields:
C Eval JlKeyFld(1) = 101
C Eval JlKeyFld(2) = 305
C Eval JlKeyFld(3) = 1307
C Eval JlKeyFld(4) = 1308
C Eval JlKeyFld(5) = 1309
C Eval JlKeyFld(6) = 1906
**
**-- Sort field specification:
C Eval SiNbrKeys = 1
C Eval SiKeyFldOfs(1) = 1
C Eval SiKeyFldLen(1) = 10
C Eval SiKeyFldTyp(1) = 4
C Eval SiSrtOrd(1) = '1'
C Eval SiRsv(1) = x'00'
**
C DoW 1 = 1
**
**-- Retrieve job list:
C CallP LstJobs( JlJobInf
C : %Size( JlJobInf )
C : 'OLJB0200'
C : JlKeyInf
C : %Size( JlKeyInf )
C : JlLstInf
C : 1
C : JlSrtInf
C : JlSltInf
C : %Size( JlSltInf )
C : JlNbrFldRtn
C : JlKeyFld
C : ApiError
C : 'OLJS0200'
C : JOB_KEEP_STAT
C : JlGenDta
C : %Size( JlGenDta )
C )
**
C If AeBytAvl = *Zero
**
C DoW LiLstSts <> '2' Or
C LiRcdNbrTot > JlRtnRcdNbr
**
C ExSr GetKeyDta
**
C Eval JlRtnRcdNbr = JlRtnRcdNbr + 1
**
C CallP GetLstEnt( JlJobInf
C : %Size( JlJobInf )
C : LiHandle
C : JlLstInf
C : 1
C : JlRtnRcdNbr
C : ApiError
C )
**
C If AeBytAvl > *Zero
C Leave
C EndIf
**
C EndDo
**
C CallP CloseLst( LiHandle
C : ApiError
C )
**
**-- Wait 10 seconds:
C CallP sleep( WakeUp )
**
C Reset JlLstInf
C Eval JlRtnRcdNbr = 1
C Else
C Leave
C EndIf
C EndDo
C If AeBytAvl > *Zero
C CallP SndEscMsg( AeExcpId
C : 'QCPFMSG'
C : %Subst( AeExcpDta: 1: AeBytAvl- 16 )
C )
C EndIf
**
C Eval *InLr = *On
**
C Return
**
**-- Get KEY data: -----------------------------------------------------**
C GetKeyDta BegSr
**
C Clear JbKeyDta
**
C For Ix = 1 To KiFldNbrRtn
**
C Select
C When KiKeyFld(Ix) = 305
C CallP memcpy( %Addr( JbCurUsr )
C : %Addr( JlJobInf ) +
C KiDtaOfs(Ix)
C : KiDtaLen(Ix)
C )
**
C When KiKeyFld(Ix) = 1307
C CallP memcpy( %Addr( JbMsgRpy )
C : %Addr( JlJobInf ) +
C KiDtaOfs(Ix)
C : KiDtaLen(Ix)
C )
**
C When KiKeyFld(Ix) = 1308
C CallP memcpy( %Addr( JbMsgKeyRpy )
C : %Addr( JlJobInf ) +
C KiDtaOfs(Ix)
C : KiDtaLen(Ix)
C )
**
C When KiKeyFld(Ix) = 1309
C CallP memcpy( %Addr( JbMsgQRpy )
C : %Addr( JlJobInf ) +
C KiDtaOfs(Ix)
C : KiDtaLen(Ix)
C )
**
C When KiKeyFld(Ix) = 1906
C CallP memcpy( %Addr( JbQualSbs )
C : %Addr( JlJobInf ) +
C KiDtaOfs(Ix)
C : KiDtaLen(Ix)
C )
C EndSl
C EndFor
**
C If JbMsgRpy = '1'
C Eval PgmNam = GetTopStkE( JbJobId )
C If MsgQ = '*YES'
C Exsr SndCmpMsg
C EndIf
C If Mail = '*YES'
C Exsr GetMsgTxt
C Exsr SndMailAtch
C EndIf
C EndIf
**
C EndSr
**-- Get Message Text: -------------------------------------------------**
C GetMsgTxt BegSr
**
C Eval MsgTyp = '*INQ'
C Eval MsgKey = JbMsgKeyRpy
C Eval MsqNam_q= JbMsgQRpy
C CallP RcvMsg( RCVM0200
C : %Size( RCVM0200 )
C : 'RCVM0200'
C : MsqNam_q
C : MsgTyp
C : MsgKey
C : NO_WAIT
C : OLD_STS
C : ApiError
C : JOB_CCSID
C )
C If RCVM0200.MsgFilLib_u=*Blanks
C eval RCVM0200.MsgFilLib_u=RCVM0200.MsgFilLib_s
C EndIf
C Eval MsgDta = %Subst( RCVM0200.VarDta
C : 1
C : RCVM0200.DtaLenRtn
C )
C eval MsgTxt = %Subst( RCVM0200.VarDta
C : RCVM0200.DtaLenRtn + 1
C : RCVM0200.MsgLenRtn
C )
C If RCVM0200.MsgId = *Blanks
C eval MsgTxt = MsgDta
C Else
C eval SecLvl = RtvSecLvl( RCVM0200.MsgFilNam +
C RCVM0200.MsgFilLib_u
C : RCVM0200.MsgId
C : MsgDta
C )
C eval SecLvlFmt=FmtMsgStr( SecLvl: NbrLinSec )
C eval SecLvlMsgTxt = *Blanks
C For idx = 1 to 64
C If %len(%trimr(SecLvlFmt(idx))) > 0
C If %Subst(SecLvlFmt(idx):1:2) <> 'Ca' and
C %Subst(SecLvlFmt(idx):1:2) <> 'Re'
C eval %Subst(SecLvlFmt(idx):1:2) = ' '
C EndIf
C eval SecLvlMsgTxt = %trimr(SecLvlMsgTxt) +
C SecLvlFmt(idx) + CRLF
C Else
C leave
C EndIf
C EndFor
C EndIf
C
C EndSr
**-- Send completion message: ------------------------------------------**
C SndCmpMsg BegSr
**
C Eval QualMsgQ = PsCurUsr + '*LIBL'
C If MsgQ <> *Blanks
C Eval QualMsgQ = ToMsgQ
C EndIf
C Eval MsgDta = 'Program ' +
C %Trim(%SubSt(PgmNam:11:10)) +
C '/' +
C %Trim(%SubSt(PgmNam: 1:10)) +
C ' in job ' +
C %Trim( JbNbrUsd ) + '/' +
C %Trim( JbUsrUsd ) + '/' +
C %Trim( JbJobUsd ) +
C ' waiting for a message' +
C ' in Msgq ' +
C %Trim(%SubSt(JbMsgQRpy:11:10))+
C '/' +
C %Trim(%SubSt(JbMsgQRpy:1:10))+
C '.'
**
C CallP(e) SndMsg( *Blanks
C : *Blanks
C : MsgDta
C : %Len( MsgDta )
C : '*COMP'
C : QualMsgQ
C : 1
C : *Blanks
C : MsgKey
C : 0
C )
**
C EndSr
**-- Send mail message with attach file: -------------------------------**
c SndMailAtch BegSr
c Eval DateSnt = RCVM0200.DatSnt
c Eval TimeSnt = RCVM0200.TimSnt
c Eval DateSentC = '20' + SentYY + '-' +
c SentMM + '-' + SentDD + '-' +
c SentHH + ':' + SentMIN+ ':' +
c SentSS
C Eval PgmJob = 'Program ' +
C %Trim(%SubSt(PgmNam:11:10)) +
C '/' +
C %Trim(%SubSt(PgmNam: 1:10)) +
C ' error in job ' +
C %Trim( JbNbrUsd ) + '/' +
C %Trim( JbUsrUsd ) + '/' +
C %Trim( JbJobUsd )
C Eval MailText =
C %trim(PgmJob) + CRLF +
C 'Time sent: '+DateSentc+' '+
C CRLF +
C 'Message ID: ' +
C RCVM0200.MsgId + CRLF +
C 'Message: ' + %trim(MsgTxt) +
C CRLF + CRLF
C* Eval filename = %str(tmpnam(*OMIT))
C Eval filename = '/tmp/' +
C 'Error_'+ %trim(JbJobUsd) +
C '_' + %trim(JbUsrUsd) +
C '_' + %trim(JbNbrUsd) +
C '.TXT'
C callp unlink(filename)
C
C Eval fd = open( filename
C : O_CREAT + O_CCSID+ O_WRONLY
C + O_TEXT_CREAT + O_TEXTDATA
C : S_IRUSR + S_IWUSR
C : IfsCcsid
C : 0 )
C
C if fd = -1
C* open failed, check errno for the reason why.
C endif
C callp write(fd: %addr(MailText)+2
C : %len(%trim(MailText)))
C
C If %len(SecLvlMsgTxt) > 0
C callp write(fd: %addr(SecLvlMsgTxt)+2
C : %len(%trim(SecLvlMsgTxt)))
C EndIf
C callp close(fd)
C
C Eval Subject = 'AS400 program ' +
C %Trim(%SubSt(PgmNam:11:10)) +
C '/' +
C %Trim(%SubSt(PgmNam: 1:10)) +
C ' exception occurred.'
C EVAL cmdSTR = 'SNDSMTPEMM RCP(' +
C %trim(ToMail) +
C ') SUBJECT(' + QUOTE +
C %trim(Subject) +
C QUOTE + ') NOTE(' +
C QUOTE +
C %trim( MailText) +
C QUOTE + ') ATTACH(' +
C QUOTE +
C %trim(filename) +
C QUOTE + ')'
C* ' CONTENT(*HTML)'
C callp(e) Cmd(%trim(cmdStr) : %len(%trim(cmdstr)))
C callp unlink(filename)
c EndSr
**-- Get top stack entry: ----------------------------------------------**
P GetTopStkE B Export
D Pi 20a
D GtJobId 26a Const
**-- API parameters:
D CsRcvVar Ds
D CsBytRtn 10i 0
D CsBytAvl 10i 0
D CsNbrStkE 10i 0
D CsOfsStkE 10i 0
D CsNbrEntRtn 10i 0
D CsThrId 8a
D CsInfSts 1a
D CsCalStk 32767a
**
D CsCalStkE Ds Based( pCalStkE )
D CsStkEntLen 10i 0
D CsOfsStmIds 10i 0
D CsNbrStmIds 10i 0
D CsOfsPrcNam 10i 0
D CsLenPrcNam 10i 0
D CsRqsLvl 10i 0
D CsPgmNam 10a
D CsPgmLib 10a
D CsMiInst 10i 0
D CsModNam 10a
D CsModLib 10a
D CsCtlBdy 1a
D CsRsv 3a
D CsActGrpNbr 10u 0
D CsActGrpNam 10a
D CsAddInf 4096a
**
D CsStmIds 10a Dim( 16 )
D CsPrcNam 512a
**
D CsJobId Ds
D JiJobId 26a
D JiJobNam 10a Overlay( JiJobId: 1 )
D JiUsrNam 10a Overlay( JiJobId: *Next )
D JiJobNbr 6a Overlay( JiJobId: *Next )
D JiIntId 16a
D JiRsv 2a Inz( *Allx'00' )
D JiThrInd 10i 0 Inz( 2 )
D JiThrId 8a Inz( *Allx'00' )
**-- Retrieve call stack:
D RtvCalStk Pr ExtPgm( 'QWVRCSTK' )
D RcRcvVar 32767a
D RcRcvVarLen 10i 0 Const
D RcRcvInfFmt 8a Const
D RcJobId 56a Const
D RcJobIdFmt 8a Const
D RcError 32767a Options( *VarSize )
**
D EntNbr s 5u 0
**-- Get stack entries: ------------------------------------------------**
**
C Eval JiJobId = GtJobId
**
C CallP RtvCalStk( CsRcvVar
C : %Size( CsRcvVar )
C : 'CSTK0100'
C : CsJobId
C : 'JIDF0100'
C : ApiError
C )
**
C If AeBytAvl = *Zero
C Eval pCalStkE = %Addr( CsRcvVar ) + CsOfsStkE
**
C For EntNbr = 1 to CsNbrEntRtn
**
C* If EntNbr = 1
**
C Eval CsStmIds = *Blanks
C Eval CsPrcNam = *Blanks
**
C If CsOfsStmIds > *Zero
C CallP MemCpy( %Addr( CsStmIds )
C : %Addr( CsCalStkE ) +
C CsOfsStmIds
C : CsNbrStmIds * %Size( CsStmIds )
C )
C EndIf
**
C If CsOfsPrcNam > *Zero
C CallP MemCpy( %Addr( CsPrcNam )
C : %Addr( CsCalStkE ) +
C CsOfsPrcNam
C : CsLenPrcNam
C )
C EndIf
**
C* Leave
C* EndIf
C If %SubSt(CsPgmNam:1:1) <> 'Q'
C Leave
C EndIf
**
C If EntNbr < CsNbrEntRtn
C Eval pCalStkE = PCalStkE + CsStkEntLen
C EndIf
C EndFor
**
C Return CsPgmNam + CsPgmLib
**
C Else
C Return *Blanks
C EndIf
**
P GetTopStkE E
**-- Retrieve second level help text:
P RtvSecLvl B
D Pi 4096a Varying
D PxMsgFil_q 20a Const
D PxMsgId 7a Const
D PxMsgDta 4096a Const Varying
**-- Message information structure:
D RTVM0100 Ds Qualified
D BytRtn 10i 0
D BytAvl 10i 0
D RtnMsgLen 10i 0
D RtnMsgAvl 10i 0
D RtnHlpLen 10i 0
D RtnHlpAvl 10i 0
D Msg 4096a
**
D RPL_SUB_VAL c '*YES'
D INC_FMT_CTL c '*YES'
/Free
RtvMsg( RTVM0100
: %Size( RTVM0100 )
: 'RTVM0100'
: PxMsgId
: PxMsgFil_q
: PxMsgDta
: %Len( PxMsgDta )
: RPL_SUB_VAL
: INC_FMT_CTL
: ApiError
);
If AeBytAvl > *Zero;
Return NULL;
Else;
Return %Subst( RTVM0100.Msg
: RTVM0100.RtnMsgLen + 1
: RTVM0100.RtnHlpLen
);
EndIf;
/End-Free
P RtvSecLvl E
**-- Format message string:
P FmtMsgStr B
D Pi 78a Dim( 64 )
D PxMsgStr 4096a Value Varying
D PxNbrLin 5i 0
**-- Local variables:
D InzInd s n Inz( *On )
D LinIdx s 5i 0
D PrcLen s 5i 0
D StrPos s 10i 0 Inz( 1 )
D RtnFmt s 78a Dim( 64 )
/Free
If PxMsgStr > *Blanks;
For LinIdx = 1 To %Elem( RtnFmt );
RtnFmt(LinIdx) = FmtMsgLin( %TrimL( PxMsgStr ): PrcLen: InzInd );
If %Len( %TrimL( PxMsgStr )) > PrcLen;
PxMsgStr = %Subst( %TrimL( PxMsgStr ): PrcLen + 1 );
Else;
Leave;
EndIf;
If PxMsgStr = *Blanks;
Leave;
EndIf;
EndFor;
EndIf;
PxNbrLin = LinIdx;
Return RtnFmt;
/End-Free
P FmtMsgStr E
**-- Format message line:
P FmtMsgLin B
D Pi 78a
D PxMsgLin 82a Const Varying
D PxPrcLen 5i 0
D PxInzInd n Options( *NoPass )
**-- Local variables:
D IndPos s 5u 0 Inz( 1 ) Static
D IndNxt s 5u 0 Inz( 1 ) Static
D StrLen s 5u 0
D FmtPos s 5u 0
D FmtIns s 2a
D FmtBeg s n
D LeadBlk s 10i 0
**
D MsgLin Ds Qualified
D LstPos 1a Overlay( MsgLin: 78 )
D NxtPos 1a Overlay( MsgLin: 79 )
/Free
If %Parms = 3 And PxInzInd = *On;
Reset IndPos;
Reset IndNxt;
PxInzInd = *Off;
EndIf;
FmtBeg = *Off;
FmtPos = FndFmtIns( PxMsgLin );
If FmtPos > *Zero;
FmtIns = %Subst( PxMsgLin: FmtPos: 2 );
If FmtPos = 1;
FmtBeg = *On;
IndPos = GetIndPos( FmtIns: IndNxt );
FmtPos = FndFmtIns( PxMsgLin: 4 );
If FmtPos > *Zero;
%Subst( MsgLin: IndPos ) = %Subst( PxMsgLin: 4: FmtPos - 4 );
Else;
%Subst( MsgLin: IndPos ) = %Subst( PxMsgLin: 4 );
EndIf;
Else;
%Subst( MsgLin: IndPos ) = %Subst( PxMsgLin: 1: FmtPos - 1 );
EndIf;
Else;
%Subst( MsgLin: IndPos ) = %Subst( PxMsgLin: 1 );
EndIf;
LeadBlk = %Check( ' ': MsgLin );
If LeadBlk > *Zero;
LeadBlk -= IndPos;
EndIf;
IndPos = IndNxt;
If MsgLin.LstPos = *Blank Or MsgLin.NxtPos = *Blank;
StrLen = %Size( MsgLin ) - 1;
Else;
StrLen = ScanR( ' ': MsgLin ) - 1;
If StrLen = *Zero;
StrLen = %Size( MsgLin ) - 1;
EndIf;
EndIf;
MsgLin = %Subst( MsgLin: 1: StrLen );
If FmtBeg = *On;
PxPrcLen = %Len( %Trim( MsgLin )) + 3 + LeadBlk;
Else;
PxPrcLen = %Len( %Trim( MsgLin )) + 1 + LeadBlk;
EndIf;
Return MsgLin;
/End-Free
P FmtMsgLin E
**-- Find format instruction:
P FndFmtIns B
D Pi 5u 0
D PxMsgLin 82a Const Varying
D PxOffSet 5u 0 Const Options( *NoPass )
**-- Local variables:
D FmtPosN s 5u 0
D FmtPosP s 5u 0
D FmtPosB s 5u 0
D OffSet s 5u 0
/Free
If %Parms = 2;
OffSet = PxOffSet;
Else;
OffSet = 1;
EndIf;
FmtPosN = %Scan( '&N': PxMsgLin: OffSet );
FmtPosP = %Scan( '&P': PxMsgLin: OffSet );
FmtPosB = %Scan( '&B': PxMsgLin: OffSet );
If FmtPosN = *Zero;
FmtPosN = *HiVal;
EndIf;
If FmtPosP = *Zero;
FmtPosP = *HiVal;
EndIf;
If FmtPosB = *Zero;
FmtPosB = *HiVal;
EndIf;
Select;
When FmtPosN < FmtPosP And
FmtPosN < FmtPosB;
Return FmtPosN;
When FmtPosP < FmtPosN And
FmtPosP < FmtPosB;
Return FmtPosP;
When FmtPosB < FmtPosN And
FmtPosB < FmtPosP;
Return FmtPosB;
EndSl;
Return *Zero;
/End-Free
P FndFmtIns E
**-- Get inden positions:
P GetIndPos B
D Pi 5u 0
D PxFmtIns 2a Const
D PxIndNxt 5u 0
/Free
Select;
When PxFmtIns = '&N';
PxIndNxt = 3;
Return 1;
When PxFmtIns = '&P';
PxIndNxt = 3;
Return 5;
When PxFmtIns = '&B';
PxIndNxt = 5;
Return 3;
Other;
PxIndNxt = 0;
Return 0;
EndSl;
/End-Free
P GetIndPos E
**-- Scan reverse:
P ScanR B
D Pi 5u 0
D PxArg 128a Const Varying
D PxString 4096a Const Varying
D PxOfs 5u 0 Const Options( *NoPass )
**
D Pos s 5u 0
D Ofs s 5u 0
/Free
If %Parms = 3;
Ofs = PxOfs - %Len( PxArg ) + 1;
Else;
Ofs = %Len( PxString ) - %Len( PxArg ) + 1;
EndIf;
If Ofs > %Len( PxString );
Pos = %Len( PxString ) + 1;
Else;
For Pos = Ofs DownTo 1;
If %SubSt( PxString: Pos: %Len( PxArg )) = PxArg;
Leave;
EndIf;
EndFor;
EndIf;
Return Pos;
/End-Free
P ScanR E
** As400ObjFound - Attempts to locate an AS/400 object
P As400ObjFound B
D As400ObjFound PI N
D QlObjName 20 Value
D ObjType 10 Value
* Local variables and prototypes
D RtvObjDesc PR ExtPgm( 'QUSROBJD' )
D RcvrVar 8
D LenRcvrVar 10I 0 Const
D FmtName 8 Const
D QlObjName 20 Const
D ObjType 10 Const
D ApiErrInf Like( ApiError )
D Rcvr S 8
* Invoke the QUSROBJD API to attempt to locate the object
C CallP RtvObjDesc( Rcvr:
C %Size( Rcvr ):
C 'OBJD0100':
C QlObjName:
C ObjType:
C ApiError )
* If the API returns any error at all, I assume we were unable to
* locate the object.
C If AeBytAvl > *Zero
C CallP SndEscMsg( AeExcpId
C : 'QCPFMSG'
C : %Subst( AeExcpDta: 1: AeBytAvl- 16 )
C )
C Return *Off
C Else
C Return *On
C EndIf
P As400ObjFound E
**-- Send escape message: ----------------------------------------------**
P SndEscMsg B
D Pi 10i 0
D PxMsgId 7a Const
D PxMsgF 10a Const
D PxMsgDta 512a Const Varying
**
D MsgKey s 4a
D MsgFQual s 20a
C If %SubSt(PxMsgId: 1: 3) = 'GUI'
C eval %SubSt(MsgFQual : 1: 10) = 'QGUIMSG'
C Else
C eval %SubSt(MsgFQual : 1: 10) = PxMsgF
C EndIf
C eval %SubSt(MsgFQual :11: 10) = '*LIBL'
C Callp SndPgmMsg( PxMsgId
C : MsgFQual
C : PxMsgDta
C : %Len( PxMsgDta )
C : '*ESCAPE'
C : '*PGMBDY'
C : 1
C : MsgKey
C : ApiError
C )
C If AeBytAvl > *Zero
C Return -1
C
C Else
C Return 0
C EndIf
P SndEscMsg E
File : QCMDSRC
Member: CHKJOBMSGW
Usage : CrtCmd Cmd( CHKJOBMSGW )
Pgm( CHKJOBMSGW )
SrcFile( YourSourceFile )
/* =============================================================== */
/* = Command....... ChkJobMsgw = */
/* = CPP........... ChkJobMsgw RPGLE = */
/* = Description... Check job message waiting and send = */
/* = notification to msgq or detail info to mail = */
/* = or both = */
/* = = */
/* = CrtCmd Cmd( ChkJobMsgw ) = */
/* = Pgm( ChkJobMsgw ) = */
/* = SrcFile( YourSourceFile ) = */
/* =============================================================== */
/* = Date : 2015/06/05 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
/* = Usage: = */
/* = Notification send to MsgQ QSYSOPR : = */
/* = SBMJOB CMD(CHKJOBMSGW WAKEUP(600)) = */
/* = JOB(CHKJOBMSGW) = */
/* = JOBQ(QSYSNOMAX) = */
/* = = */
/* = Notification send to Mail with attachement by SNDSMTPEMM = */
/* = SBMJOB CMD(CHKJOBMSGW WAKEUP(600) = */
/* = MAIL(*YES) = */
/* = MSGQ(*NO ) = */
/* = TOMAIL('user@domain') = */
/* = CLTCCSID(819) = */
/* = ) = */
/* = JOB(CHKJOBMSGW) = */
/* = JOBQ(QSYSNOMAX) = */
/* = = */
/* =============================================================== */
Cmd Prompt('Check Job Message Wait')
Parm WAKEUP *Dec (5 0) +
Dft(300) +
Prompt('Wakeup interval for the batch')
Parm MAIL *Char 4 +
Dft(*NO) +
Values(*YES *NO) +
Rstd(*YES) +
Prompt('Send to mail')
Parm MSGQ *Char 4 +
Dft(*YES) +
Values(*YES *NO) +
Rstd(*YES) +
Prompt('Send to MsgQ')
Parm TOMAIL *Char 32 +
PmtCtl(IFMAIL) +
Prompt('Notification send to email')
Parm CLTCCSID *Dec (5 0) +
PmtCtl(IFMAIL) +
Dft(950) +
Prompt('Client ccsid for mail used')
Parm TOMSGQ +
Type( Qual2) +
PmtCtl(IFMSGQ) +
Prompt('Notification send to MsgQ')
QUAL2: Qual Type(*NAME) +
Dft(QSYSOPR) +
Expr(*YES)
Qual Type(*NAME) +
Dft(*LIBL) +
SpcVal((*LIBL) (*CURLIB)) +
Expr(*YES) +
Prompt('Library')
IFMAIL: PmtCtl Ctl(MAIL) Cond((*EQ *YES))
IFMSGQ: PmtCtl Ctl(MSGQ) Cond((*EQ *YES))
Dep Ctl(&MAIL *EQ *YES) +
Parm((&TOMAIL *NE ' ')) +
NbrTrue(*EQ 1)
Dep Ctl(&MAIL *EQ *NO) +
Parm((&MSGQ *NE *NO)) +
NbrTrue(*EQ 1)
參照: Open List of Jobs (QGYOLJOB) API
星期一, 11月 06, 2023
2003-11-20 如何直接使用 QtmmSendMail API 傳送 E-amil ?(Command SNDEMAIL)
如何直接使用 QtmmSendMail API 傳送 E-amil ?(Command SNDEMAIL)
要利用 AS/400 傳送 EMAIL，我於先前電子報是利用 SNDDST 指令來完成，但此指令僅能
附加一個檔案為附件，而且傳送對象無法向一般 email 軟體，指定副本(cc :copy to) 或 密件副本 (bcc)，
但 AS/400 另提供一個 API QtmmSendMail
可以達成上述需求。
要使用此工具前須先執行（只要設定一次即可），
1. CHGSMTPA MAILROUTER(other smtp server IP)
2. 要啟動 SMTP server(STRTCPSVR *SMTP)
File : QRPGLESRC
Member: SNDEMAILR
Type : RPGLE
Usage : CRTRPGMOD lib/SNDEMAILR SRCFILE(srclib/srcfile)
CRTPGM lib/SNDEMAILR MODULE(lib/SNDEMAILR) BNDSRVPGM(QTCP/QTMMSNDM)
H*****************************************************************
H* Program description
H*
H* This program will send a MIME e-mail, with optional attachments.
H*
H* To create this program, issue the following:
H* CRTRPGMOD lib/SNDEMAILR SRCFILE(srclib/srcfile)
H* CRTPGM lib/SNDEMAILR MODULE(lib/SNDEMAILR) BNDSRVPGM(QTCP/QTMMSNDM)
H*
H* November 2003
H* Author: Vengoal Chang
H*****************************************************************
H debug BNDDIR('QC2LE')
H OPTION(*SRCSTMT:*NODEBUGIO)
D* IFS Prototype
D*****************************************************************
*-- GetErrNo ---- Get error number ----------------------------------
* extern int * __errno(void);
D @__errno PR * ExtProc('__errno')
*-- StrError ---- Get error text ------------------------------------
* char *strerror(int errnum);
D strerror PR * ExtProc('strerror')
D errnum 10I 0 value
D perror PR ExtProc('perror')
D comment * value options(*string)
D errno PR 10I 0
D die PR
D peMsg 256A const
D err S 10I 0
D*** open an IFS file
Dopen PR 10I 0 EXTPROC('open')
D filename * VALUE OPTIONS(*STRING)
D openflags 10I 0 VALUE
D mode 10U 0 VALUE OPTIONS(*NOPASS)
D codepage 10U 0 VALUE OPTIONS(*NOPASS)
D*** read an IFS file
Dread PR 10I 0 EXTPROC('read')
D filehandle 10I 0 VALUE
D datareceived * VALUE
D nbytes 10U 0 VALUE
D*** write to an IFS file
Dwrite PR 10I 0 EXTPROC('write')
D filehandle 10I 0 VALUE
D datatowrite * VALUE
D nbytes 10U 0 VALUE
D*** close an IFS file
Dclose PR 10I 0 EXTPROC('close')
D filehandle 10I 0 VALUE
* stat()--Get File Information ...........................................
Dstat PR 10I 0 EXTPROC('stat')
D path * VALUE
D buf * VALUE
*
Dencodemailaddr PR 10I 0
D mail_addr 256 VALUE
D mail_desc 50 VALUE
D outstr 9999
Dto950 PR 10I 0
D ebcdic 9999 VALUE
D c950 9999
Dsmtphead PR 10I 0
D instr 9999 VALUE
D outstr 9999
DBencode PR 3P 0
D ascii 256 VALUE
D buflen 3P 0 VALUE
D newbuf 256
Dbase64e PR 4
D inchr 3 VALUE
D translate PR ExtPgm('QDCXLATE')
D length 5P 0 const
D data 32766A options(*varsize)
D table 10A const
* Program status structure
D PsDs SDS
D PsProc *PROC
D PsSts *STATUS
D PsSrcLineNo 21 28
D PsExcpType 40 42
D PsExcpNum 43 46
D PsMsgId 40 46
D PsPgmLib 81 90
D PsLstFileErr 175 184
D PsJobName 244 253
D PsUsrId 254 263
D PsJobNum 270 275
D PsPgmName 334 343
D PsModName 344 353
D*****************************************************************
D* IFS CONSTANTS
D*****************************************************************
D*** File Access Modes for open()
D O_RDONLY S 10I 0 INZ(1)
D O_WRONLY S 10I 0 INZ(2)
D O_RDWR S 10I 0 INZ(4)
D*** oflag Values for open()
D O_CREAT S 10I 0 INZ(8)
D O_EXCL S 10I 0 INZ(16)
D O_TRUNC S 10I 0 INZ(64)
D*** File Status Flags for open() and fcntl()
D O_NONBLOCK S 10I 0 INZ(128)
D O_APPEND S 10I 0 INZ(256)
D*** oflag Share Mode Values for open()
D O_SHARE_NONE S 10I 0 INZ(2000000)
D O_SHARE_RDONLY S 10I 0 INZ(0200000)
D O_SHARE_RDWR S 10I 0 INZ(1000000)
D O_SHARE_WRONLY S 10I 0 INZ(0400000)
D*** file permissions
D S_IRUSR S 10I 0 INZ(256)
D S_IWUSR S 10I 0 INZ(128)
D S_IXUSR S 10I 0 INZ(64)
D S_IRWXU S 10I 0 INZ(448)
D S_IRGRP S 10I 0 INZ(32)
D S_IWGRP S 10I 0 INZ(16)
D S_IXGRP S 10I 0 INZ(8)
D S_IRWXG S 10I 0 INZ(56)
D S_IROTH S 10I 0 INZ(4)
D S_IWOTH S 10I 0 INZ(2)
D S_IXOTH S 10I 0 INZ(1)
D S_IRWXO S 10I 0 INZ(7)
D*** misc
D O_TEXTDATA S 10I 0 INZ(16777216)
D O_CODEPAGE S 10I 0 INZ(8388608)
D O_CCSID C 32
D*****************************************************************
D* DATA DEFINITIONS
D*****************************************************************
D*** Miscellaneous data declarations
D FileName S 255A
D FileLen S 9B 0
D Originator S 255A
D OriginName S 80A
D OriginLen S 9B 0
D CPFNumber S Like(MSGID)
D Subject S 256A
D Message S 512A
D AttachName S 256A
D*AsciiCodePage S 10U 0 INZ(819)
D AsciiCodePage S 10U 0 INZ(950)
D EbcdicCodePage S 10U 0 INZ(937)
D OutAddrArr s 256a dim(1000)
D OutDistArr s 10i 0 dim(1000)
D ToAddrArr s 256a dim(1000)
D ToNameArr s 50a dim(1000)
D CcAddrArr s 256a dim(1000)
D CcNameArr s 50a dim(1000)
D bCcAddrArr s 256a dim(1000)
D bCcNameArr s 50a dim(1000)
D Importnc s 4a
D Priority s 4a
D Sensitiv s 4a
D Receipt s 4a
D***
D Addressee S Like(Address)
D AddresseeName S Like(Address)
D Recipients s 280 dim(1000)
D TotalRecp S 9B 0
D***
D FileDesc S 10I 0
D Flags S 10I 0
D BytesWrt S 10I 0
D Data S 9999A
D Data1 S 9999A
D Data2 S 9999A
D InData S 9999A
D AttachDesc S 10I 0
D BodyDesc S 10I 0
D atcfd S 10I 0
D BytesRead S 10I 0
D DataRead S 9899A
D EOR S 2A Inz(X'0D25')
D CRLF S 2 INZ(X'0D0A')
D Null S 1A Inz(X'00')
D FullName S 512A
D ReturnInt S 10I 0
D Pos S 5U 0
D SavePos S Like(Pos)
D*** Data structure of recipient info.
D Recipient DS
D OffSet 1 4B 0
D AddrLen 5 8B 0
D Format 9 16
D DistrType 17 20B 0
D Reserved 21 24B 0
D Address 25 280
D*** MIME Header fields
D MSender S 256A
D MReceipt S 256A
D MImportnc S 256A
D MPriority S 256A
D MDateTime S 256A
D MFrom S 256A
D MMimeVer S 256A
D MTo S 9999A
D MCc S 9999A
D MBcc S 9999A
D MSubject S 256A
D MBoundary S 256A Inz('--PART.BOUNDARY.1')
D*** Array of Receiption address
D ToReceiptions DS
D to 1 9302
D NbrofTo 5U 0 OVERLAY(to : 1)
D to_replacem 5U 0 OVERLAY(to : 3) DIM(30)
D CcReceiptions DS
D cc 1 9302
D Nbrofcc 5U 0 OVERLAY(cc : 1)
D cc_replacem 5U 0 OVERLAY(cc : 3) DIM(30)
D BccReceiptions DS
D bcc 1 9302
D Nbrofbcc 5U 0 OVERLAY(bcc : 1)
D bcc_replacem 5U 0 OVERLAY(bcc : 3) DIM(30)
D RcptNA DS 306
D RcptName 50 overlay(RcptNA : 1)
D RcptAddr 256 overlay(RcptNA : 51)
DTxtF ds
D TxtFile 10a
D TxtFLib 10a
D TxtFMbr s 10a
D*** Array of file attachments
D Attachment DS
D NbrFiles 1 2B 0
D AttachFile 256A Dim(30)
D*** API error info
D APIError DS
D BytesProvided 10I 0 Inz( %Size( APIError ) )
D BytesAvail 10I 0 Inz( *Zero )
D MsgID 7 Inz( *Blanks )
D 1 Inz( X'00' )
D MsgDta 256 Inz( *Blanks )
D*** Constants
D AtS S 1a inz(X'7C')
D DTo C Const(0)
D DCC C Const(1)
D DBCC C Const(2)
D MsgSize C Const(%Len(Message))
*=============================================
* MISCELLANEOUS
D EmailAddr s 255a
D r s 10i 0
D outstr s 9999a
* string character set
Dcharset S 16 Inz('Big5')
* current time for temp file name (store mail message)
Dcurtime S Z
* last folding position in encoded string
Dfold S 3P 0
*
* SBCS character tables *****************************************
*
* US-ASCII (ANSI X3.4-1986) characters (95)
Da_c S 95
Da_x C X'202122232425262728292A2B2C2D2E2F-
* sp ! " # $ % & ' ( ) * + , - . /
D 303132333435363738393A3B3C3D3E3F-
* 0 1 2 3 4 5 6 7 8 9 : ; < = > ?
D 404142434445464748494A4B4C4D4E4F-
* @ A B C D E F G H I J K L M N O
D 505152535455565758595A5B5C5D5E5F-
* P Q R S T U V W X Y Z [ \ ] ^ _
D 606162636465666768696A6B6C6D6E6F-
* ` a b c d e f g h i j k l m n o
D 707172737475767778797A7B7C7D7E'
* p q r s t u v w x y z { | } ?
*
Dtoblank S 95 INZ(*ALL' ')
*
* 'safe' ASCII chars other than especials[RFC2047 p3] and
* quoted chars for EBCDIC gateway [RFC2045 p20]) (69)
* (These characters are also invariant EBCDIC characters)
Da_s_c C ' %&''*+-0123456789-
D ABCDEFGHIJKLMNOPQRSTUVWXYZ-
D abcdefghijklmnopqrstuvwxyz'
*
Da_s_x C X'202526272A2B2D30313233343536373839-
* sp % & ' * + - 0 1 2 3 4 5 6 7 8 9
D 4142434445464748494A4B4C4D-
* A B C D E F G H I J K L M
D 4E4F505152535455565758595A-
* N O P Q R S T U V W X Y Z
D 6162636465666768696A6B6C6D-
* a b c d e f g h i j k l m
D 6E6F707172737475767778797A'
* n o p q r s t u v w x y z
Da_c_c S 98
Da_c_x S 98
* ISO-2022-JP escape sequences
DG0ascii C X'1B2842'
DG0roman C X'1B284A'
DG0kana C X'1B2849'
DG0k78 C X'1B2440'
DG0k83 C X'1B2442'
* especial characters (RFC2047 section 2)
Despecials C X'28293C3E402C3B3A222F5B5D3F2E3D'
* ( ) < > @ , ; : " / [ ] ? . =
*****************************************************************
* base64 encode (attachment file) ........................................
Db64chrDS DS
D b64i 1 3
D b64i1 1 1
D b64i2 2 2
D b64i3 3 3
Db64apDS DS
D b64ap 1 8
D b64ap1 1 2U 0
D b64ap1L 2 2
D b64ap2 3 4U 0
D b64ap2L 4 4
D b64ap3 5 6U 0
D b64ap3L 6 6
D b64ap4 7 8U 0
D b64ap4L 8 8
*
Db64a C X'4142434445464748494A4B4C4D4E4F-
* A B C D E F G H I J K L M N O
D 505152535455565758595A-
* P Q R S T U V W X Y Z
D 6162636465666768696A6B6C6D6E6F-
* a b c d e f g h i j k l m n o
D 707172737475767778797A-
* p q r s t u v w x y z
D 303132333435363738392B2F'
* 0 1 2 3 4 5 6 7 8 9 + /
*****************************************************************
* Loop control
DI S 9P 0
DJ S 9P 0
DK S 9P 0
* write buffer for tmpf
Dtmpfwb S 512
Dtmpfwbb64 S 3900
Dtmpfwblen S 10I 0
* total size of tmpf
Dtmpf_size S 10I 0
* read buffer for attachment file
Datcfrb S 2850
Datcfrblen S 10I 0
*****************************************************************
* attachment size array
Datc_st_size S LIKE(st_size) DIM(30)
* structure stat ........................................ QSYSINC/SYS.STAT
Dstatinfo DS
* Data types in () are defined at QSYSINC/SYS.TYPES
* File mode (typedef unsigned int mode_t;)
D st_mode 10U 0
* File serial number (typedef unsigned int ino_t;)
D st_ino 10U 0
* Number of links (typedef unsigned short nlink_t;)
D*st_nlink 5U 0
D st_nlink 10U 0
* User ID of the owner of file (typedef unsigned int uid_t;)
D st_uid 10U 0
* Group ID of the group of file (typedef unsigned int gid_t;)
D st_gid 10U 0
* For regular files, the file size in bytes (typedef int off_t;)
D st_size 10I 0
* Time of last access (typedef long int time_t;)
D st_atime 10I 0
* Time of last data modification typedef (long int time_t;)
D st_mtime 10I 0
* Time of last file status change (typedef long int time_t;)
D st_ctime 10I 0
* ID of device containing file (typedef unsigned int dev_t;)
D st_dev 10U 0
* Size of a block of the file (typedef unsigned int size_t;)
D st_blksize 10U 0
* Allocation size of the file unsigned long
D st_allocsize 10U 0
* AS/400 object type (typedef char qp0l_objtype_t[11];)
D st_objtype 11
* Object data codepage unsigned short
D st_codepage 5U 0
* reserved - must be 0x00's char[62]
D st_reserved1 62 INZ(*ALLX'00')
* File serial number generation id unsigned int
D st_ino_gen_id 10U 0
*
D*****************************************************************
C* MAIN LINE CALCULATIONS
C*****************************************************************
C*** Entry Parms
C *ENTRY PLIST
C Parm Originator
C Parm ToReceiptions
C Parm OriginName
C Parm CcReceiptions
C Parm BCcReceiptions
C Parm Attachment
C Parm Subject
C Parm Message
C parm TxtF
C parm TxtFMbr
C parm Importnc
C parm Priority
C parm Receipt
C PARM tmpdir 64
C Exsr #INIT
* check sender
C Eval EmailAddr = Originator
C Exsr ChkEmail
* check receiption
C Exsr ChkRcpt
C*** Initialize error structure
C Eval BytesProvided = 0
C*** Initialize values
C Eval OriginLen = %Len(%Trimr(Originator))
C Eval Format = 'ADDR0100'
C Eval Reserved = 0
* Fill in the "Recipients" array
C do 1000 z
C if OutAddrArr(z) = ' '
C leave
C endif
C eval Address = OutAddrArr(z)
* check recipient's e-mail
C eval EMailAddr = Address
C exsr ChkEMail
C eval AddrLen = %len(%trimr(Address))
C eval DistrType = OutDistArr(z)
C if OutAddrArr(z+1) <> ' '
C eval OffSet= 280
C else
C eval OffSet=0
C endif
C eval Recipients(z) = recipient
C enddo
* Total number of recipients
C eval TotalRecp = z -1
C*** Write MIME file
C Exsr WriteHdr
C*** Call API to send e-mail
C CallB 'QtmmSendMail'
C Parm FileName
C Parm FileLen
C Parm Originator
C Parm OriginLen
C Parm Recipients
C Parm TotalRecp
C Parm APIError
C* MSGID dsply
c* dump
C*** Return to caller
C Exit Tag
C Eval *InLr = *On
C Return
*****************************************************************
* Initialize routine
C #INIT BEGSR
* US ASCII character set
* X'A2' = Cent sign, X'A3' = Pound sign, X'A5' = Yen sign
C MOVE *BLANKS a_c_256 256
C* EVAL rc = iconvw(a_x + X'A2A3A5' + NULL : a_c_256)
C Eval a_c_256 = a_x + X'A2A3A5' + NULL
c callp Translate(%len(%trim(a_c_256)):
c a_c_256 : 'QTCPEBC')
* print EBCDIC internal table
C MOVEL a_c_256 a_c_c
C MOVEL a_c_c a_c
C EVAL a_c_x = a_x + X'0D0A' + X'1B'
* check body text file
C If %trim(txtFile) <> '*NONE'
C Eval FullName = '/QSYS.LIB/' +
C %trim(TxtFLib) + '.LIB/' +
C %trim(TxtFile) + '.FILE/' +
C %trim(TxtFmbr) + '.MBR' + NULL
C Eval BodyDesc = open(%trimr(FullName)
C : O_RDONLY)
C If BodyDesc < 0
c eval err = errno
c callp die(%str(strerror(err)) + ' ' + fullname)
C return
C Else
C Eval ReturnInt = close(BodyDesc)
C EndIf
C EndIf
* check attachement
C If Nbrfiles > *ZERO
C and AttachFile(1) <> '*NONE'
C DO NbrFiles I
C EVAL fullname = %TRIM(AttachFile(I)) + NULL
C IF -1 = stat(%ADDR(fullname) : %ADDR(statinfo))
c eval err = errno
c callp die(%str(strerror(err)) + ' ' + fullname)
C return
C ENDIF
* store st_size to array
C EVAL atc_st_size(I) = st_size
* path must be stream file or doc
C IF (%SUBST(st_objtype : 1 : 10) <> '*STMF') AND
C (%SUBST(st_objtype : 1 : 10) <> '*DOC') AND
C (%SUBST(st_objtype : 1 : 10) <> '*DSTMF')
c callp die(%TRIM(AttachFile(I))+ ' ' +
c 'not a STMF or DOC type.')
C return
C ENDIF
* file size is 0
C IF st_size = 0
C ENDIF
C ENDDO
C EndIf
*
C ENDSR
C*****************************************************************
C* Write header portion of file
C*****************************************************************
CSR WriteHdr Begsr
C*** Open file
* open work file to write mail message
C TIME curtime
C MOVE curtime curtimec 26
C EVAL FileName = %TRIM(tmpdir) + '/SNDEMAIL_' +
C %TRIM(PsJobNum) + '-' +
C %TRIM(PsUsrid) + '-' +
C %TRIM(PsJobName) + '_' +
C %SUBST(curtimec : 1 : 23) + '.TXT'
C Eval FileLen = %Len(%Trimr(FileName))
C Eval FullName = %TRIMR(FileName)
C Eval Flags = O_CREAT + O_WRONLY + O_TRUNC +
C O_CCSID
C Eval FileDesc = open(%trimr(FullName)
C : Flags
C : S_IRWXU + S_IROTH
C : AsciiCodePage)
C Move *BLANKS tmpstr 45
C Eval ReturnInt = close(FileDesc)
C Eval FileDesc = open(%trimr(FullName)
C : O_RDWR + O_CCSID
C : S_IRWXU + S_IROTH
C : AsciiCodePage)
C* eval err = errno
C* eval tmpstr = %str(strerror(err))
C* dsply tmpstr
C* 'open0' dsply FileDesc
C*** Build MIME header fields
C If OriginName <> *BLANKS
C Eval rtnlen = smtphead(OriginName : outstr)
C Eval MSender =
C 'Sender: "' +
C %subst(outstr : 1 : rtnlen) +
C '"' + Originator
C Else
C Eval MSender =
C 'Sender: ' + Originator
C EndIf
C Eval MDateTime =
C 'Date: '
C eval rtnlen =
C encodemailaddr(Originator :
C OriginName : outstr)
C Eval MFrom =
C 'From: ' + %subst(outstr : 1 : rtnlen)
C Eval MMimeVer =
C 'MIME-Version: 1.0'
* Create Mto, Mcc, Mbcc mail string
C Exsr Crtdistr
C If Subject <> *Blanks
C eval InData = Subject
C callp smtphead(InData : outstr)
C Eval MSubject =
C 'Subject: ' + %trim(outstr)
C Else
C Eval MSubject =
C 'Subject: '
C Endif
C
C If Message <> *Blanks
C eval InData = Message
C eval outstr = *blanks
C callp to950(InData : outstr)
C eval Message = outstr
C endIf
* Add receipt notification, if requested so
C if Receipt = '*YES'
C eval MReceipt =
C 'Disposition-Notification-To: ' +
C %trim(Msender) + EOR
C endif
* Add the Importance header
C exsr SetImpo
* Add the Priority header
C exsr SetPrio
C Eval Data1 = %Trimr(MSender) +
C EOR +
C %Trimr(MDateTime) +
C EOR +
C %Trimr(MFrom) +
C EOR +
C %Trimr(MMimeVer) +
C EOR +
C %Trimr(MTo) +
C %Trim(MCc) +
C %Trim(MBCc) +
C EOR +
C %trimr(MReceipt) +
C %Trimr(MSubject) +
C EOR +
C %Trimr(MImportnc) +
C EOR +
C %Trimr(MPriority) +
C EOR +
C 'Content-Type: multipart/mixed; boundary=' +
C '"' + %Trimr(MBoundary) + '"' +
C EOR +
C EOR +
C 'This is a multi-part message in MIME ' +
C 'format.' + EOR + EOR +
C '--' + %Trimr(MBoundary) +
C EOR +
C* 'Content-Type: text/plain; charset=us-ascii'+
C 'Content-Type: text/plain; charset='+
C %trim(charset)+
C EOR +
C 'Content-Transfer-Encoding: 7bit' +
C EOR + EOR
C Eval Data2 =
C* %Trimr(Message) +
C EOR + EOR + EOR + EOR +
C '--' + %Trimr(MBoundary)
C*** Add attachment file(s) if requested
C If NbrFiles > *Zero
C and AttachFile(1) <> '*NONE'
C Exsr WriteHead
C Do NbrFiles Z 4 0
C Clear SavePos
C Eval Pos = %Scan('/':AttachFile(Z):1)
C Dow Pos > *Zero
C Eval SavePos = Pos
C Eval Pos = %Scan('/':AttachFile(Z):Pos+1)
C Enddo
C If SavePos <> *Zero
C Eval AttachName = %Subst(AttachFile(Z):SavePos+1)
C Else
C Eval AttachName = AttachFile(Z)
C Endif
C Eval Data = EOR +
C 'Content-Type: application/octet' +
C '-stream; name="' +
C %Trimr(AttachName) + '"' +
C EOR +
C* 'Content-Disposition: inline; filename="' +
C 'Content-Disposition: attachment;' +
C ' filename="' +
C %Trimr(AttachName) + '"' +
C EOR +
C* 'Content-Transfer-Encoding: 7bit' +
C 'Content-Transfer-Encoding: base64' +
C EOR + EOR
C* Write attached file heading
C Exsr WriteAttachHd
C*** Open file and write to MIME file
C Eval FullName = %TRIMR(AttachFile(Z)) + Null
C Exsr #WATC
C If Z >= NbrFiles
C Eval Data = EOR +
C '--' + %Trimr(MBoundary) + '--' +
C EOR + EOR
C Else
C Eval Data = EOR +
C '--' + %Trimr(MBoundary)
C Endif
C Exsr WriteAttachHd
C Enddo
C Else
C*** Write end of MIME file for e-mail w/ no attachment
C Exsr WriteHead
C Endif
C*** Close file
C Eval ReturnInt = close(FileDesc)
C***
C Endsr
C*****************************************************************
C* Check Receiption Addr
C*****************************************************************
CSR ChkRcpt Begsr
C*** Add receiption to arrary
C z-add 1 x
C If Nbrofto > *Zero
C Z-add 1 Z
C Do Nbrofto Z
C Eval RcptNA =
C %SUBST(to : to_replacem(Z) + 3 : 306)
c Eval EMailAddr = RcptAddr
C Exsr ChkEmail
c Eval ToAddrArr(z) = RcptAddr
C Eval ToNameArr(z) = RcptName
c Eval OutAddrArr(x) = RcptAddr
c Eval OutDistArr(x) = DTO
C Eval x = x + 1
C EndDo
C EndIf
C If Nbrofcc > *Zero
C Z-add 1 Z
C Do Nbrofcc Z
C Eval RcptNA =
C %SUBST(cc : cc_replacem(Z) + 3 : 306)
c Eval EMailAddr = RcptAddr
C Exsr ChkEmail
c Eval CcAddrArr(z) = RcptAddr
C Eval CcNameArr(z) = RcptName
c Eval OutAddrArr(x) = RcptAddr
c Eval OutDistArr(x) = DCC
C Eval x = x + 1
C EndDo
C EndIf
C If Nbrofbcc > *Zero
C Z-add 1 Z
C Do Nbrofbcc Z
C Eval RcptNA =
C %SUBST(bcc : bcc_replacem(Z) + 3 : 306)
c Eval EMailAddr = RcptAddr
C Exsr ChkEmail
c Eval BCcAddrArr(z) = RcptAddr
C Eval BCcNameArr(z) = RcptName
c Eval OutAddrArr(x) = RcptAddr
c Eval OutDistArr(x) = DBCC
C Eval x = x + 1
C EndDo
C EndIf
CSR EndSr
C*****************************************************************
C* Create Distribution
C*****************************************************************
CSR CrtDistr Begsr
* Process the "To"-s
C z-add 0 NumberOf 4 0
C z-add 0 x 4 0
C 1 DO 1000 x
C if ToNameArr(x) = ' '
C leave
C endif
C eval NumberOf = NumberOf +1
C Z-add 0 rtnlen 10 0
C eval rtnlen =
C encodemailaddr(ToAddrArr(x):
C ToNameArr(x): outstr)
C if NumberOf = 1
C eval MTo = 'To: ' + %subst(outstr:1 : rtnlen)
C else
C eval MTo = %trimr(Mto) +
C ' ,' + %subst(outstr:1 : rtnlen)
C endif
C ENDDO
* Process the "Cc"-s
C z-add 0 NumberOf 4 0
C z-add 0 x 4 0
C 1 DO 1000 x
C if CcNameArr(x) = ' '
C leave
C endif
C eval NumberOf = NumberOf +1
C Z-add 0 rtnlen 10 0
C eval rtnlen =
C encodemailaddr(CcAddrArr(x):
C CcNameArr(x): outstr)
C if NumberOf = 1
C eval MCc = 'cc: ' + %subst(outstr:1 : rtnlen)
C else
C eval MCc = %trimr(MCc) +
C ' ,' + %subst(outstr:1 : rtnlen)
C endif
C ENDDO
* Process the "BCc"-s
C z-add 0 NumberOf 4 0
C z-add 0 x 4 0
C 1 DO 1000 x
C if BCcNameArr(x) = ' '
C leave
C endif
C eval NumberOf = NumberOf +1
C Z-add 0 rtnlen 10 0
C eval rtnlen =
C encodemailaddr(BCcAddrArr(x):
C BCcNameArr(x): outstr)
C if NumberOf = 1
C eval MBCc= 'bcc: '+ %subst(outstr:1 : rtnlen)
C else
C eval MBCc = %trimr(MBCc) +
C ' ,' + %subst(outstr:1 : rtnlen)
C endif
C ENDDO
C If %len(%trim(MCc)) > 0
C eval MTo = %trim(MTo) + EOR
C EndIf
C If %len(%trim(MBCc)) > 0
C eval MCc = %trim(MCc) + EOR
C EndIf
CSR EndSr
*=====================================================================
* Set importance
*=====================================================================
C SetImpo begsr
C eval MImportnc = *Blanks
C select
C when Importnc = '*LOW'
C eval MImportnc = 'Importance: low'
C when Importnc = '*MED'
C eval MImportnc = 'Importance: medium'
C when Importnc = '*HIG'
C eval MImportnc = 'Importance: high'
C endsl
C endsr
*=====================================================================
* Set priority
*=====================================================================
C SetPrio begsr
C eval MPriority = *blanks
C select
C when Priority = '*NUR'
C eval MPriority = 'Priority: non-urgent'
C when Priority = '*NRM'
C eval MPriority = 'Priority: normal'
C when Priority = '*URG'
C eval MPriority ='Priority: urgent'
C endsl
C endsr
*****************************************************************
* write message text to temp file
C #WBODY BEGSR
*
C Eval FullName = '/QSYS.LIB/' +
C %trim(TxtFLib) + '.LIB/' +
C %trim(TxtFile) + '.FILE/' +
C %trim(TxtFmbr) + '.MBR' + NULL
C
C Eval BodyDesc = open(%trimr(FullName)
C : O_RDONLY)
C If BodyDesc < 0
c eval err = errno
c callp die(%str(strerror(err)) + ' ' + fullname)
C return
C EndIf
C* append CRLF to Message after
C If %len(%trim(Message)) > 0
C Eval BytesWrt = write(FileDesc
C : %ADDR(CRLF)
C : 2)
C EndIf
C*** Read from file and write to MIME file
C Eval BytesRead = read(BodyDesc
C : %Addr(DataRead)
C : 80)
C Dow BytesRead > 0
C Eval InData = %Subst(DataRead:1:BytesRead) +
C EOR
C eval outstr = *blanks
C Eval rtnlen = to950(InData : outstr)
C Eval BytesWrt = write(FileDesc
C : %ADDR(outstr)
C : rtnlen)
C Eval BytesRead = read(BodyDesc
C : %Addr(DataRead)
C : 80)
C Enddo
C Eval ReturnInt = close(BodyDesc)
*
C ENDSR
C*****************************************************************
C* Write head
C*****************************************************************
CSR WriteHead Begsr
C* conver ebcdic to ascii
C Move *Blanks DataEnd 6
C Eval DataEnd = '--' + EOR + EOR
C Z-add 0 Data1Len 5 0
C Z-add 0 Data2Len 5 0
C Eval Data1len = %len(%trimr(Data1))
C Eval Data2len = %len(%trimr(Data2))
C* Eval %SubSt(Data2 : Data2Len+1 : 6) =
C* DataEnd
C* Eval Data2len = Data2len + 6
C a_c:a_x XLATE Data1 Data1
C EOR:CRLF XLATE Data1 Data1
C a_c:a_x XLATE Data2 Data2
C EOR:CRLF XLATE Data2 Data2
C a_c:a_x XLATE DataEnd DataEnd
C EOR:CRLF XLATE DataEnd DataEnd
C Eval BytesWrt = write(FileDesc
C : %ADDR(Data1)
C : Data1len)
C Eval BytesWrt = write(FileDesc
C : %ADDR(Message)
C : %len(%trim(Message)))
C If %trim(TxtFile) <> '*NONE'
C Exsr #WBODY
C EndIf
C Eval BytesWrt = write(FileDesc
C : %ADDR(Data2)
C : Data2len)
C If NbrFiles > *Zero
C and AttachFile(1) = '*NONE'
C Eval BytesWrt = write(FileDesc
C : %ADDR(DataEnd)
C : %len(%trim(DataEnd)))
C EndIf
C* Exsr WriteFile
CSR EndSr
C*****************************************************************
C* Write Attach head
C*****************************************************************
CSR WriteattachHd Begsr
C Z-add 0 Data1Len
C Eval Data1len = %len(%trimr(Data))
C a_c:a_x XLATE Data Data
C EOR:CRLF XLATE Data Data
C Eval BytesWrt = write(FileDesc
C : %ADDR(Data)
C : Data1Len)
CSR EndSr
C*****************************************************************
CSR WriteFile Begsr
C*** Write to file
C Eval BytesWrt = write(FileDesc
C : %ADDR(Data)
C : %LEN(%TRIMR(Data)))
C***
C Endsr
*===========================
* If at sign not found in e-mail address, generate an escape message
C ChkEMail begsr
C eval r = %scan(AtS:EMailAddr)
C if r = 0
C eval MsgDta = '"' + AtS +
C '" not found in"' +
C %trim(EMailAddr) + '".'
c callp die(MsgDta)
C return
C endif
C endsr
*****************************************************************
* encode attachment file and write to temp file
*****************************************************************
C #WATC BEGSR
* open attachment file
C EVAL atcfd = open(%ADDR(FullName) : 1)
*
C Z-ADD 0 rtotal 9 0
| C Z-ADD 0 inscrlf 3 0
* read 2850 byte -> base64 -> write 3900 byte
* 2850 byte (before encode) = 57(chars/line) * 50(line)
* 57 -base64encode-> * 4/3 + CRLF = 78byte
* 78 * 50 = 3900 byte (after encode)
*
* read stream file
C DO atc_st_size(Z)J
C EVAL atcfrblen = read(atcfd : %ADDR(atcfrb) :
C 2850)
C IF atcfrblen = -1
C ENDIF
* end of file
C IF atcfrblen = 0
C LEAVE
C ENDIF
C Z-ADD atcfrblen b64instrlen 9 0
* accumulate read bytes
C ADD atcfrblen rtotal
* adjust to miltiply of 3 if less than 2850 bytes read
C IF atcfrblen < 2850
* don't use %DIV/%REM for V4R2 or earlier version
C atcfrblen DIV 3 b64count 9 0
C MVR b64mod 1 0
C 3 SUB b64mod b64pad 1 0
C IF b64mod > 0
C EVAL %SUBST(atcfrb : atcfrblen + 1 : b64pad)
C = X'0000'
C ADD b64pad b64instrlen
C ENDIF
C ENDIF
* Base64 encode. should be faster than procedure call...
C Z-ADD 1 tmpfwblen
C DO b64instrlen K
C EVAL b64i = %SUBST(atcfrb : K : 3)
C MOVE *ALLX'00' b64ap
* 1st byte of outchr
C MOVE b64i1 b64ap1L
C DIV 4 b64ap1
* 2nd
C TESTB '6' b64i1 20
C 20 BITON '2' b64ap2L
C TESTB '7' b64i1 20
C 20 BITON '3' b64ap2L
C TESTB '0' b64i2 20
C 20 BITON '4' b64ap2L
C TESTB '1' b64i2 20
C 20 BITON '5' b64ap2L
C TESTB '2' b64i2 20
C 20 BITON '6' b64ap2L
C TESTB '3' b64i2 20
C 20 BITON '7' b64ap2L
* 3rd
C TESTB '4' b64i2 20
C 20 BITON '2' b64ap3L
C TESTB '5' b64i2 20
C 20 BITON '3' b64ap3L
C TESTB '6' b64i2 20
C 20 BITON '4' b64ap3L
C TESTB '7' b64i2 20
C 20 BITON '5' b64ap3L
C TESTB '0' b64i3 20
C 20 BITON '6' b64ap3L
C TESTB '1' b64i3 20
C 20 BITON '7' b64ap3L
* 4th
C BITOFF '01' b64i3
C MOVE b64i3 b64ap4L
*
C EVAL %SUBST(tmpfwbb64 : tmpfwblen : 4) =
C %SUBST(b64a : b64ap1 + 1 : 1) +
C %SUBST(b64a : b64ap2 + 1 : 1) +
C %SUBST(b64a : b64ap3 + 1 : 1) +
C %SUBST(b64a : b64ap4 + 1 : 1)
C ADD 4 tmpfwblen
* append CRLF in every 19 encodes (57->76byte)
C ADD 1 inscrlf
C IF inscrlf = 19
C EVAL %SUBST(tmpfwbb64 : tmpfwblen : 2) = CRLF
C ADD 2 tmpfwblen
C Z-ADD 0 inscrlf
C ENDIF
C ENDDO 3
*
C EVAL tmpfwblen = tmpfwblen - 1
* adjust last line
C IF atcfrblen < 2850
* remove appended CRLF
C IF inscrlf = 0
C SUB 2 tmpfwblen
C ENDIF
* adjust '='
C IF b64mod > 0
C EVAL %SUBST(tmpfwbb64 : tmpfwblen - b64pad + 1 :
C b64pad) = X'3D3D'
C ENDIF
* add CRLF
C EVAL %SUBST(tmpfwbb64 : tmpfwblen + 1 : 2) = CRLF
C ADD 2 tmpfwblen
C ENDIF
* accumulate total bytes written
C ADD tmpfwblen wtotal 9 0
* write to temp file
C EVAL BytesWrt = write(FileDesc : %ADDR(tmpfwbb64)
C : tmpfwblen)
C IF BytesWrt = -1
C ENDIF
* write operation not complete
C IF BytesWrt <> tmpfwblen
C ENDIF
* accumulate total bytes written to temp file
C EVAL tmpf_size = tmpf_size + BytesWrt
* no more data to read
C IF atcfrblen < 2850
C LEAVE
C ENDIF
*
C ENDDO 2850
* close attachment file
C IF -1 = close(atcfd)
C ENDIF
* compare read total with file size
C IF rtotal <> atc_st_size(I)
C ENDIF
*
C ENDSR
*****************************************************************
* encode mail address and description
* return : length of outstr
* < 0 return code form procedure 'smtphead'
* mtype : 'From:', 'To:', 'cc:', 'bcc:', 'Reply-To:' I
* mail_addr : mail address I
* mail_desc : mail address description I
* outstr : encoded string O
*
Pencodemailaddr B
Dencodemailaddr PI 10I 0
D mail_addr 256 VALUE
D mail_desc 50 VALUE
D outstr 9999
*
Doutstrlen S 3P 0
*
* mail adderss description is blank
C EVAL outstrlen = smtphead(%TRIM(mail_desc) :
C outstr)
C IF outstrlen < 0
C RETURN outstrlen
C ENDIF
C EVAL outstr = ' "' +
C %SUBST(outstr : 1 : outstrlen) + '"'
C Eval outstrlen = outstrlen + 3
* folding
C IF outstrlen - fold + 8 > 65
C EVAL %SUBST(outstr : outstrlen + 1 : 2) = CRLF
C EVAL outstrlen = outstrlen + 2
C ENDIF
* append mail address
C EVAL outstr = %SUBST(outstr : 1 : outstrlen) +
C ' <' + %TRIM(mail_addr) + '>'
C EVAL outstrlen = outstrlen +
C %LEN(%TRIM(mail_addr)) + 3
*
C RETURN outstrlen
Pencodemailaddr E
*****************************************************************
* Generate SMTP mail header
* return : length of outstr
* 0 nothing to process
* -1, -2, -3, -4 return code from other procedures
* -5 invalid character set (should not happen though)
* instr : input string (EBCDIC) I
* outstr : encoded string (EBCDIC) O
* (dftjobccsid : CCSID of instr )R
* (charset : 'US-ASCII' or 'US-ASCII-NONSAFE' or 'ISO-8859-1' )M
* ( or 'ISO-2022-JP' (Japanese) )
* (fold : last folding position of encoded string )M
*
Psmtphead B
Dsmtphead PI 10I 0
D instr 9999 VALUE
D outstr 9999
*
Dinstrlen S 3P 0
Dascii S 9999
Drc S 3P 0
*
C EVAL instrlen = %LEN(%TRIMR(instr))
C IF instrlen = 0
C RETURN 0
C ENDIF
* encode string
C SELECT
* Plain ASCII
C WHEN charset = 'US-ASCII'
C EVAL outstr = instr
C RETURN %LEN(%TRIM(instr))
C WHEN charset = 'Big5'
* convert jobccsid -> 950
C EVAL rc = to950(instr : ascii)
C IF rc < 0
C RETURN rc
C ENDIF
C RETURN Bencode(ascii : rc : outstr)
*
C ENDSL
*
C RETURN -5
*
Psmtphead E
*****************************************************************
* Convert EBCDIC string to Big5
*
* return : length of Big5 string
* 0 no graphic character found
* -1 iconv error (->950)
* ebcdic : ebcdic representation of original string I
* c950 : Big5 string O
*
Pto950 B
Dto950 PI 10I 0
D ebcdic 9999 VALUE
D c950 9999
*
D***
D QDCXLATE PR ExtPgm('QDCXLATE')
D CvtDtaLen 5 0
D CvtDta 10
D SBCSTabNam 10
D SBCSTabLib 10
D OutputDta 10
D Outbuflen 5 0
D Outcvtlen 5 0
D DBCSID 10
D ShiftInOut 1
D CvtType 10
D
D CvtDtaLen S 5 0
D CvtDta S 9999
D SBCSTabNam S 10
D SBCSTabLib S 10
D OutputDta S 9999
D Outbuflen S 5 0
D Outcvtlen S 5 0
D DBCSID S 10 inz('*BG5')
D ShiftInOut S 1
D CvtType S 10 inz('*EA')
Debcdic_len S 3P 0
Dc950_len S 10I 0
Dc950_chr S 1
* no character other than space (X'40') found
C Eval CvtType = '*EA'
C Eval DBCSID = '*BG5'
C Eval Outbuflen = 9999
C EVAL CvtDtaLen = %LEN(%TRIMR(ebcdic))
C IF CvtDtaLen = 0
C RETURN 0
C ENDIF
C Eval CvtDta = ebcdic
* convert to 950(Big5)
C CallP QDCXLATE ( CvtDtaLen :
C CvtDta :
C SbcsTabnam :
C SbcsTabLib :
C OutputDta :
C OutBufLen :
C Outcvtlen :
C DBCSID :
C ShiftInOut :
C CvtType )
C EVAL c950_len = Outcvtlen
C IF c950_len < 0
C RETURN -1
C ENDIF
C Eval c950 = %subst(OutputDta :1 : Outcvtlen)
*
C RETURN c950_len
Pto950 E
C*****************************************************************
* 'B' encode for DBCS mail header
* return : length of newbuf
* -4 especials found <- 2002-05-06 out of use
* ascii : input string I
* buflen : length of input string I
* newbuf : output (converted) string O
* (structured : string is in structured field of mail header )R
* (charset : 'US-ASCII' or 'US-ASCII-NONSAFE' or 'ISO-8859-1' )R
* (fold : > 0 if folding occured )M
*
*****************************************************************
PBencode B
DBencode PI 3P 0
D ascii 256 VALUE
D buflen 3P 0 VALUE
D newbuf 256
*
Dbufpos S 3P 0
Dcslen S 3P 0
Dchr S 1
Desc S 3 INZ(G0ascii)
Dline S 44
Dlinel S 2P 0
*
C EVAL cslen = %LEN(%TRIM(charset))
C EVAL newbuf = '=?' + %TRIM(charset) + '?B?'
C EVAL bufpos = cslen + 6
C EVAL fold = 0
*
1 C DO buflen I 3 0
| C EVAL chr = %SUBST(ascii : I : 1)
* escape char
2 C IF chr = X'1B'
| C EVAL esc = %SUBST(ascii : I : 3)
C EVAL I = I + 2
C EVAL linel = linel + 3
* normal char
E C ELSE
* DBCS
3 C IF esc = G0k78 or esc = G0k83
| C EVAL I = I + 1
| C EVAL linel = linel + 2
* SBCS
E C ELSE
| C EVAL linel = linel + 1
3 C ENDIF
2 C ENDIF
* Base64 encode when line legnth exceeds 35 bytes or end of string
2 C IF (linel > 35) or (I >= buflen)
| C EVAL line = %SUBST(ascii : I - linel + 1 : linel)
* add ascii escape sequence if not end as SBCS
3 C IF esc <> G0ascii and esc <> G0roman
| C EVAL %SUBST(line : linel + 1 : 3) = G0ascii
| C EVAL linel = linel + 3
3 C ENDIF
* adjust to multiple of 3 for base64 encode
C linel DIV 3 b64count 3 0
C MVR b64mod 3 0
C 3 SUB b64mod b64pad 3 0
3 C IF b64mod > 0
| C EVAL %SUBST(line : linel + 1 : b64pad) = X'0000'
| C EVAL linel = linel + b64pad
3 C ENDIF
* Base64 encode (3 to 4)
3 C DO linel J 3 0
| C EVAL %SUBST(newbuf : bufpos : 4) =
C base64e(%SUBST(line : J : 3))
| C EVAL bufpos = bufpos + 4
3 C ENDDO 3
C Z-ADD 0 linel
* Pad '='
3 C IF b64mod > 0
C EVAL %SUBST(newbuf : bufpos - b64pad : b64pad) =
C '=='
C ENDIF
* end of input string or maximum line length
3 C IF (I >= buflen) or (bufpos > 180)
| C EVAL %SUBST(newbuf : bufpos : 2) = '?='
| C EVAL bufpos = bufpos + 2
<- C LEAVE
| * folding
E C ELSE
| C EVAL %SUBST(newbuf : bufpos : cslen + 10) =
C '?=' + X'0D0A' + ' =?' +
C %TRIM(charset) + '?B?'
C EVAL fold = bufpos + 6
C EVAL bufpos = bufpos + cslen + 10
* add ascii escape sequence if not end as SBCS
4 C IF esc <> G0ascii and esc <> G0roman
| C EVAL %SUBST(newbuf : bufpos : 4) = base64e(esc)
| C EVAL bufpos = bufpos + 4
|4 C ENDIF
3 C ENDIF
| *
|2 C ENDIF
1 C ENDDO
*
C RETURN bufpos - 1
*****************************************************************
PBencode E
* Base64 encode (3 to 4)
* inchr : 3 bytes string to convert I
* return : Converted character (ASCII)
*
*****************************************************************
Pbase64e B
Dbase64e PI 4
D inchr 3 VALUE
*
Dchrs DS
D i1 1 1
D i2 2 2
D i3 3 3
Dap1DS DS
D ap1 1 2U 0 INZ(0)
D ap1L 2 2
Dap2DS DS
D ap2 1 2U 0 INZ(0)
D ap2L 2 2
Dap3DS DS
D ap3 1 2U 0 INZ(0)
D ap3L 2 2
Dap4DS DS
D ap4 1 2U 0 INZ(0)
D ap4L 2 2
*
Db64e C 'ABCDEFGHIJKLMNOPQRSTUVWXYZ-
D abcdefghijklmnopqrstuvwxyz-
D 0123456789+/'
C MOVE inchr chrs
* 1st byte of outchr
C MOVE i1 ap1L
C DIV 4 ap1
* 2nd
C TESTB '6' i1 20
C 20 BITON '2' ap2L
C TESTB '7' i1 20
C 20 BITON '3' ap2L
C TESTB '0' i2 20
C 20 BITON '4' ap2L
C TESTB '1' i2 20
C 20 BITON '5' ap2L
C TESTB '2' i2 20
C 20 BITON '6' ap2L
C TESTB '3' i2 20
C 20 BITON '7' ap2L
* 3rd
C TESTB '4' i2 20
C 20 BITON '2' ap3L
C TESTB '5' i2 20
C 20 BITON '3' ap3L
C TESTB '6' i2 20
C 20 BITON '4' ap3L
C TESTB '7' i2 20
C 20 BITON '5' ap3L
C TESTB '0' i3 20
C 20 BITON '6' ap3L
C TESTB '1' i3 20
C 20 BITON '7' ap3L
* 4th
C BITOFF '01' i3
C MOVE i3 ap4L
*
C RETURN %SUBST(b64e : ap1 + 1 : 1) +
C %SUBST(b64e : ap2 + 1 : 1) +
C %SUBST(b64e : ap3 + 1 : 1) +
C %SUBST(b64e : ap4 + 1 : 1)
*
Pbase64e E
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* This ends this program abnormally, and sends back an escape.
* message explaining the failure.
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P die B
D die PI
D peMsg 256A const
D SndPgmMsg PR ExtPgm('QMHSNDPM')
D MessageID 7A Const
D QualMsgF 20A Const
D MsgData 256A Const
D MsgDtaLen 10I 0 Const
D MsgType 10A Const
D CallStkEnt 10A Const
D CallStkCnt 10I 0 Const
D MessageKey 4A
D ErrorCode 32766A options(*varsize)
D dsEC DS
D dsECBytesP 1 4I 0 INZ(256)
D dsECBytesA 5 8I 0 INZ(0)
D dsECMsgID 9 15
D dsECReserv 16 16
D dsECMsgDta 17 256
D wwMsgLen S 10I 0
D wwTheKey S 4A
c eval wwMsgLen = %len(%trimr(peMsg))
c if wwMsgLen<1
c return
c endif
c callp SndPgmMsg('CPF9897': 'QCPFMSG *LIBL':
c peMsg: wwMsgLen: '*ESCAPE':
c '*PGMBDY': 1: wwTheKey: dsEC)
c return
P E
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* This procedure return call socket C API errno
*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
P errno B
D errno PI 10I 0
D p_errno S *
D wwreturn S 10I 0 based(p_errno)
C eval p_errno = @__errno
c return wwreturn
P E
File : QCMDSRC
Member: SNDEMAIL
Type : CMD
Usage : CRTCMD lib/SNDEMAIL SRCFILE(srclib/srcfile) PGM(lib/SNDEMAILR)
SNDEMAIL SENDERNAME('Sender name') SENDERADDR(name@company.com.tw)
TO(('Receipt 中文 ' name@company.com.tw)) ATTACHMENT('/tmp/qcustcdt.txt') SUBJECT(' 主旨 ') TXTF(QGPL/QDDSSRC) TXTMBR(QDSIGNON)
如果要匯出 AS/400 資料庫使用 CPYTOIMPF 指令. 例如: CPYTOIMPF FROMFILE(QIWS/QCUSTCDT) TOSTMF('/tmp/qcustcdt.txt') STMFCODP
AG(*PCASCII) RCDDLM(*CRLF) DTAFMT(*FIXED)
本指令只支援 IFS 目錄下的附件，並不支援 /QSYS.LIB/library.lib/...。
/*********************************************************************/
/* To create this command, issue the following: */
/* CRTCMD lib/SNDEMAIL SRCFILE(srclib/srcfile) PGM(lib/SNDEMAILR) */
/* November 2003 */
/* Author: Vengoal Chang */
/*********************************************************************/
CMD PROMPT('Send an E-mail Message')
PARM KWD(SENDERADDR) TYPE(*PNAME) LEN(255) MIN(1) +
EXPR(*YES) PROMPT('Sender email address' 2)
PARM KWD(TO) TYPE(TO) MIN(1) MAX(30) +
PROMPT('Recipient' 3)
PARM KWD(SENDERNAME) TYPE(*CHAR) LEN(256) +
DFT(*NONE) SPCVAL((*NONE '')) EXPR(*YES) +
PROMPT('Sender name' 1)
PARM KWD(CC) TYPE(CC) MAX(30) PROMPT('CC' 4)
PARM KWD(BCC) TYPE(BCC) MAX(30) PROMPT('BCC' 5)
PARM KWD(ATTACHMENT) TYPE(*PNAME) LEN(256) +
DFT(*NONE) SNGVAL((*NONE)) MAX(30) +
EXPR(*YES) PROMPT('File attachment' 6)
PARM KWD(SUBJECT) TYPE(*CHAR) LEN(256) DFT(*NONE) +
SPCVAL((*NONE '')) EXPR(*YES) +
PROMPT('Subject' 7)
PARM KWD(MESSAGE) TYPE(*CHAR) LEN(512) +
DFT(*NONE) SPCVAL((*NONE '')) EXPR(*YES) +
PROMPT('Message' 8)
PARM KWD(TXTF) TYPE(QUAL1) PROMPT('Text source +
file')
QUAL1: QUAL TYPE(*NAME) LEN(10) DFT(*NONE) SPCVAL((*NONE +
*NONE))
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*LIBL) (*CURLIB)) PROMPT('Library')
PARM KWD(TXTMBR) TYPE(*NAME) LEN(10) PROMPT('Text +
source member')
PARM KWD(IMPORTNC) TYPE(*CHAR) LEN(4) RSTD(*YES) +
DFT(*MED) VALUES(*LOW *MED *HIG) +
PROMPT('Importance' )
PARM KWD(PRIORITY) TYPE(*CHAR) LEN(4) RSTD(*YES) +
DFT(*NRM) VALUES(*NUR *NRM *URG) +
PROMPT('Priority' )
PARM KWD(RECEIPT) TYPE(*CHAR) LEN(4) RSTD(*YES) +
DFT(*NO) VALUES(*NO *YES) PROMPT('Return +
receipt' )
PARM KWD(TMPDIR) TYPE(*PNAME) LEN(64) DFT('/TMP') +
PMTCTL(*PMTRQS) +
PROMPT('Work directory')
TO: ELEM TYPE(*CHAR) LEN(50) EXPR(*YES) +
PROMPT('Name')
ELEM TYPE(*CHAR) LEN(256) EXPR(*YES) +
PROMPT('Mail address')
CC: ELEM TYPE(*CHAR) LEN(50) MIN(1) EXPR(*YES) +
PROMPT('Name')
ELEM TYPE(*CHAR) LEN(256) MIN(1) EXPR(*YES) +
PROMPT('Mail address')
BCC: ELEM TYPE(*CHAR) LEN(50) MIN(1) EXPR(*YES) +
PROMPT('Name')
ELEM TYPE(*CHAR) LEN(256) MIN(1) EXPR(*YES) +
PROMPT('Mail address')
訂閱：
文章 (Atom)