CDO.sys to send mail with base64 encoding ASP help

[maxxxxel]

Hi

Can anyone help me with some asp code , I changed the code to use CDO.message instead of the old cdont.sys to send mail from a ASP webpage which works fine.

Our problem is that when we send mail externally to a internet email site like Gmail the PDF is sent but is corrupted because CDOSYS ends up using binary encoding
rather than Base64 encoding when creating the attachment. More information here: Anthonys Code

My knowledge of ASP is basic. The second bit of code is at the bottom is written by Anthony so i am trying to change my code to support base64 with the help of his code but at th moment i am lost

Thanks for any imput :-)

<%
 
if Session("LoggedIn") = False Then
Response.Redirect("autoexit.htm")
end if
Response.Buffer = False
Server.ScriptTimeout = 310
 
Dim Q, iAtt, bErr, strErrNum, strErrDesc, strFilepath, PCL2PDF, ObjReference
Dim strFrom, strTo, strCC, strSubject, strBody, strAttachments, strFromString, strSubjectString
Dim strCompany, strDocumentname, strInvoicenumber, strVisibleFileName, strExtension 'for building the visible attachment name
Dim strUser, strPassword, strServer, strDatabase 'connection-variables to the database
Dim strShortAttName 'e.g.: 154209.tif
Dim strAttFileName ' e.g.: KundFaktura29875199F3769788749425000.gz
Dim strAttFile 'e.g.: DFC6C9CECAC8CCCACACC154209.tif
Dim dosendmail
 
Q = Chr(34)
iAtt=0
bErr = False
strErrNum = ""
strErrDesc = ""
strFilepath = Application("filepath")+Session("sid")+"\"
PCL2PDF = Request.Cookies("PCL2PDF")
strUser = Session("u")
strPassword = Session("p")
strServer = Request.Cookies("RePrintWebClient")("s")
strDatabase = Request.Cookies("RePrintWebClient")("d")
 
Function AttachmentName(ObjId, FileType)
Dim strFilename 'the real filename in the temp-directory, e.g.: .PDF or .MIME
Dim splitFile 'array
If UCase(FileType)="PCL" Then
 
If PCL2PDF = "No" Then
strFilename = ObjReference.GetAttachmentName(strUser, strPassword, strServer, strDatabase, strFilepath, ObjId, FileType)
Else
strFilename = ObjReference.GetAttachmentNamePDF(strUser, strPassword, strServer, strDatabase, strFilepath, ObjId, FileType)
End If
Else
strFilename = ObjReference.GetAttachmentName(strUser, strPassword, strServer, strDatabase, strFilepath, ObjId, FileType)
End If
If Left(strFilename, 5)="ERROR" Then
strFilename = ""
End if
 
If ucase(right(strFilename,4))="MIME" Then
splitFile = split(ObjReference.GetAttachmentFile( strFilepath+strFilename ),"#")
strShortAttName = splitFile(0)
strAttFileName = splitFile(1)
strAttFile = splitFile(2)
'strTo = splitFile(3)
'strCC = splitFile(4)
'strFromString = splitFile(5)
'strSubjectString = splitFile(6)
Else
strShortAttName = strFilename
End If
strExtension = right(strShortAttName,len(strShortAttName)-InStrRev(strShortAttName,".")+1)
If ucase(right(strFilename,4))="MIME" Then
strVisibleFileName = left(strFilename,len(strFilename)-5) & strExtension
AttachmentName = strFilepath & ObjReference.GetConfiguration(strServer,strDatabas  e,strUser,strPassword,"mailcompany") & " " & Request.Form("objType") & " " & ObjReference.GetAtt(strUser, strPassword, strServer, strDatabase, strFilepath, ObjId, strAttFileName, strAttFile)
Else
strVisibleFileName = strFilename
AttachmentName = strFilepath & strFilename
End If
End Function
 
