Sie sind aktuell nicht angemeldet.

Funktionen: Einloggen  |  Neu registrieren  |  Suchen

Re: Div. Mailproggy Source's gesucht
Autor: InKUbuS GhUL
Datum: 08.08.01 22:16
Hiermit kann man einen Mailbomber programmieren, ein Ghostmailproggy oder ein einfach Mailproggy! Eben sehr flexibel...VB eben ;-D MfG InKUbuS GhUL Option Explicit Dim Mailing As Boolean Dim Result$, Sec%, TimeOut% Const Server$ = "Ihre.MailServer.Domäne" Const Absender$ = "Gudrun Gichtelgrund" Const Email$ = "gundi@gichtelgrund.de" Const Domain$ = "goetz-reinecke.de" Private Sub Form_Load() TimeOut = 20 Text1.Text = Server Text2.Text = Absender Text3.Text = Email Text8.Text = TimeOut ProgressBar1.Min = 0 ProgressBar1.Value = 0 ProgressBar1.Max = TimeOut * 5 Text1.SelStart = 0 Text1.SelLength = Len(Text1.Text) Label7.Caption = "" End Sub Private Sub Command1_Click() If Mailing = False Then If SendMail(Text1.Text, Text2.Text, Text3.Text, Text4.Text, _ Text5.Text, Text6.Text, Text7.Text) Then MsgBox ("Email erfolgreich verschickt") Else MsgBox ("Fehler beim Versenden aufgetreten") End If Else MsgBox ("Letzte EMail wird noch gesendet !") End If End Sub Private Sub Text8_Change() TimeOut = Val(Text8.Text) End Sub Private Sub Timer1_Timer() Sec = Sec + 1 ProgressBar1.Value = Sec - 1 DoEvents End Sub Private Function Response(RCode$) As Boolean Sec = 0 Timer1.Interval = 200 Timer1.Enabled = True Response = True Do While Left$(Result, 3) <> RCode DoEvents If Sec > TimeOut * 5 Then If Len(Result) Then ShowStatus ("SMTP Error! Falscher Rückgabewert") Else ShowStatus ("SMTP Error! Time out") End If Response = False Exit Do End If Loop Result = "" ProgressBar1.Value = 0 Timer1.Enabled = False End Function Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) Winsock1.GetData Result End Sub Private Sub ShowStatus(ByVal Text$) Label7.Caption = Text Label7.Refresh End Sub Private Function SendMail(SMTP$, FromName$, FromMail$, ToName$, _ ToMail$, Subj$, Body$) As Boolean Dim MAIL$, outTO$, outFR$ If Mailing = True Then Exit Function Mailing = True MousePointer = vbHourglass If Winsock1.State = sckClosed Then On Error GoTo ERRORMail Winsock1.LocalPort = 0 outFR = "mail from: " & FromMail & vbCrLf outTO = "rcpt to: " & ToMail & vbCrLf & "data" & vbCrLf MAIL = MAIL & "From: " & FromName & " <" & FromMail & ">" MAIL = MAIL & vbCrLf & "Date: " & Format(Date, "Ddd") MAIL = MAIL & ", " & Format(Date, "dd Mmm YYYY") & " " MAIL = MAIL & Format(Time, "hh:mm:ss") & " +0100" & vbCrLf MAIL = MAIL & "X-Mailer: Visual Basic Mailing Tester" MAIL = MAIL & vbCrLf & "To: " & ToName & " <" & ToMail & ">" MAIL = MAIL & vbCrLf & "Subject: " & Subj & vbCrLf MAIL = MAIL & vbCrLf & Body & vbCrLf & vbCrLf & "." & vbCrLf '### Verbindung aufbauen ShowStatus ("Verbinde...") Winsock1.Protocol = sckTCPProtocol Winsock1.RemoteHost = SMTP Winsock1.RemotePort = 25 Winsock1.Connect If Not Response("220") Then GoTo ERRORMail '### Verbunden ShowStatus ("Verbunden") Winsock1.SendData ("HELO " & Domain & vbCrLf) If Not Response("250") Then GoTo ERRORMail '### Mail Senden ShowStatus ("Nachricht Senden") Winsock1.SendData (outFR) If Not Response("250") Then GoTo ERRORMail Winsock1.SendData (outTO) If Not Response("354") Then GoTo ERRORMail Winsock1.SendData (MAIL) If Not Response("250") Then GoTo ERRORMail '### Trennen ShowStatus ("Trennen") Winsock1.SendData ("quit" & vbCrLf) If Not Response("221") Then GoTo ERRORMail ShowStatus ("Nachricht verschickt !") SendMail = True End If ERRORMail: Mailing = False Winsock1.Close MousePointer = vbDefault Exit Function End Function

Div. Mailproggy Source's gesucht	67	OttO	07.08.01 16:30
Re: Div. Mailproggy Source's gesucht	72	InKUbuS GhUL	08.08.01 22:16

Sie sind nicht angemeldet! Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden. Einloggen  |  Neu registrieren

Funktionen:  Zum Thema  |  Gesamtübersicht

Suchen