[es] - To mail or not to mail... Mail program u VB6

zWest
Aleksandar
Banja Luka

Član broj: 17852
Poruke: 21
*.dialup.blic.net.

Sajt: www.blhost.net

Profil

Re: To mail or not to mail... Mail program u VB6

^{18.12.2006. u 20:15}

program lako napraviti bez atachmenta uz Winsock kontrolu mada mozes i sa atachmentom samo je malo komplikovanije

recimo ovo je moj programcic za to (nikad ga nisam finalizovao nazalost ali radi)

Mail program

a evo i jedan code :

Code:
Dim Response 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)
Dim 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
With Winsock1
    If .State = sckClosed Then ' Check to see if socket is closed
        DateNow = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") & "" & " -0600"
        first = "mail from: " & FromEmailAddress & vbCrLf ' Get who's sending E-Mail address
        Second = "rcpt to: " & ToEmailAddress & vbCrLf ' Get who mail is going to
        Third = "Date: " & DateNow & vbCrLf ' Date when being sent
        Fourth = "From: """ & FromName & """ <" & FromEmailAddress & ">" + vbCrLf ' Who's Sending
        Fifth = "To: " & ToNametxt & vbCrLf ' Who it going to
        Sixth = "Subject: " & EmailSubject & vbCrLf ' Subject of E-Mail
        Seventh = EmailBodyOfMessage & vbCrLf ' E-mail message body
        Ninth = "X-Mailer: STMP Sender" & vbCrLf ' What program sent the e-mail, customize this
        .LocalPort = 0 ' Must set local port to 0 (Zero) or you can only send 1 e-mail per program start
        .Protocol = sckTCPProtocol ' Set protocol for sending
        .RemoteHost = MailServerName ' Set the server address
        .RemotePort = 25 ' Set the SMTP Port
        .Connect ' Start connection
        WaitFor ("220")
        StatusTxt.Caption = "Connecting...."
        .SendData ("HELO EnterComputerNameHere" & vbCrLf)
        WaitFor ("250")
        StatusTxt.Caption = "Connected"

        .SendData (first)
        StatusTxt.Caption = "Sending Message"

        WaitFor ("250")
        .SendData (Second)
        WaitFor ("250")
        .SendData ("data" & vbCrLf)
        WaitFor ("354")
        .SendData (Fourth & Third & Ninth & Fifth & Sixth & vbCrLf)
        .SendData (Seventh & vbCrLf)
        .SendData ("." & vbCrLf)
        WaitFor ("250")
        .SendData ("quit" & vbCrLf)
        StatusTxt.Caption = "Disconnecting"

        WaitFor ("221")
        .Close
    Else
        MsgBox (Str(.State))
    End If
End With
End Sub

Sub WaitFor(ResponseCode As String)
    Start = Timer ' Time event so won't get stuck in loop
    While Len(Response) = 0
        Tmr = Start - Timer
        DoEvents ' Let System keep checking for incoming response **IMPORTANT**
        If Tmr > 50 Then ' Time in seconds to wait
            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 = "" ' Sent response code to blank **IMPORTANT**
End Sub

Private Sub CmdSendMail_Click()
    SendEmail txtEmailServer.Text, txtFromName.Text, txtFromEmailAddress.Text, txtToEmailAddress.Text, txtToEmailAddress.Text, txtEmailSubject.Text, txtMessage.Text
    StatusTxt.Caption = "Mail Sent"
    Beep
    Close
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Winsock1.GetData Response ' Check for incoming response *IMPORTANT*
End Sub

code nije moj ali je dostupan na netu besplatno

http://www.blforum.com
http://www.zwest.info

^{18.12.2006. u 20:15}