Sorry, hab das ganze mal komplett verbessert.
Übersichtlicher, sicherer und Unicode-fähig.
Code: Alles auswählen
;Email (PB 4.41, PB 4.50)
;von Der-T, Kiffi, DrFalo, NicTheQuick, ...
EnableExplicit
InitNetwork()
#MAIL_BUFFER = 1024
Procedure.s Mail_ReceiveString(*hConnection.Integer)
If (Not *hConnection\i)
ProcedureReturn ""
EndIf
Protected DataResult.s = ""
Protected *mem = AllocateMemory(#MAIL_BUFFER), received.i
Repeat
received = ReceiveNetworkData(*hConnection\i, *mem, #MAIL_BUFFER)
If (received = -1)
Debug "ReceiveNetworkData() returns error -1. Received Data: '" + DataResult + "'"
*hConnection\i = 0
Break
EndIf
DataResult + PeekS(*mem, received, #PB_Ascii)
Until received < #MAIL_BUFFER
Debug "Debug 'DataResult':" + #CRLF$ + DataResult
FreeMemory(*mem)
ProcedureReturn DataResult
EndProcedure
Procedure Mail_SendString(*hConnection.Integer, StringToSend.s)
If (Not *hConnection\i)
ProcedureReturn
EndIf
StringToSend + #CRLF$
Protected sent.i = 0, length = Len(StringToSend), res.i
Protected *mem = AllocateMemory(length + 1)
PokeS(*mem, StringToSend, length, #PB_Ascii)
Repeat
res = SendNetworkData(*hConnection\i, *mem + sent, length - sent)
If (res = -1)
Debug "SendNetworkData() returns error -1. Sent Data: '" + PeekS(*mem, sent, #PB_Ascii) + "'"
*hConnection = 0
Break
EndIf
sent + res
Until sent = length
FreeMemory(*mem)
EndProcedure
Procedure Mail_CheckAnswer(*hConnection.Integer, expected.s)
If (Not *hConnection\i)
ProcedureReturn #False
EndIf
Protected answer.s = Mail_ReceiveString(*hConnection)
If (Left(answer, Len(expected)) = expected)
ProcedureReturn #True
EndIf
Debug "Server says '" + answer + "', but expected was '" + expected + "'"
*hConnection\i = 0
ProcedureReturn #False
EndProcedure
Procedure.s Mail_Base64Encoder(string.s)
Protected *mem = AllocateMemory(Len(string) + 1)
Protected result.s = Space(Len(string) * 3 / 2)
PokeS(*mem, string, Len(string), #PB_Ascii)
Base64Encoder(*mem, Len(string), @result, Len(result))
FreeMemory(*mem)
ProcedureReturn result
EndProcedure
Procedure Mail_Send(Server.s, User.s, Pass.s, MailFrom.s, MailTo.s, Subject.s, Content.s)
Protected ConnectionID.i = OpenNetworkConnection(Server, 25), state.i
Protected TmpString.s
If ConnectionID
state = ConnectionID
Mail_CheckAnswer(@state, "220")
Mail_SendString(@state, "EHLO localhost")
Mail_CheckAnswer(@state, "250")
Mail_SendString(@state, "AUTH LOGIN")
Mail_CheckAnswer(@state, "334")
Mail_SendString(@state, Mail_Base64Encoder(User))
Mail_CheckAnswer(@state, "334")
Mail_SendString(@state, Mail_Base64Encoder(Pass))
Mail_CheckAnswer(@state, "235")
Mail_SendString(@state, "MAIL FROM: <" + MailFrom + ">")
Mail_CheckAnswer(@state, "250")
Mail_SendString(@state, "RCPT TO: <" + MailTo + ">")
Mail_CheckAnswer(@state, "250")
Mail_SendString(@state, "DATA")
Mail_CheckAnswer(@state, "354")
Mail_SendString(@state, "From: <" + MailFrom + ">")
Mail_SendString(@state, "To: <" + MailTo + ">")
Mail_SendString(@state, "Subject: " + Subject + #CRLF$)
Mail_SendString(@state, Content)
Mail_SendString(@state, ".")
Mail_CheckAnswer(@state, "250")
Mail_SendString(@state, "QUIT")
CloseNetworkConnection(ConnectionID)
EndIf
ProcedureReturn state
EndProcedure
Define result.i
result = Mail_Send("Server" ,"User" ,"Pass" ,"MailFrom", "MailTo" ,"Subject ,"Content")
Debug "Mail_Send returns: " + Str(result)
Leider mag unser Uni-Mail-Server keine Authentifizierung. Aber wen's interessiert. Hier das Log:
Debug 'DataResult':
220 triton.rz.uni-saarland.de ESMTP Sendmail; Thu, 15 Jul 2010 10:34:13 +0200
Debug 'DataResult':
250-triton.rz.uni-saarland.de Hello wpa-uds054.funklan.uni-saarland.de [134.96.118.63], pleased to meet you
250-ENHANCEDSTATUSCODES
250-PIPELINING
250-8BITMIME
250-SIZE 21485760
250-DSN
250-ETRN
250-STARTTLS
250-DELIVERBY
250 HELP
Debug 'DataResult':
503 5.3.3 AUTH not available
Server says '503 5.3.3 AUTH not available
', but expected was '334'
Mail_Send returns: 0