Re: SNDEMAILR using QtmmSendMail (dave leland)

Mine is from 1996 and worked when we took it out of production on V7R1.

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*****************************************************************
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*** 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*****************************************************************



On Thu, Dec 28, 2017 at 12:56 PM, Jay Vaughn <jeffersonvaughn@xxxxxxxxx>
wrote:

Would anyone mind providing the source to the SNDEMAILR pgm that Dave
Leland originally wrote a long time ago?

I have a version, from which I can't remember where I obtained that seems
to be having issues.

If someone could provide a "working" version of it, it would save me a

TON

of time.

Thanks in advance...
--
This is the RPG programming on the IBM i (AS/400 and iSeries) (RPG400-L)
mailing list
To post a message email: RPG400-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: https://lists.midrange.com/mailman/listinfo/rpg400-l
or email: RPG400-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at https://archive.midrange.com/rpg400-l.

Please contact support@xxxxxxxxxxxx for any subscription related
questions.

Help support midrange.com by shopping at amazon.com with our affiliate
link: http://amzn.to/2dEadiD

--
Art Tostaine
--
This is the RPG programming on the IBM i (AS/400 and iSeries) (RPG400-L)
mailing list
To post a message email: RPG400-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: https://lists.midrange.com/mailman/listinfo/rpg400-l
or email: RPG400-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at https://archive.midrange.com/rpg400-l.

Please contact support@xxxxxxxxxxxx for any subscription related
questions.

Help support midrange.com by shopping at amazon.com with our affiliate
link: http://amzn.to/2dEadiD