Function Sendmail()
Dim Mail, strmailitems, splitmailitems, i, splitmailitem, splitobjid, splitft
strmailitems = Request.Form("mailitems")
splitmailitems = split(strmailitems,";")
Set Mail = CreateObject("CDO.Message")
 
 
 
 
If err.number = 0 then
for i=0 to ubound(splitmailitems) step 1
splitmailitem = splitmailitems(i)
splitft = mid(splitmailitem,instr(splitmailitem,"#")+1)
splitobjid = mid(splitmailitem,1,len(splitmailitem)-len(splitft)-1)
If splitmailitem <> "" Then
Mail.AddAttachment AttachmentName(splitobjid,splitft),strVisibleFileN  ame
iAtt = iAtt + 1
End If
next
Mail.From = strFrom
Mail.To = strTo
Mail.CC = strCC
Mail.Subject = strSubject
' Mail.BodyFormat = 1
' Mail.MailFormat = 1
' Mail.Body= strBody
Mail.Configuration.Fields.Item _
("h***p://schemas.microsoft.com/cdo/configuration/sendusing")=2
 
'Name or IP of remote SMTP server
Mail.Configuration.Fields.Item _
("h***p://schemas.microsoft.com/cdo/configuration/smtpserver") _
="**********"
'Server port
Mail.Configuration.Fields.Item _
("h***p://schemas.microsoft.com/cdo/configuration/smtpserverport") _
=25
 
Mail.Configuration.Fields.Update
Mail.Send
Set Mail = Nothing
Else
bErr = True
strErrDesc = err.description
strErrNum = err.number
End if
Set ObjReference = Nothing
End Function
 
