Bill Adams
Mar 16th, 2000, 03:26 AM
This code reads an input file to get the SMTP mail server, sender, recipient, subject, and message text. It then proceeds to send e-mail until end-of-file.
The code runs perfectly on machines where VB has been installed. It refuses to run on machines where VB has not been installed. You can install VB on a "fresh" machine and immediately uninstall it and the code will still work fine.
As information, I used the add-in package and deployment wizard to create an installation package. All the .DLLs needed to run VB programs are included in the package as well as winsock.
The installation goes smoothly. When requested for a reboot (due to the VB support file garbage), I do so and run the setup app again (this installs the app on the second go-round). It completes normally.
The code will run on non-VB machines, but for some reason either cannot connect with the server or cannot hear back from the server if VB has not been installed on the particular machine...Therefore, it just sits there.
Again, install the app on a machine upon which VB has been installed in the past and, presto, it works flawlessly. What is it that VB installation does that allows this code to work?
For the sample to work, you need to have a form and add a winsock control to it.
Dim spacepos As Integer
Dim Holder As String
Dim txtServer As String
Dim txtTo As String
Dim txtFrom As String
Dim txtSubject As String
Dim txtText As String
Dim sCommand As String
Dim StrStatus As String
Dim outtext As String
Dim X As Long
Dim I As Long
Dim InputString(5000) As String * 500
Private Sub Form_Load()
Text1.Text = Now
' Open Input File
Open "c:\InMsg.txt" For Input As #1
If Err <> 0 Then
Msg = "Error: Input file cannot be opened. Terminating Session"
MsgBox Msg
End If
I = 1
While Not EOF(1)
Line Input #1, InputString(I)
I = I + 1
Wend
' Data is now in an array so we can close the input file.
Close #1
' Open Output File
Open "c:\outmsg.txt" For Output As #2
If Err <> 0 Then
Msg = "Error: Output file cannot be opened. Terminating Session"
MsgBox Msg
End If
X = 1
Getnext
End Sub
Sub Getnext()
' We'll check to see if the counter (X) = the number of records in the array. If so end
' as the last number in the array is a blank record. If we're not ready to end, call sendit.
' Sendit will send the message and increment the counter (X) by 1 and send the code back
' here to see if it needs to stop.
If X >= I Then
Close #2
End
Exit Sub
End If
sendit
End Sub
Sub sendit()
' This logic decodes the input file and initiates communication from the server. Then, the
' code will wait for a response from the server. See wsTCP_DataArrival.
' Yeah, this is a funky delimiter strategy
txtServer = Left(InputString(X), InStr(InputString(X), "\-/") - 1)
txtTo = Left(InputString(X), InStr(InputString(X), "\\-//") - 1)
txtTo = Mid(txtTo, InStr(txtTo, "\-/") + 3)
txtFrom = Left(InputString(X), InStr(InputString(X), "\\\-///") - 1)
txtFrom = Mid(txtFrom, InStr(txtFrom, "\\-//") + 5)
txtSubject = Left(InputString(X), InStr(InputString(X), "\\\\-////") - 1)
txtSubject = Mid(txtSubject, InStr(txtSubject, "\\\-///") + 7)
txtText = Mid(InputString(X), InStr(InputString(X), "\\\\-////") + 9)
' Replace spaces in From party with "_"
Holder = txtFrom
spacepos = InStr(Holder, Chr$(32))
' SMTP standards say the From party cannot have spaces in it. Replace them here.
While spacepos > 0
Mid(Holder, spacepos, 1) = "_"
spacepos = InStr(Holder, Chr$(32))
Wend
txtFrom = Holder
' Start communicating with the server.
Me.wsTCP.Close
Me.wsTCP.RemotePort = 25
Me.wsTCP.RemoteHost = txtServer
Me.wsTCP.Connect
End Sub
Private Sub wsTCP_DataArrival(ByVal bytesTotal As Long)
' This logic waits on a reply from the server. Depending on the reply, the server will send
' farm out the response to subs. If a message is sent ok, or if there is an error, the code
' writes a log entry and loops back to check for the end of the input file.
On Error Resume Next
Dim MsgIn As String
Dim sCode As Integer
Me.wsTCP.GetData MsgIn
sCode = Val(Left(MsgIn, 3))
If sCode = 220 Then
Send220
Exit Sub
End If
If sCode = 250 Then
send250
Exit Sub
End If
If sCode = 354 Then
send354
Exit Sub
End If
If sCode = 221 Then
outtext = "Message sent successfully." & " Server = " & txtServer & " Recipient = " & txtTo & " Sender = " & txtFrom & " Subject = " & txtSubject & " Message = " & txtText
Print #2, outtext
X = (X + 1)
Getnext
Exit Sub
End If
If sCode = 501 Then
outtext = "Error occurred sending message." & " Server = " & txtServer & " Recipient = " & txtTo & " Sender = " & txtFrom & " Subject = " & txtSubject & " Message = " & txtText
Print #2, outtext
X = (X + 1)
Getnext
Exit Sub
End If
'If you got here, something bad and unexpected happened so exit the sub
outtext = "Error occurred sending message." & " Server = " & txtServer & " Recipient = " & txtTo & " Sender = " & txtFrom & " Subject = " & txtSubject & " Message = " & txtText
Print #2, outtext
Getnext
Exit Sub
End Sub
Private Sub Send220()
Me.wsTCP.SendData "HELO " & txtServer & vbCrLf
End Sub
Private Sub send250()
Select Case sCommand
Case ""
sCommand = "MAIL FROM:"
Me.wsTCP.SendData sCommand & txtFrom & vbCrLf
Case "MAIL FROM:"
sCommand = "RCPT TO:"
Me.wsTCP.SendData sCommand & txtTo & vbCrLf
Case "RCPT TO:"
sCommand = "DATA"
Me.wsTCP.SendData sCommand & vbCrLf
Case Else
sCommand = ""
StrStatus = "message sent"
Me.wsTCP.SendData "QUIT" & vbCrLf
End Select
End Sub
Private Sub send354()
Me.wsTCP.SendData "DATE: " & Format(Now, "h:mm:ss") & vbCrLf _
& "FROM: " & txtFrom & vbCrLf _
& "TO: " & txtTo & vbCrLf _
& "SUBJECT: " & txtSubject & vbCrLf & vbCrLf _
& txtText & vbCrLf & "." & vbCrLf
End Sub
The code runs perfectly on machines where VB has been installed. It refuses to run on machines where VB has not been installed. You can install VB on a "fresh" machine and immediately uninstall it and the code will still work fine.
As information, I used the add-in package and deployment wizard to create an installation package. All the .DLLs needed to run VB programs are included in the package as well as winsock.
The installation goes smoothly. When requested for a reboot (due to the VB support file garbage), I do so and run the setup app again (this installs the app on the second go-round). It completes normally.
The code will run on non-VB machines, but for some reason either cannot connect with the server or cannot hear back from the server if VB has not been installed on the particular machine...Therefore, it just sits there.
Again, install the app on a machine upon which VB has been installed in the past and, presto, it works flawlessly. What is it that VB installation does that allows this code to work?
For the sample to work, you need to have a form and add a winsock control to it.
Dim spacepos As Integer
Dim Holder As String
Dim txtServer As String
Dim txtTo As String
Dim txtFrom As String
Dim txtSubject As String
Dim txtText As String
Dim sCommand As String
Dim StrStatus As String
Dim outtext As String
Dim X As Long
Dim I As Long
Dim InputString(5000) As String * 500
Private Sub Form_Load()
Text1.Text = Now
' Open Input File
Open "c:\InMsg.txt" For Input As #1
If Err <> 0 Then
Msg = "Error: Input file cannot be opened. Terminating Session"
MsgBox Msg
End If
I = 1
While Not EOF(1)
Line Input #1, InputString(I)
I = I + 1
Wend
' Data is now in an array so we can close the input file.
Close #1
' Open Output File
Open "c:\outmsg.txt" For Output As #2
If Err <> 0 Then
Msg = "Error: Output file cannot be opened. Terminating Session"
MsgBox Msg
End If
X = 1
Getnext
End Sub
Sub Getnext()
' We'll check to see if the counter (X) = the number of records in the array. If so end
' as the last number in the array is a blank record. If we're not ready to end, call sendit.
' Sendit will send the message and increment the counter (X) by 1 and send the code back
' here to see if it needs to stop.
If X >= I Then
Close #2
End
Exit Sub
End If
sendit
End Sub
Sub sendit()
' This logic decodes the input file and initiates communication from the server. Then, the
' code will wait for a response from the server. See wsTCP_DataArrival.
' Yeah, this is a funky delimiter strategy
txtServer = Left(InputString(X), InStr(InputString(X), "\-/") - 1)
txtTo = Left(InputString(X), InStr(InputString(X), "\\-//") - 1)
txtTo = Mid(txtTo, InStr(txtTo, "\-/") + 3)
txtFrom = Left(InputString(X), InStr(InputString(X), "\\\-///") - 1)
txtFrom = Mid(txtFrom, InStr(txtFrom, "\\-//") + 5)
txtSubject = Left(InputString(X), InStr(InputString(X), "\\\\-////") - 1)
txtSubject = Mid(txtSubject, InStr(txtSubject, "\\\-///") + 7)
txtText = Mid(InputString(X), InStr(InputString(X), "\\\\-////") + 9)
' Replace spaces in From party with "_"
Holder = txtFrom
spacepos = InStr(Holder, Chr$(32))
' SMTP standards say the From party cannot have spaces in it. Replace them here.
While spacepos > 0
Mid(Holder, spacepos, 1) = "_"
spacepos = InStr(Holder, Chr$(32))
Wend
txtFrom = Holder
' Start communicating with the server.
Me.wsTCP.Close
Me.wsTCP.RemotePort = 25
Me.wsTCP.RemoteHost = txtServer
Me.wsTCP.Connect
End Sub
Private Sub wsTCP_DataArrival(ByVal bytesTotal As Long)
' This logic waits on a reply from the server. Depending on the reply, the server will send
' farm out the response to subs. If a message is sent ok, or if there is an error, the code
' writes a log entry and loops back to check for the end of the input file.
On Error Resume Next
Dim MsgIn As String
Dim sCode As Integer
Me.wsTCP.GetData MsgIn
sCode = Val(Left(MsgIn, 3))
If sCode = 220 Then
Send220
Exit Sub
End If
If sCode = 250 Then
send250
Exit Sub
End If
If sCode = 354 Then
send354
Exit Sub
End If
If sCode = 221 Then
outtext = "Message sent successfully." & " Server = " & txtServer & " Recipient = " & txtTo & " Sender = " & txtFrom & " Subject = " & txtSubject & " Message = " & txtText
Print #2, outtext
X = (X + 1)
Getnext
Exit Sub
End If
If sCode = 501 Then
outtext = "Error occurred sending message." & " Server = " & txtServer & " Recipient = " & txtTo & " Sender = " & txtFrom & " Subject = " & txtSubject & " Message = " & txtText
Print #2, outtext
X = (X + 1)
Getnext
Exit Sub
End If
'If you got here, something bad and unexpected happened so exit the sub
outtext = "Error occurred sending message." & " Server = " & txtServer & " Recipient = " & txtTo & " Sender = " & txtFrom & " Subject = " & txtSubject & " Message = " & txtText
Print #2, outtext
Getnext
Exit Sub
End Sub
Private Sub Send220()
Me.wsTCP.SendData "HELO " & txtServer & vbCrLf
End Sub
Private Sub send250()
Select Case sCommand
Case ""
sCommand = "MAIL FROM:"
Me.wsTCP.SendData sCommand & txtFrom & vbCrLf
Case "MAIL FROM:"
sCommand = "RCPT TO:"
Me.wsTCP.SendData sCommand & txtTo & vbCrLf
Case "RCPT TO:"
sCommand = "DATA"
Me.wsTCP.SendData sCommand & vbCrLf
Case Else
sCommand = ""
StrStatus = "message sent"
Me.wsTCP.SendData "QUIT" & vbCrLf
End Select
End Sub
Private Sub send354()
Me.wsTCP.SendData "DATE: " & Format(Now, "h:mm:ss") & vbCrLf _
& "FROM: " & txtFrom & vbCrLf _
& "TO: " & txtTo & vbCrLf _
& "SUBJECT: " & txtSubject & vbCrLf & vbCrLf _
& txtText & vbCrLf & "." & vbCrLf
End Sub