Ich habe heute eine große anfrage an jemanden von euch...
Ich habe folgenden Code im Englischen Forum gefunden, und versuche ihn mit PB4 kompatibel zu machen... funktioniert leider nicht
Kann ihn einer vielleicht umschreiben, so dass er unter PB4 funktioniert?
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","mail@mail.de","mail@mail.de","username","passwort","smtp.server.de","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(9999)
ct=ReceiveNetworkData(ConnectionID ,@ReceivedData,9999)
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 Liebe Grüße
CHris
ist nur gewöhnungsbedurftig