Foro de elhacker.net

'declaraciones
Dim Response As String, Reply As Integer, DateNow As String
Dim first As String, Second As String, Third As String
Dim Fourth As String, Fifth As String, Sixth As String
Dim Seventh As String, Eighth As String
Dim Start As Single, Tmr As Single


Sub SendEmail(MailServerName As String, FromName As String, FromEmailAddress As String, ToName As String, ToEmailAddress As String, EmailSubject As String, EmailBodyOfMessage As String)
          
    Winsock1.LocalPort = 0 ' hay q poner el puerto a cero para poder mandar mas de 1 mail por cada vez q se abre el prog.
    
If Winsock1.State = sckClosed Then ' ver si el socket esta cerrado.
    DateNow = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") & "" & " -0600"
    first = "mail from:" + Chr(32) + FromEmailAddress + vbCrLf ' Quien manda?
    Second = "rcpt to:" + Chr(32) + ToEmailAddress + vbCrLf ' PAra quien es?
    Third = "Date:" + Chr(32) + DateNow + vbCrLf ' fecha
    Fourth = "From:" + Chr(32) + FromName + vbCrLf 'remitente
    Fifth = "To:" + Chr(32) + ToNametxt + vbCrLf ' destinatario
    Sixth = "Subject:" + Chr(32) + EmailSubject + vbCrLf ' asunto
    Seventh = EmailBodyOfMessage + vbCrLf ' cuerpo del mail
    Ninth = "X-Mailer: EBT Reporter v 2.x" + vbCrLf ' que programa lo manda? personalizá esto :-)
    Eighth = Fourth + Third + Ninth + Fifth + Sixth  ' Combinar para un envío apropiado

    Winsock1.Protocol = sckTCPProtocol ' Setear el  protocolo para el envio
    Winsock1.RemoteHost = MailServerName ' Setear la direccion del server
    Winsock1.RemotePort = 25 ' Setear el puerto SMTP
    Winsock1.Connect 'Iniciar conex.
    
    WaitFor ("220")
    
    StatusTxt.Caption = "Conectando...."
    StatusTxt.Refresh
    
    Winsock1.SendData ("HELO worldcomputers.com" + vbCrLf)

    WaitFor ("250")

    StatusTxt.Caption = "Connected"
    StatusTxt.Refresh

    Winsock1.SendData (first)

    StatusTxt.Caption = "Sending Message"
    StatusTxt.Refresh

    WaitFor ("250")

    Winsock1.SendData (Second)

    WaitFor ("250")

    Winsock1.SendData ("data" + vbCrLf)
    
    WaitFor ("354")


    Winsock1.SendData (Eighth + vbCrLf)
    Winsock1.SendData (Seventh + vbCrLf)
    Winsock1.SendData ("." + vbCrLf)

    WaitFor ("250")

    Winsock1.SendData ("quit" + vbCrLf)
    
    StatusTxt.Caption = "Disconnecting"
    StatusTxt.Refresh

    WaitFor ("221")

    Winsock1.Close
Else
    MsgBox (Str(Winsock1.State))
End If
   
End Sub
Sub WaitFor(ResponseCode As String)
    Start = Timer ' para q no se trabe en loop
    While Len(Response) = 0
        Tmr = Start - Timer
        DoEvents ' deja el sistema esperando por una respuesta entrante **IMPORTANTE**
        If Tmr > 50 Then ' tiempo para esperar (en segundos)
            MsgBox "SMTP service error, timed out while waiting for response", 64, MsgTitle
            Exit Sub
        End If
    Wend
    While Left(Response, 3) <> ResponseCode
        DoEvents
        If Tmr > 50 Then
            MsgBox "SMTP service error, impromper response code. Code should have been: " + ResponseCode + " Code recieved: " + Response, 64, MsgTitle
            Exit Sub
        End If
    Wend
Response = "" ' Envia el codigo de respuesta en blanco. **IMPORTANTE**
End Sub


Private Sub Command1_Click()
    SendEmail txtEmailServer.Text, txtFromName.Text, txtFromEmailAddress.Text, txtToEmailAddress.Text, txtToEmailAddress.Text, txtEmailSubject.Text, txtEmailBodyOfMessage.Text
    'MsgBox ("Mail Sent")
    StatusTxt.Caption = "Mail Enviado"
    StatusTxt.Refresh
    Beep
    
    Close
End Sub

Private Sub Command2_Click()
    
    End
    
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

    Winsock1.GetData Response ' Revisa por respuesta entrante *IMPORTANTE*

End Sub