Etwas eigenartig musste ich die Proc SendFiles() schreiben. Ich hätte gerne die Schleife
For i=0 To OutputBufferLength/60 geschrieben. Leider fehlt dann in der Ausgabe die erste Zeile. Das erste Byte ist dann 0!?
PeekS(*memout+1,60) liefert ein korrektes Ergebnis allerdings mit fehlendem ersten Zeichen.
Vielleicht weiss hier ja jemand wie man die ganze Geschichte weiter optimieren kann. Ein Timeout währe ja auch nicht schlecht oder sogar
Status-Events. Leider bin ich nicht ganz so fit in diesen Dingen.
Teile werdet Ihr bestimmt wiedererkennen, sie sind aus den Foren bzw. dem Code-Archiv.
Code: Alles auswählen
Global ConnectionID.l
Global CrLf.s
CrLf.s=Chr(13)+Chr(10)
Enumeration
#eHlo
#RequestAuthentication
#Username
#Password
#MailFrom
#RcptTo
#Data
#Quit
#Complete
EndEnumeration
NewList Attachments.s()
InsertElement(Attachments())
Attachments() = "c:\afile.htm"
;InsertElement(Attachments())
;Attachments() = "c:\another.jpg"
Declare.s Base64Encode(strText.s)
Declare SendFiles()
Declare.s GetMIMEType(Extension.s)
Declare Send(msg.s)
Declare SendESMTPMail(name.s,sender.s,recipient.s,username.s,password.s,smtpserver.s,subject.s,body.s)
;Sending Mail with SMTP-AUTH
sendesmtpmail("Clipper","my@email.com","your@email.com","username","password","auth.smtp.mailserver.com","Hallo","This is the body")
; Don´t fill the Username if you want to sent regular
;sendesmtpmail("Clipper","my@email.com","your@email.com","","","smtp.mailserver.com","Hallo","This is the body")
Procedure SendESMTPMail(name.s,sender.s,recipient.s,username.s,password.s,smtpserver.s,subject.s,body.s)
If InitNetwork()
ConnectionID = OpenNetworkConnection(smtpserver, 25)
If ConnectionID
loop250.l=0
Repeat
If NetworkClientEvent(ConnectionID)
ReceivedData.s=Space(256)
ct=ReceiveNetworkData(ConnectionID ,@ReceivedData,256)
If ct
cmdID.s=Left(ReceivedData,3)
cmdText.s=Mid(ReceivedData,5,ct-6)
Debug "<" + cmdID + " " + cmdText
Select cmdID
Case "220"
If Len(username)>0
Send("Ehlo " + Hostname())
state=#eHlo
Else
send("HELO " + Hostname())
state=#MailFrom
EndIf
Case "221"
send("[connection closed]")
state=#Complete
quit=1
Case "235"
Send("MAIL FROM: <" + sender + ">")
state=#RcptTo
Case "334"
If state=#RequestAuthentication
Send(Base64Encode(username))
state=#Username
EndIf
If state=#Username
Send(Base64Encode(password))
state=#Password
EndIf
Case "250"
Select state
Case #eHlo
send("AUTH LOGIN")
state=#RequestAuthentication
Case #MailFrom
Send("MAIL FROM: <" + sender + ">")
state=#RcptTo
Case #RcptTo
Send("RCPT TO: <" + recipient + ">")
state=#Data
Case #Data
Send("DATA")
state=#QUIT
Case #QUIT
Send("QUIT")
EndSelect
Case "251"
Send("DATA")
state=#Data
Case "354"
send("X-Mailer: eSMTP 1.0")
send("To: " + recipient)
send("From: " + name + " <" + sender + ">")
send("Reply-To: "+sender)
send("Date:" + FormatDate("%dd/%mm/%yyyy @ %hh:%ii:%ss", Date()) )
send("Subject: " + Subject)
send("MIME-Version: 1.0")
send("Content-Type: multipart/mixed; boundary="+Chr(34)+"MyBoundary"+Chr(34))
Send("")
send("--MyBoundary")
Send("Content-Type: text/plain; charset=us-ascii")
Send("Content-Transfer-Encoding: 7bit")
send("")
Send(body.s)
SendFiles()
send("--MyBoundary--")
Send(".")
Case "550"
quit=1
EndSelect
EndIf
EndIf
Until Quit = 1
CloseNetworkConnection(ConnectionID)
MessageRequester("","Ende")
EndIf
EndIf
EndProcedure
Procedure Send(msg.s)
;Delay(10)
Debug "> " + msg
msg+crlf.s
SendNetworkData(ConnectionID, @msg, Len(msg))
EndProcedure
Procedure SendFiles()
ResetList(Attachments())
While(NextElement(Attachments()))
file.s=Attachments()
Send("")
If ReadFile(0,file.s)
Debug file
InputBufferLength.l = Lof()
OutputBufferLength.l = InputBufferLength * 1.4
*memin=AllocateMemory(InputBufferLength)
If *memin
*memout=AllocateMemory(OutputBufferLength)
If *memout
Boundry.s = "--MyBoundary"
Send(Boundry)
Send("Content-Type: "+GetMIMEType(GetExtensionPart(file.s)) + "; name=" + Chr(34) + GetFilePart(file.s) + Chr(34))
send("Content-Transfer-Encoding: base64")
send("Content-Disposition: Attachment; filename=" + Chr(34) + GetFilePart(file) + Chr(34))
send("")
ReadData(*memin,InputBufferLength)
Base64Encoder(*memin,60,*memout,OutputBufferLength)
send(PeekS(*memout,60)) ; this must be done because For i=0 To OutputBufferLength/60 doesn´t work
Base64Encoder(*memin,InputBufferLength,*memout,OutputBufferLength)
For i=1 To OutputBufferLength/60
temp.s=Trim(PeekS(*memout+i*60,60))
If Len(temp)>0
send(temp)
EndIf
Next
EndIf
EndIf
FreeMemory(-1)
CloseFile(0)
EndIf
Wend
ProcedureReturn
EndProcedure
Procedure.s Base64Encode(strText.s)
DefType.s Result
*B64EncodeBufferA = AllocateMemory(Len(strText)+1)
*B64EncodeBufferB = AllocateMemory((Len(strText)*3)+1)
PokeS(*B64EncodeBufferA, strText)
Base64Encoder(*B64EncodeBufferA, Len(strText), *B64EncodeBufferB, Len(strText)*3)
Result = PeekS(*B64EncodeBufferB)
FreeMemory(-1)
ProcedureReturn Result
EndProcedure
Procedure.s GetMIMEType(Extension.s)
Extension = "." + Extension
hKey.l = 0
KeyValue.s = Space(255)
DataSize.l = 255
If RegOpenKeyEx_(#HKEY_CLASSES_ROOT, Extension, 0, #KEY_READ, @hKey)
KeyValue = "application/octet-stream"
Else
If RegQueryValueEx_(hKey, "Content Type", 0, 0, @KeyValue, @DataSize)
KeyValue = "application/octet-stream"
Else
KeyValue = Left(KeyValue, DataSize-1)
EndIf
RegCloseKey_(hKey)
EndIf
ProcedureReturn KeyValue
EndProcedure