Function GetFormData()
Dim strmailitems, splitmailitems, i, splitmailitem, splitobjid, splitft, strtest, strAhref
strmailitems = Request.Form("mailitems")
strAhref = ""
splitmailitems = split(strmailitems,";")
If err.number = 0 then
for i=0 to ubound(splitmailitems) step 1
splitmailitem = splitmailitems(i)
splitft = mid(splitmailitem,instr(splitmailitem,"#")+1)
splitobjid = mid(splitmailitem,1,len(splitmailitem)-len(splitft)-1)
If splitmailitem <> "" Then
strtest = AttachmentName(splitobjid,splitft)
If UCase(splitft)="MIME" Then
strAhref = strAhref & "<a href=" & Q & "Show Attachment" & Q & " OnClick=" & Q & "ShowAtt('" & splitobjid & "','" & strAttFileName & "','" & strAttFile & "');return false" & Q & "><img border=" & Q & "0" & Q & " src=" & Q & "images/att.gif" & Q & " align=" & Q & "texttop" & Q & ">" & strVisibleFileName & "</a><br>"
Else
strAhref = strAhref & "<a href=" & Q & "Show Attachment" & Q & " OnClick=" & Q & "Show('" & splitobjid & "','" & splitft & "');return false" & Q & "><img border=" & Q & "0" & Q & " src=" & Q & "images/att.gif" & Q & " align=" & Q & "texttop" & Q & ">" & strVisibleFileName & "</a><br>"
End If
strAttachments = strAttachments & strVisibleFileName
iAtt = iAtt + 1
End If
next
Else
bErr = True
strErrDesc = err.description
strErrNum = err.number
End if
Response.Write "<table width=" & Q & "70%" & Q & " bgcolor=" & Q & "#FFFFFF" & Q & " style=" & Q & "border-style:groove;border-width:medium" & Q & ">"
Response.Write "<tr>"
Response.Write "<td width=" & Q & "110" & Q & " valign=" & Q & "top" & Q & "><b>From:</b></td>"
Response.Write "<td title=" & Q & "From" & Q & " valign=" & Q & "top" & Q & "><INPUT type=" & Q & "text" & Q & " name=" & Q & "fldFrom" & Q & " id=" & Q & "fldFrom" & Q & " value=" & Q & strFrom & Q & " style=" & Q & "width:100%" & Q & "></td>"
Response.Write "</tr>"
Response.Write "<tr>"
Response.Write "<td width=" & Q & "110" & Q & " valign=" & Q & "top" & Q & "><b>To:</b></td>"
Response.Write "<td title=" & Q & "To" & Q & " valign=" & Q & "top" & Q & "><INPUT type=" & Q & "text" & Q & " name=" & Q & "fldTo" & Q & " id=" & Q & "fldTo" & Q & " value=" & Q & strTo & Q & " style=" & Q & "width:100%" & Q & "></td>"
Response.Write "</tr>"
Response.Write "<tr>"
Response.Write "<td width=" & Q & "110" & Q & " valign=" & Q & "top" & Q & "><b>Cc:</b></td>"
Response.Write "<td title=" & Q & "Cc" & Q & " valign=" & Q & "top" & Q & "><INPUT type=" & Q & "text" & Q & " name=" & Q & "fldCC" & Q & " id=" & Q & "fldCC" & Q & " value=" & Q & strCC & Q & " style=" & Q & "width:100%" & Q & "></td>"
Response.Write "</tr>"
Response.Write "<tr>"
Response.Write "<td width=" & Q & "110" & Q & " valign=" & Q & "top" & Q & "><b>Subject:</b></td>"
Response.Write "<td title=" & Q & "Subject" & Q & " valign=" & Q & "top" & Q & "><INPUT type=" & Q & "text" & Q & " name=" & Q & "fldSubject" & Q & " id=" & Q & "fldSubject" & Q & " value=" & Q & strSubject & Q & " style=" & Q & "width:100%" & Q & "></td>"
Response.Write "</tr>"
Response.Write "<tr>"
Response.Write "<td width=" & Q & "110" & Q & " valign=" & Q & "top" & Q & "><b>Body:</b></td>"
Response.Write "<td title=" & Q & "Body" & Q & " valign=" & Q & "top" & Q & "><textarea name=" & Q & "fldBody" & Q & " id=" & Q & "fldBody" & Q & " wrap=" & Q & "soft" & Q & " style=" & Q & "width:100%;font-family:Verdana;font-size:8pt" & Q & ">" & strBody & "</textarea></td>"
Response.Write "</tr>"
Response.Write "<tr>"
Response.Write "<td width=" & Q & "110" & Q & " valign=" & Q & "top" & Q & "><b>Attachments:</b></td>"
Response.Write "<td title=" & Q & "View attachment" & Q & " valign=" & Q & "top" & Q & ">"
Response.Write strAhref
Response.Write "</td>"
Response.Write "</tr>"
Response.Write "</table>"
Set ObjReference = Nothing
End Function
 
 
%>

Anthonys Code to send base64 attachments

Function AddAttachment(Message, Source, FileName, MimeType)
 
Dim oPart ' As IBodyPart
Dim oStreamIn ' As ADODB.Stream
Dim oStreamOut ' As ADODB.Stream
 
Set oPart = Message.Attachments.Add
 
oPart.ContentMediaType = MimeType & "; Name = """ & FileName & """"
oPart.ContentTransferEncoding = "base64"
oPart.Fields("urn:schemas:mailheader:content-disposition").Value =
"attachment; FileName = """ & FileName & """"
oPart.Fields.Update
 
Set oStreamIn = Server.CreateObject("ADODB.Stream")
 
oStreamIn.Open
oStreamIn.Type = adTypeBinary
oStreamIn.LoadFromFile Source
 
Set oStreamOut = oPart.GetDecodedContentStream
 
oStreamIn.CopyTo oStreamOut
 
oStreamOut.Flush
 
oStreamIn.Close
 
Set AddAttachment = oPart
 
End Function
 
 

[maxxxxel]

Fixed it :)

I cant believe it was so simple :)

I just needed to add:

Mail.HTMLBody = ("message")

This causes the encoding of the mail to change