Code: Alles auswählen
;Email (PB 4.41, PB 4.50)
;von Der-T, Kiffi, DrFalo, HeX0R, ...
InitNetwork()
EnableExplicit
Global SMTP_LAST_ERROR
Structure _SMTP_QUESTION_ANSWER_
Question.s
Answer.s
EndStructure
Enumeration
#SMTP_NO_ERROR
#SMTP_ERROR_SERVER_NOT_AVAILABLE
#SMTP_ERROR_TIMED_OUT
#SMTP_ERROR_NO_MEMORY_AVAILABLE
#SMTP_ERROR_UNKNOWN_DISCONNECT
#SMTP_ERROR_PHASE_0
#SMTP_ERROR_PHASE_1
#SMTP_ERROR_PHASE_2
#SMTP_ERROR_PHASE_3
#SMTP_ERROR_PHASE_4
#SMTP_ERROR_PHASE_5
#SMTP_ERROR_PHASE_6
#SMTP_ERROR_PHASE_7
#SMTP_ERROR_PHASE_8
EndEnumeration
Procedure SendAsciiString(ConnectionID, StringToSend.s, TimeOUT = 1000)
Protected *Buffer, Result, Pos, R, Size, Error, TimedOUT
StringToSend + #CRLF$
*Buffer = AllocateMemory(StringByteLength(StringToSend, #PB_Ascii) + 1)
If *Buffer
PokeS(*Buffer, StringToSend, -1, #PB_Ascii)
Pos = 0
Size = MemorySize(*Buffer) - 1
TimedOUT = ElapsedMilliseconds() + TimeOUT
Repeat
R = SendNetworkData(ConnectionID, *Buffer + Pos, Size - Pos)
If R = -1
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
Error = WSAGetLastError_()
If Error = #WSAEWOULDBLOCK
Delay(10)
Else
Break
EndIf
CompilerElse
Break
CompilerEndIf
Else
Pos + R
EndIf
If TimedOUT < ElapsedMilliseconds()
Break
EndIf
Until Pos = Size
FreeMemory(*Buffer)
If Pos = Size
Result = #True
EndIf
EndIf
ProcedureReturn Result
EndProcedure
Procedure.s MyBase64(String.s)
Protected Result.s, *Buffer, *TmpString, L
*TmpString = AllocateMemory(2048)
If *TmpString
*Buffer = AllocateMemory(StringByteLength(String, #PB_Ascii) + 1)
If *Buffer
PokeS(*Buffer, String, -1, #PB_Ascii)
L = Base64Encoder(*Buffer, MemorySize(*Buffer) - 1, *TmpString, 2048)
FreeMemory(*Buffer)
Result = PeekS(*TmpString, L, #PB_Ascii)
EndIf
FreeMemory(*TmpString)
EndIf
ProcedureReturn Result
EndProcedure
Procedure SendMyMail(Server.s, User.s, Pass.s, MailFrom.s, MailTo.s, Subject.s, Body.s, Port = 25, TimeOUT = 1000)
Protected Pos, i, L, R, Result, ConnectionID, OptionalParameters.s
Protected Phase, TimedOUT, *Buffer, a$, b$, c$
SMTP_LAST_ERROR = #SMTP_NO_ERROR
*Buffer = AllocateMemory($10000)
If *Buffer = #Null
SMTP_LAST_ERROR = #SMTP_ERROR_NO_MEMORY_AVAILABLE
ProcedureReturn #False
EndIf
ConnectionID = OpenNetworkConnection(Server, Port)
If ConnectionID = #Null
SMTP_LAST_ERROR = #SMTP_ERROR_SERVER_NOT_AVAILABLE
FreeMemory(*Buffer)
ProcedureReturn #False
EndIf
Dim Answers._SMTP_QUESTION_ANSWER_(10)
Answers(0)\Answer = "220"
Answers(0)\Question = "EHLO localhost"
Answers(1)\Answer = "250"
Answers(1)\Question = "AUTH LOGIN"
Answers(2)\Answer = "334"
Answers(2)\Question = MyBase64(User)
Answers(3)\Answer = "334"
Answers(3)\Question = MyBase64(Pass)
Answers(4)\Answer = "235"
Answers(4)\Question = "MAIL FROM: <" + MailFrom + ">"
Answers(5)\Answer = "250"
Answers(5)\Question = "RCPT TO: <" + MailTo + ">"
Answers(6)\Answer = "250"
Answers(6)\Question = "DATA"
Answers(7)\Answer = "354"
Answers(7)\Question = "From: <" + MailFrom + ">" + #CRLF$
Answers(7)\Question + "To: <" + MailTo + ">" + #CRLF$
Answers(7)\Question + "Subject: " + Subject + #CRLF$ + #CRLF$
Answers(7)\Question + Body + #CRLF$
Answers(7)\Question + "."
Answers(8)\Answer = "250"
Answers(8)\Question = "QUIT"
Phase = 0
TimedOUT = ElapsedMilliseconds() + TimeOUT
Repeat
If NetworkClientEvent(ConnectionID) = #PB_NetworkEvent_Data
TimedOUT = ElapsedMilliseconds() + TimeOUT
Pos = 0
Repeat
L = ReceiveNetworkData(ConnectionID, *Buffer + Pos, $10000 - Pos)
If L = -1
SMTP_LAST_ERROR = #SMTP_ERROR_UNKNOWN_DISCONNECT
Break 2
Else
Pos + L
EndIf
If TimedOUT < ElapsedMilliseconds()
SMTP_LAST_ERROR = #SMTP_ERROR_TIMED_OUT
Break 2
EndIf
Until Pos > 3 And PeekW(*Buffer + Pos - 2) = $0A0D
TimedOUT = ElapsedMilliseconds() + TimeOUT
b$ = PeekS(*Buffer, L, #PB_Ascii)
a$ = Left(b$, 3)
R = 0
Debug b$
If a$ = Answers(Phase)\Answer
R = SendAsciiString(ConnectionID, Answers(Phase)\Question)
EndIf
If R
If Phase = 1
OptionalParameters = ""
For i = 1 To CountString(b$, #CRLF$) - 1
c$ = StringField(b$, i + 1, #LF$)
c$ = RemoveString(c$, #CR$)
OptionalParameters + Mid(c$, 5) + #LF$
Next i
Debug "Accepted Parameters:" + OptionalParameters
EndIf
Phase + 1
If Phase = 9
Result = #True
Phase = 100
EndIf
Else
SMTP_LAST_ERROR = #SMTP_ERROR_PHASE_0 + Phase
Phase = 100
EndIf
Else
Delay(5)
EndIf
If TimedOUT < ElapsedMilliseconds()
SMTP_LAST_ERROR = #SMTP_ERROR_TIMED_OUT
Break
EndIf
Until Phase = 100
CloseNetworkConnection(ConnectionID)
FreeMemory(*Buffer)
ProcedureReturn Result
EndProcedure
SendMyMail("mailserver.dein", "user", "passwort", "mailaddy_von", "mailaddy_an", "Betreff", "Inhalt")