VB6 Winsock multiple TCP connections > problems with DoEvents - vb6

I made a software couple years ago using VB6 that works as a TCP server, receives multiple connections from clients.
The basic Idea of the software is to listen on a specific port, accept connections from different clients and pass each connection to a separate winsock which analyzes the data, looks in DB, replies with the proper message, and then closes the connection.
Here's some code:
Initializing the sockets when the application starts:
For i = 1 To MaxCon
Load sckAccept(i)
Next i
sckListen.Listen
Accepting connections:
Private Sub sckListen_ConnectionRequest(ByVal requestID As Long)
Dim aFreeSocket As Integer
aFreeSocket = GetFreeSocket
If aFreeSocket = 0 Then
sckAccept(0).Accept requestID
sckAccept(0).SendData "Server is full!"
sckAccept(0).Close
Else
sckAccept(aFreeSocket).Accept requestID
End Sub
Receiving data, analyzing it, and reply:
Private Sub sckAccept_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim sData As String
sckAccept(Index).GetData sData
'Do lots of analyizing and search in DB
'
'
sckAccept(Index).SendData "Message"
'
'
DoEvents
sckAccept(Index).Close
End Sub
Everything was working fine, but now the number of connections has increased (couple dozens per second), so the software started getting Out of stack space exception (because of DoEvents).
I know that in many cases DoEvents is evil, but if I remove it, the application UI won't respond (because of the over load on the thread) and some data might not be delivered.
So, my question is: does anyone have an idea of how to get around this problem with/without using DoEvents?
Note: I know that VB6 doesn't really support multi-threading and might be a PITA for such situations. I'm actually planning to upgrade the software and re-create it using .Net, but that will take some time. That's why I need to fix this problem in VB6 since the software is written in VB6 for now.

Well, I managed to figure out the problem, and have solved it.
The short answer
Do NOT use DoEvents.. Some data won't be delivered? Well, close the connection ONLY in the SendComplete event.
The long answer
First thing first:
Why I used DoEvents in the first place? because some of the sent messages were not being delivered. A lot of articles/questions on the internet suggest using DoEvents after Socket.SendData in order to guarantee the data arrival to the receiver.
I digged deeper into this trying to figure out why the messages aren't delivered. I found out that this problem only occurs when closing the connection after sending the message:
Socket.SendData "Message"
'
'
Socket.Close
So, I simply moved the line that closes the connection to the SendComplete event, removed the DoEvents sentence -since I don't need it anymore-, and the problem is gone :)
Private Sub sckAccept_SendComplete(Index As Integer)
sckAccept_Close (Index)
End Sub
I hope this could help someone who has the same problem.

Related

Publishing protocol buffer messages over websockets in Julia

I'm working on a project where I want to have a Julia server process periodically publishing messages that involve some binary data. The initial client will be written in javascript, but we'd ultimately like the capability of having multiple clients, implemented in various ways. For that reason, I'd like to define the message using protocol buffers. I've turned up 3 Julia websocket implementations: WebSockets.jl, SimpleSockets.jl and HTTP.jl's WebSockets. I've done some naive experimenting with WebSockets.jl and got an error ("WebSockets does not support byte I/O"). My inclination is to shift my focus to the HTTP.jl implementation; I get the impression that it is under more active development than WebSockets.jl.
Update: I've continued with my experimentation. I was guided to a previous SO question, unable to write binary data in websocket, that was instructive. I modeled my server implementation after that in the link, yielding:
include("testmessage_pb.jl")
text = "A man spekith"
msg = TestMessage(someText=text)
function server(port)
#async HTTP.listen(Sockets.localhost, port) do http::HTTP.Stream
if HTTP.WebSockets.is_upgrade(http.message)
HTTP.WebSockets.upgrade(http, binary=true) do ws
while !eof(ws)
data = readavailable(ws)
IOExtras.startwrite(ws)
writeproto(ws, msg)
IOExtras.closewrite(ws)
end
end
end
end
end
Running it, I got an error very much like the previous one I reported:
HTTP.WebSockets.WebSocket{HTTP.ConnectionPool.Transaction{Sockets.TCPSocket}} does not support byte I/O
I'm wondering if anyone reading this has any experience with this particular cluster of technologies (julia, protobuf, websockets) and suggestions on how to proceed ("don't try" would count as useful feedback).
HTTP.jl websockets are working fine. Havn't tried it with protobuf, but hardly there should be any problem with that. It's basically
HTTP.WebSockets.open(data_url) do ws
x = readavailable(ws)
# Do protobuf related things, generate response
write(ws, response)
end
readavailable returns you UInt8[] so you can do whatever you want with it.
I was able to tweak the server implementation that I showed in the question, and it now works. It's a little clunky, and I'll hold off from accepting my own answer in hopes that a nicer approach comes along. In any event, here's the new version:
function server(port)
#async HTTP.listen(Sockets.localhost, port) do http::HTTP.Stream
if HTTP.WebSockets.is_upgrade(http.message)
HTTP.WebSockets.upgrade(http, binary=true) do ws
while !eof(ws)
data = readavailable(ws)
iob = PipeBuffer()
writeproto(iob, msg)
write(ws, take!(iob))
end
end
end
end
end

