如何直接使用 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')
星期一, 11月 06, 2023
2003-11-20 如何直接使用 QtmmSendMail API 傳送 E-amil ?(Command SNDEMAIL)
訂閱：
張貼留言 (Atom)
沒有留言:
張貼留言