www.pudn.com > 20063518740652.zip > BCAST32.FRM
VERSION 4.00
Begin VB.Form Bcast
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Bcast"
ClientHeight = 6630
ClientLeft = 1545
ClientTop = 855
ClientWidth = 6090
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 = 7320
Left = 1485
LinkTopic = "Form1"
ScaleHeight = 6630
ScaleWidth = 6090
Top = 225
Width = 6210
Begin VB.TextBox eEmail
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
Text = "test.mai"
Top = 1320
Width = 2295
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 = 3615
Left = 240
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 8
Top = 2160
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 = 1680
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
Text = "email.lst"
Top = 960
Width = 2295
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 = 3495
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 lEmail
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Email Msg"
ForeColor = &H80000008&
Height = 255
Left = 360
TabIndex = 9
Top = 1320
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 = 1680
Width = 975
End
Begin VB.Label lTo
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "Email List "
ForeColor = &H80000008&
Height = 255
Left = 120
TabIndex = 5
Top = 960
Width = 1215
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 mTest
Caption = "Test List"
End
Begin VB.Menu mConnect
Caption = "Connect"
End
Begin VB.Menu mSend
Caption = "SendEmail"
Enabled = 0 'False
End
Begin VB.Menu mExit
Caption = "Exit"
End
End
Attribute VB_Name = "Bcast"
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."
S1 = "This program emails the file specified by 'Email Msg' to every email "
S2 = "address in the file specified by 'Email List'."
eMessage.Text = S1 & S2
End Sub
Private Sub mExit_Click()
Dim Code As Integer
Code = seeClose()
End
End Sub
Private Sub mInstruct_Click()
Dim NL As String * 2
Dim S1 As String
Dim S2 As String
'''Dim S3 As String
NL = Chr$(13) + Chr$(10)
eMessage.Text = ""
S1 = "This program emails the file specified by 'Email Msg' to every email"
S2 = "address in the file specified by 'Email List'."
eMessage.Text = S1 & NL & S2
End Sub
Private Sub mSend_Click()
Dim Code As Long
Dim TheFile As String
Dim NullString As String
Dim NL As String
Dim Msg As String
Dim X As String
On Error GoTo SendErrorHandler
NullString = Chr$(0)
NL = Chr$(13) + Chr$(10)
'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(Bcast, Code, "Email from address: ")
Exit Sub
End If
End If
' set up log file
Code = seeStringParam(SEE_LOG_FILE, "Bcast.log")
'connect to server
mSend.Enabled = False
eResult.Text = Time$ & " Connecting to SMTP server."
Code = seeSmtpConnect(eServer.Text, eFrom.Text, NullString)
If Code < 0 Then
'error attempting to connect
Call ShowError(Bcast, Code, "seeSmtpConnect: ")
Code = seeClose()
Exit Sub
End If
eResult.Text = Time$ & " Connected."
' disable AUTO CALL [see Users Manual SEE4VB_U.TXT]
Code = seeIntegerParam(SEE_AUTO_CALL_DRIVER, 0&)
' send email message
mSend.Enabled = False
eResult.Text = Time$ & " Sending email."
TheFile = eTo.Text
eMessage.Text = eMessage.Text + "Opening " + TheFile + NL
Open eTo.Text For Input As 1
Do Until EOF(1)
Line Input #1, X
If Len(X) > 0 Then
If (InStr(X, "<") = 0) And (InStr(X, ">") = 0) Then
' sorround with brackets
X = "<" + X + ">"
End If
eMessage.Text = eMessage.Text + X
' prefix filename with @
If Left(eEmail.Text, 1) <> "@" Then
eEmail.Text = "@" + eEmail.Text
End If
' setup to send email
Code = seeSendEmail(X, NullString, NullString, eSubject, eEmail.Text, NullString)
If Code < 0 Then
'error attempting to send email
Call ShowError(Bcast, Code, "seeSendEmail: ")
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(Bcast, Code, "seeDriver: ")
Exit Sub
End If
Loop
eMessage.Text = eMessage.Text & " OK" & NL
End If
Loop
' enable AUTO CALL
Code = seeIntegerParam(SEE_AUTO_CALL_DRIVER, 1&)
Close 1
mSend.Enabled = True
Exit Sub
SendErrorHandler:
Select Case Err
Case 53: Msg = "VB Error 53: File " & TheFile & " doesn't exist."
Case 76: Msg = "VB Error 76: Path " & TheFile & " doesn't exist."
Case Else: Msg = "VB Error " & Err & " occurred."
End Select
MsgBox Msg
'''Resume Next
End Sub
Private Sub mTest_Click()
Dim Code As Long
Dim X As String
Dim Msg As String
Dim NL As String
Dim TheFile As String
NL = Chr$(13) + Chr$(10)
On Error GoTo TestErrorHandler
' open email file
TheFile = eEmail.Text
Open TheFile For Input As 1
Close 1
' open list of receipient addresses
TheFile = eTo.Text
eMessage.Text = eMessage.Text + "Opening " + TheFile + NL
Open eTo.Text For Input As 1
Do Until EOF(1)
Line Input #1, X
If Len(X) > 0 Then
If (InStr(X, "<") = 0) And (InStr(X, ">") = 0) Then
' sorround with brackets
X = "<" + X + ">"
End If
eMessage.Text = eMessage.Text + X + NL
Code = seeVerifyFormat(X)
If Code < 0 Then
Call ShowError(Bcast, Code, X & ": ")
eMessage.Text = eMessage.Text + eResult.Text
Exit Do
End If
End If
Loop
Close 1
Exit Sub
TestErrorHandler:
Select Case Err
Case 53: Msg = "VB Error 53: File " & TheFile & " doesn't exist."
Case 76: Msg = "VB Error 76: 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