VB6 ADODB.Connection Execute() Retry until successful

I'm trying to fix a little utility which seems to be losing connection to the database after some idle time. I already set the timeout to 0 but that didn't seem to work.
Instead of simply crashing and displaying a couple of error messages I would like to try to re-establish the connection and execute the query until successful (I realize this is probably a bad use of resources) but even then that's what I'm trying to accomplish here. Or if possible display a Message Box saying that connection was lost which will then be closed once connection is established.
Any suggestions would be greatly appreciated.
Public connMain As ADODB.Connection
Public rsMain As ADODB.Recordset
......
Function Picture_Exists() As Boolean
On Error Resume Next
sqlstr = "select * .... "
Set rsMain = connMain.Execute(sqlstr)
Your connection is probably being dropped at the database end due to non-use. It isn't good practice to maintain a connection when it isn't being used; connections are expensive in terms of resources so any such practice wouldn't scale well. Dbadmins aren't likely to leave unused connections open for very long.
Your potential solution says to try to connect and if you can't ignore the error. We don't say "never" in this business very often, but you should never use "On Error Resume Next" without also evaluating Err.Number to see whether it equals 0 (if it does, there's no error). This is called "inline error handling."
In any case, I wouldn't use this method. I would evaluate the Connection object's State Property, and if it's closed (cn.State = adoStateClosed) then I would reopen it.
You can try the following:
On Error Resume ''''instead of On Error Resume Next
Dim rsMain As New ADODB.Recordset
sqlstr = "select * .... "
If rsMain.State = adStateOpen Then rsMain.Close
rsMain.Open sqlstr, sProvider, adOpenKeyset, adLockOptimistic

VB6 - Reading a single bit over an RS232 line/ COM port

I am currently working on writing a little script on VB6 to replace a script running on a UNIX machine. What that script does is wait for the UPS system to close a switch which is then received by a COM port and a driver shuts down the UNIX machine. I want to do that for a Windows PC but it is giving me some trouble.
I built a connector, according to the schematics I have, bridging pins 7 and 8 and connecting a switch between pins 2 and 3 (RXD and TXD). Flipping the switch on is exactly the same as the UPS system doing it.
Private Sub shutdownPC()
Dim inStr As Variant
myCom.CommPort = 1
myCom.Settings = "9600,e,7,1"
myCom.RThreshold = 1
myCom.InputLen = 0
myCom.InputMode = comInputModeBinary
myCom.InBufferCount() = 0
myCom.PortOpen = True
'Shell ("shutdown.exe -s -t01")
If myCom.CommEvent = comEvReceive Then
inStr = myCom.Input
End If
End Sub
This is my code so far. I have included the MSComm library and added an MSComm object to my form. When I use comInputModeBinary and comInputModeText, I get "No variables" and "" on myCom.Input respectively. Using Powershell I can see that the COM1 port is working.
Any ideas on what I am doing wrong?
connecting a switch between pins 2 and 3 (RXD and TXD)
That would create a loopback.
That is only useful if your program is sending out test messages.
If nothing is received, then the switch is still open. When the switch closes, then the program will begin receiving the messages it sent.
Any ideas on what I am doing wrong?
Your program cannot wait passively.
It has to poll the UPS by sending bytes out and then check if any of the data is received back.
You either have to loop or put in an event handler as your code will execute before anything in the external world happens. Looping wastes battery life and slows computers down. The helpfile is at C:\Windows\HELP\COMM98.CHM.
OnComm Event
The OnComm event is generated whenever the value of the CommEvent property changes, indicating that either a communication event or an error occurred.
Syntax
Private Sub object_OnComm ()
The OnComm event syntax has these parts:
Part Description
object Anobject expression that evaluates to an object in the Applies To list.
Remarks
The CommEvent property contains the numeric code of the actual error or event that generated the OnComm event. Note that setting the RThreshold or SThreshold properties to 0 disables trapping for the comEvReceive and comEvSend events, respectively.

VB6 ADO Connection Pooling

We have a bunch of VB6 apps at our company. We are trying to debug a random SQL timeout error and did a trace with SQL Server Profiler on the Audit Login event. We noticed that the connections were coming in as nonpooled. We use the SQLOLEDB provider with SQL Server 2000 & 2005. I searched the internet and everything I come across says that connections are pooled by default in the SQLOLEDB provider, but we are not seeing this. Below is the code we use to connect to the database. We really need to have these connections pooled because we think this may be the problem with our random timeout error. Could any one shine some light on why connection pooling isn't working and any way to make it work? Thanks.
Dim cnn As New ADODB.Connection
cnn.ConnectionString = "Provider=SQLOLEDB;Data Source=xxx;Catalog=xxx;User ID=xxx Password=xxx;"
Call cnn.Open
Dim cmd As New ADODB.Command
Set cmd.ActiveConnection = cnn
cmd.CommandText = "SELECT * FROM [Table]"
Dim rs As New ADODB.RecordSet
Call rs.Open(cmd, , adOpenStatic, adLockOptimistic)
While Not rs.eof
'Do stuff
Call rs.MoveNext
Wend
'Close and Dispose connection here
Disposing the connection on every call could prevent pooling
...at least one instance of a Connection
object instantiated for each unique
user—at all times. Otherwise, the pool
will be destroyed when the last
Connection object for that string is
closed.
http://msdn.microsoft.com/en-us/library/ms810829.aspx
I messed around and opened a connection at app startup and kept it open through the entire time the app was running. Connection pooling did start after the second opened and closed connection.
You mentioned that you were trying to track down a random timeout problem. I've had the same, generally when I was doing a SELECT that returned a lot of rows. Two things:
Cnn.CursorLocation=ADODB.adUseServer
(The other option is adUseClient) - I believe adUseServer gave me faster queries, which reduced the likelihood of timeouts. You do this before you open the connection, I believe.
Cnn.CommandTimeout=0
Also before the open(), tells it that you want an infinite timeout. I think the default timeout is something like 30s, which was way too short for some queries. The CommandTimeout will be used for Recordset queries. If you use a Command object, it has it's own CommandTimeout member, which doesn't appear to inherit from the Connection (ie, I set it before I Execute a command).
Sorry if the syntax isn't quite right, I'm cutting from some C++ code.

CDO.Message - to many connections

I am writing a newsletter application using CDO.Message. But get an error back that we have to many connections. Seems they have a limit of 10 simultaneous connections.
So, is there a way to send several messages on one connection, or disconnect faster?
There is a cdo/configuration/smtpconnectiontimeout parameter, but I think that's more about how long the sender will try.
(If we send,ant it fails, it will succeed again after some minutes, probably meaning that the connection is disconnected).
(We are using CDO partly because we are pulling the HTML message body from a webserver)
Edit:
Public Sub ipSendMail(ByVal toEmail As String, ByVal fromEmail As String, ByVal subject As String, ByVal url As String)
Dim iMsg As Object
Set iMsg = CreateObject("CDO.Message")
iMsg.From = fromEmail
iMsg.To = toEmail
iMsg.Subject = subject
iMsg.CreateMHTMLBody(url)
iMsg.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
iMsg.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "relay.wwwwwwwwww.net"
iMsg.Configuration.Fields.Item_
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
iMsg.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 0
iMsg.Configuration.Fields.Update()
iMsg.Send()
Set iMsg = Nothing
End Sub
Try to use SMTP instead of CDO, System.Web.Mail.SmtpMail
You could implement a queue, that is processed by a background thread. The background thread would only send one message at a time.
You can store the email in a database table, which is processed by a scheduled task or a stored procedure. Those can again send one mail at a time, and have the advantage of being able to retry, if it goes wrong.
Ordinarily you only need one connection regardless of how many messages you are sending.
Perhaps you are not releasing something that you should be.
Edit: Just a thought, the SMTP server you are sending to, it wouldn't happen to be host on an XP box perhaps for testing reasons?
Edit: Ok so your SMTP server is fine.
What platform is the server supplying the result of the URL?
I know that CDO can be quirky at times, so these are the possible suggestions that I would make:
A queue would probably work the best for you. After that, I would consider setting up a local SMTP server without inbound connection limits that uses a smarthost to queue up your outbound messages. (This could actually be written fairly easily. The "S" is for "Simple" and it actually is.)
If all else fails... You could always roll your own mailer component implementing RFCs 2821 and 2822 (or whatever the latest and greatest RFCs are for SMTP and message format)
EDIT: If the newsletter you are sending out is identical for all recipients, you can address it to a dummy recipient (i.e. newsletter#yourdomain.com) and BCC it to the recipient list (or a subset of the recipient list). Just be careful not to get flagged as unsolicited commercial email. Let your provider know what you are doing. They have to deal with the complaints, and you are the one paying the bill. Letting them know that complaints would be mostly unwarranted (and few and far between) will help to assuage their natural risk aversion.

Resources