| 
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* NEWS/400, September 1998
H* Copyright (c) 1998 Duke Communications Internationa
H* ALL RIGHTS RESERVED
H*****************************************************************
D* IFS PROTOTYPES
D*****************************************************************
D*** open an IFS file
Dopen PR 10I 0 EXTPROC('open')
D filename * VALUE
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
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***************************************************************** 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(CPFID) D Subject S 256A D Message S 512A D AttachName S 256A D AsciiCodePage S 10U 0 INZ(819) D*** D Addressee S Like(Address) D AddresseeName S Like(Address) D TotalRecp S 9B 0 D*** |
|
D FileDesc S 10I 0
D BytesWrt S 10I 0
D Data S 9999A
D AttachDesc S 10I 0
D BytesRead S 10I 0
D DataRead S 9899A
D EOR S 2A Inz(X'0D25')
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 MDateTime S 256A
D MFrom S 256A
D MMimeVer S 256A
D MTo S 256A
D MSubject S 256A
D MBoundary S 256A Inz('--PART.BOUNDARY.1')
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 APIBytes 1 4B 0
D CPFID 9 15
D*** Constants
D DTo C Const(0)
D DCC C Const(1)
D DBCC C Const(2)
D MsgSize C Const(%Len(Message))
D**********************************************************************
D* Protoyope pour la procédure sndcvt qui utilise iconv(dans cvt500)
|
|
D********************************************************************** DSNDCVT PR D 32767 options(*varsize) D 5 0 value D***************************************************************** C* MAIN LINE CALCULATIONS C***************************************************************** C*** Entry Parms C *ENTRY PLIST C PARM FileName C Address Parm Addressee C Parm Originator C Parm AddresseeName C Parm OriginName C Parm Attachment C Parm Subject C Parm Message C*** Initialize error structure C Eval APIBytes = 11 C*** Initialize values C Eval FileLen = %Len(%Trimr(FileName)) C Eval %Subst(FileName:FileLen+1:2) = X'0000' C Eval OriginLen = %Len(%Trimr(Originator)) C Eval Format = 'ADDR0100' C Eval DistrType = DTo C Eval Reserved = 0 C Eval AddrLen = %Len(%Trimr(Address)) C Eval OffSet = 0 C Eval TotalRecp = 1 C*** Write MIME file C Exsr WriteHdr C*** Ajout volubis * (conversion des adresses en code page 500) c callp sndcvt(Originator : %len(originator)) c callp sndcvt(Address : %len(Address)) C*** Call API to send e-mail C CallB 'QtmmSendMail' C Parm FileName C Parm FileLen C Parm Originator C Parm OriginLen C Parm Recipient C Parm TotalRecp |
|
C Parm APIError C*** Return to caller C Exit Tag C Return C***************************************************************** C* Write header portion of file C***************************************************************** CSR WriteHdr Begsr C*** Open file C Eval FullName = %TRIMR(FileName) + Null C Eval FileDesc = open(%ADDR(FullName) C : O_CREAT + O_WRONLY + O_TRUNC + C O_CODEPAGE C : S_IRWXU + S_IROTH C : AsciiCodePage) C Eval ReturnInt = close(FileDesc) C Eval FileDesc = open(%ADDR(FullName) C : O_TEXTDATA + O_RDWR) C*** Build MIME header fields C Eval MSender = C 'Sender: ' + Originator C Eval MDateTime = C 'Date: ' C Eval MFrom = C 'From: ' + C %Trimr(OriginName) + ' <' + C %Trimr(Originator) + '>' C Eval MMimeVer = C 'MIME-Version: 1.0' C If AddresseeName > *Blanks C Eval MTo = C 'To: ' + %TRIMR(AddresseeName) + C ' <' + %TRIMR(Address) + '>' C Else C Eval MTo = C 'To: ' + %TRIMR(Address) C Endif C If Subject > *Blanks C Eval MSubject = C 'Subject: ' + Subject C Else C Eval MSubject = C 'Subject: ' C Endif |
|
C Eval Data = %Trimr(MSender) +
C EOR +
C %Trimr(MDateTime) +
C EOR +
C %Trimr(MFrom) +
C EOR +
C %Trimr(MMimeVer) +
C EOR +
C %Trimr(MTo) +
C EOR +
C %Trimr(MSubject) +
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 EOR +
C 'Content-Transfer-Encoding: 7bit' +
C EOR + EOR +
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 WriteFile
C Do NbrFiles Z 5 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-Transfer-Encoding: 7bit' + C EOR + C 'Content-Disposition: inline; filename="' + C %Trimr(AttachName) + '"' + C EOR + EOR C Exsr WriteFile C*** Open file C Eval FullName = %TRIMR(AttachFile(Z)) + Null C Eval AttachDesc = open(%ADDR(FullName) C : O_RDONLY + O_TEXTDATA) C*** Read from file and write to MIME file C Eval BytesRead = read(AttachDesc C : %Addr(DataRead) C : %Size(DataRead)) C Dow BytesRead > 0 C Eval Data = %Subst(DataRead:1:BytesRead) C Eval BytesWrt = write(FileDesc C : %ADDR(Data) C : %LEN(%TRIMR(Data))) C Eval BytesRead = read(AttachDesc C : %Addr(DataRead) C : %Size(DataRead)) C Enddo C*** Close attachment file and write to MIME C Eval ReturnInt = close(AttachDesc) 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 WriteFile C Enddo C Else C*** Write end of MIME file for e-mail w/ no attachment C Eval Data = %Trimr(Data) + '--' + EOR + EOR C Exsr WriteFile C Endif |
|
C*** Close file C Eval ReturnInt = close(FileDesc) C*** C Endsr C***************************************************************** C* Write file C***************************************************************** CSR WriteFile Begsr C*** Write to file C Eval BytesWrt = write(FileDesc C : %ADDR(Data) C : %LEN(%TRIMR(Data))) C*** C Endsr C***************************************************************** |
