www.pudn.com > 20063518740652.zip > BCAST16.FRM, change:1998-11-29,size:9984b
VERSION 2.00
Begin Form Bcast
Caption = "Bcast"
ClientHeight = 6570
ClientLeft = 1905
ClientTop = 1845
ClientWidth = 6090
Height = 7260
Left = 1845
LinkTopic = "Form1"
ScaleHeight = 6570
ScaleWidth = 6090
Top = 1215
Width = 6210
Begin TextBox eEmail
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 285
Left = 1560
TabIndex = 11
Text = "c:\temp\test.mai"
Top = 1320
Width = 2295
End
Begin TextBox eResult
Height = 615
Left = 240
MultiLine = -1 'True
TabIndex = 10
Text = "Ready."
Top = 5880
Visible = 0 'False
Width = 5535
End
Begin TextBox eMessage
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 3615
Left = 240
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 8
Top = 2160
Width = 5535
End
Begin TextBox eSubject
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 285
Left = 1560
TabIndex = 6
Top = 1680
Width = 4215
End
Begin TextBox eTo
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 285
Left = 1560
TabIndex = 4
Text = "c:\temp\email.lst"
Top = 960
Width = 2295
End
Begin TextBox eFrom
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 285
Left = 1560
TabIndex = 2
Top = 600
Width = 3495
End
Begin TextBox eServer
FontBold = 0 'False
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 285
Left = 1560
TabIndex = 0
Top = 240
Width = 3495
End
Begin Label lEmail
Alignment = 1 'Right Justify
Caption = "Email Msg"
Height = 255
Left = 360
TabIndex = 9
Top = 1320
Width = 975
End
Begin Label lSubject
Alignment = 1 'Right Justify
Caption = "Subject"
Height = 255
Left = 360
TabIndex = 7
Top = 1680
Width = 975
End
Begin Label lTo
Alignment = 1 'Right Justify
Caption = "Email List "
Height = 255
Left = 120
TabIndex = 5
Top = 960
Width = 1215
End
Begin Label lFrom
Alignment = 1 'Right Justify
Caption = "Email From"
Height = 255
Left = 240
TabIndex = 3
Top = 600
Width = 1095
End
Begin Label lServer
Alignment = 1 'Right Justify
Caption = "SMTP Server"
Height = 255
Left = 120
TabIndex = 1
Top = 240
Width = 1215
End
Begin Menu mTest
Caption = "TestList"
End
Begin Menu mSend
Caption = "SendEmail"
End
Begin Menu mExit
Caption = "Exit"
End
End
Option Explicit
Sub bOK_Click ()
eResult.Visible = False
eResult.Text = ""
End Sub
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'. Choose 'TestList' to "
S3 = "verify the address formats in 'Email List'"
eMessage.Text = S1 & S2 & S3
End Sub
Sub mExit_Click ()
Dim Code As Integer
Code = seeClose()
End
End Sub
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
Sub mSend_Click ()
Dim Code As Integer
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
Sub mTest_Click ()
Dim Code As Integer
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