PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

SMTP-Code in PB4 umwandeln

https://www.purebasic.fr/german/viewtopic.php?t=7565

Seite 1 von 1

SMTP-Code in PB4 umwandeln

Verfasst: 25.03.2006 21:26
von winduff
Hallo,

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
Danke im Vorraus, ich weis ist viel arbeit :-(

Liebe Grüße
CHris

Verfasst: 25.03.2006 21:44
von spacewalker
Hi!
bei mir funktionierts jetzt :

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 

Global 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","absender@mail.de","empfaenger@mail.de","user","pass","smtp.mail.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(0) 
   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(0,*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) 
    Define.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
P.S. War nicht wirklich viel arbeit, nur paar sachen geaendert - Linked List ist jetzt nicht mech selbstverstaendlich global, DefType heisst Define und dateioperationen brauchen zusaetzlich die datei id. :-) ist nur gewöhnungsbedurftig

Verfasst: 25.03.2006 22:22
von winduff
Wow!

Genial :-)

Vielen tausend dank :-)

Verfasst: 31.03.2006 13:56
von Dostej
Danke auch - das war genau das, was ich gesucht habe.
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de