www.pudn.com > 20063518740652.zip > MAILER32.FRM
VERSION 4.00
Begin VB.Form Mailer
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Mailer"
ClientHeight = 6600
ClientLeft = 3075
ClientTop = 1800
ClientWidth = 6120
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 7290
Left = 3015
LinkTopic = "Form1"
ScaleHeight = 6600
ScaleWidth = 6120
Top = 1170
Width = 6240
Begin VB.TextBox eAttach
Appearance = 0 'Flat
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 1560
TabIndex = 11
Top = 1680
Width = 4215
End
Begin VB.TextBox eResult
Appearance = 0 'Flat
Height = 615
Left = 240
MultiLine = -1 'True
TabIndex = 10
Top = 5880
Visible = 0 'False
Width = 5535
End
Begin VB.TextBox eMessage
Appearance = 0 'Flat
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3255
Left = 240
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 8
Top = 2520
Width = 5535
End
Begin VB.TextBox eSubject
Appearance = 0 'Flat
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 1560
TabIndex = 6
Top = 1320
Width = 4215
End
Begin VB.TextBox eTo
Appearance = 0 'Flat
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 1560
TabIndex = 4
Top = 960
Width = 4215
End
Begin VB.TextBox eFrom
Appearance = 0 'Flat
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 1560
TabIndex = 2
Top = 600
Width = 4215
End
Begin VB.TextBox eServer
Appearance = 0 'Flat
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 1560
TabIndex = 0
Top = 240
Width = 3495
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Attach"
ForeColor = &H80000008&
Height = 255
Left = 600
TabIndex = 12
Top = 1680
Width = 735
End
Begin VB.Label lMessage
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Message"
ForeColor = &H80000008&
Height = 255
Left = 2520
TabIndex = 9
Top = 2160
Width = 975
End
Begin VB.Label lSubject
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Subject"
ForeColor = &H80000008&
Height = 255
Left = 360
TabIndex = 7
Top = 1320
Width = 975
End
Begin VB.Label lTo
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Email To"
ForeColor = &H80000008&
Height = 255
Left = 360
TabIndex = 5
Top = 960
Width = 975
End
Begin VB.Label lFrom
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Email From"
ForeColor = &H80000008&
Height = 255
Left = 240
TabIndex = 3
Top = 600
Width = 1095
End
Begin VB.Label lServer
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "SMTP Server"
ForeColor = &H80000008&
Height = 255
Left = 120
TabIndex = 1
Top = 240
Width = 1215
End
Begin VB.Menu mSend
Caption = "SendEmail"
End
Begin VB.Menu mExit
Caption = "Exit"
End
End
Attribute VB_Name = "Mailer"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Private Sub bOK_Click()
eResult.Visible = False
eResult.Text = ""
End Sub
Private Sub Form_Load()
Dim Version As Integer
Dim S1, S2, S3 As String
eResult.Visible = True
Version = seeStatistics(SEE_GET_VERSION)
S1 = "SMTP/POP3 Email Engine Version "
S2 = Hex$(Version)
S3 = Mid$(S2, 1, 1) + "." + Mid$(S2, 2, 1) + "." + Mid$(S2, 3, 1)
eResult.Text = S1 + S3 + ". Ready to connect."
End Sub
Private Sub mExit_Click()
Dim Code As Long
Code = seeClose()
End
End Sub
Private Sub mSend_Click()
Dim Code As Long
Dim Length As Long
Dim BytesSent As Long
Dim NullString As String
Dim Temp As String * 256
Dim TheFile As String
Dim Msg As String
Dim NL As String
On Error GoTo MailerErrorHandler
NullString = Chr$(0)
NL = Chr$(13) + Chr$(10)
eResult.Text = ""
'check that SMTP server name has been specifed
If Len(eServer.Text) = 0 Then
eResult.Text = Time$ & " Your SMTP server is not specified."
Exit Sub
End If
'check "From" email address
If Len(eFrom.Text) = 0 Then
eResult.Text = Time$ & " Missing 'Email From' address."
Exit Sub
Else
Code = seeVerifyFormat(eFrom.Text)
If Code < 0 Then
'error in format
Call ShowError(Mailer, Code, "From address: ")
Exit Sub
End If
End If
'check "To" email address
If Len(eTo.Text) = 0 Then
eResult.Text = Time$ & " Missing 'Email To' address."
Exit Sub
Else
Code = seeVerifyFormat(eTo.Text)
If Code < 0 Then
'error in format
Call ShowError(Mailer, Code, "To address: ")
Exit Sub
End If
End If
' verify existance of attachment file
If Len(eAttach.Text) > 0 Then
TheFile = eAttach.Text
Open TheFile For Input As 1
Close 1
End If
' verify existance of message file
Length = Len(eMessage.Text)
If Length > 0 Then
If Left$(eMessage.Text, 1) = "@" Then
' message starts with "@", so is a filename
TheFile = Right$(eMessage.Text, Length - 1)
Open TheFile For Input As 1
Close 1
End If
End If
' send email message
mSend.Enabled = False
eResult.Text = Time$ & "Sending email."
' set up log file
Code = seeStringParam(SEE_LOG_FILE, "mailer.log")
'connect to server
eResult.Text = Time$ & " Connecting to SMTP server " & eServer.Text
Code = seeSmtpConnect(eServer.Text, eFrom.Text, NullString)
If Code < 0 Then
'error attempting to connect
Call ShowError(Mailer, Code, "seeSmtpConnect: ")
mSend.Enabled = True
Code = seeClose()
Exit Sub
End If
' get server IP address
Code = seeDebug(SEE_GET_SERVER_IP, Temp, 40)
eResult.Text = Time$ & " Connected to IP " & Left$(Temp, Code)
' disable AUTO CALL [see Users Manual SEE4VB_U.TXT]
Code = seeIntegerParam(SEE_AUTO_CALL_DRIVER, 0)
' setup to send the email
Code = seeSendEmail(eTo.Text, NullString, NullString, eSubject.Text, eMessage.Text, eAttach.Text)
If Code < 0 Then
'error attempting to send email
Call ShowError(Mailer, Code, "seeSendEmail: ")
mSend.Enabled = True
Code = seeClose()
Exit Sub
End If
' run the driver (which sends the email)
Do
' execute next state
Code = seeDriver()
If Code = 0 Then
' driver is done
Exit Do
End If
If Code < 0 Then
'driver returned error
Call ShowError(Mailer, Code, "seeDriver: ")
Exit Do
End If
' driver not yet done, so report progress.
BytesSent = seeStatistics(SEE_GET_TOTAL_BYTES_SENT)
eResult.Text = Time$ & " " & Str(BytesSent) + " bytes sent."
Loop
' enable AUTO CALL
Code = seeIntegerParam(SEE_AUTO_CALL_DRIVER, 1&)
eResult.Text = Time$ & " Email has been sent (" & Str$(BytesSent) & " bytes)"
mSend.Enabled = True
Code = seeClose()
Exit Sub
MailerErrorHandler:
Select Case Err
Case 53: Msg = "VB Error 53: File " & TheFile & " doesn't exist."
Case 76: Msg = "VB Error: Path " & TheFile & " doesn't exist."
Case Else: Msg = "VB Error " & Err & " occurred."
End Select
eResult.Text = eResult.Text + Msg + NL
MsgBox Msg
Resume Next
End Sub