unknown
مدير بخش ويژوال بيسيك
Joined: 05 Dec 2004
Posts: 439
Location: Tehran
|
 Posted: Sun Feb 05, 2006 5:19 pm Post subject: |
 |
|
اولا خوش آمدی
دوما دوستان دیگه حوصله ندارم. می خوام برای کنکور بخونم. اگه دیگه زیاد من رو ندیدید نگید مرده ها!
این کد هایی رو که برات می نویسم توی notepad با پسوند .frm ذخیره کن.
نمی دونم گفتم شاید به دردت بخوره
|
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmSTMPMail
BorderStyle = 3 'Fixed Dialog
Caption = "Postman"
ClientHeight = 4485
ClientLeft = 3300
ClientTop = 2655
ClientWidth = 4920
Icon = "SendMail.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4485
ScaleWidth = 4920
ShowInTaskbar = 0 'False
Begin VB.TextBox txtFromName
Height = 285
Left = 1080
TabIndex = 2
Text = "txtFromName"
Top = 840
Width = 3735
End
Begin VB.TextBox txtEmailServer
Height = 285
Left = 1080
TabIndex = 4
Text = "txtEmailServer"
Top = 1560
Width = 3735
End
Begin VB.TextBox txtMessage
Height = 1815
Left = 120
MultiLine = -1 'True
TabIndex = 5
Text = "SendMail.frx":000C
Top = 1920
Width = 4695
End
Begin VB.TextBox txtEmailSubject
Height = 285
Left = 1080
TabIndex = 3
Text = "txtEmailSubject"
Top = 1200
Width = 3735
End
Begin VB.TextBox txtToEmailAddress
Height = 285
Left = 1080
TabIndex = 0
Text = "txtToEmailAddress"
Top = 120
Width = 3735
End
Begin VB.TextBox txtFromEmailAddress
Height = 285
Left = 1080
TabIndex = 1
Text = "txtFromEmailAddress"
Top = 480
Width = 3735
End
Begin MSWinsockLib.Winsock Winsock1
Left = 0
Top = 0
_ExtentX = 741
_ExtentY = 741
_Version = 327681
End
Begin VB.CommandButton CmdSendMail
Caption = "Send"
Height = 615
Left = 120
Picture = "SendMail.frx":0019
Style = 1 'Graphical
TabIndex = 7
Top = 3840
Width = 1695
End
Begin VB.Label StatusTxt
Caption = "StatusTxt"
Height = 615
Left = 1920
TabIndex = 12
Top = 3840
Width = 4095
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "From Name:"
Height = 195
Left = 120
TabIndex = 11
Top = 840
Width = 855
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "Email Server"
Height = 195
Left = 120
TabIndex = 10
Top = 1560
Width = 885
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "Subject"
Height = 195
Left = 360
TabIndex = 9
Top = 1200
Width = 540
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "To:"
Height = 195
Left = 600
TabIndex = 8
Top = 120
Width = 240
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "From:"
Height = 195
Left = 480
TabIndex = 6
Top = 480
Width = 390
End
End
Attribute VB_Name = "frmSTMPMail"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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 Form_Load()
End Sub
Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
End Sub
Private Sub Label4_Click()
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Winsock1.GetData Response ' Check for incoming response *IMPORTANT*
End Sub |
|
|
Profile 
Log in to check your private messages | 
FAQ 
Search 
Memberlist 
Usergroups 
Log in
Register
