My goal is to have this program send a logout command when the user is logging off or shutting down their pc.
我的目标是让用户在注销或关闭他们的电脑时发送一个注销命令。
The program is connected to a server application via a tcp socket using a Winsock object. Calling singleSock.SendData "quit" & vbCrLf
is simply a way of logging out. I am going to start capturing data with Wireshark, but I'd like to know if I'm trying to do something fundamentally wrong.
程序通过使用Winsock对象的tcp套接字连接到服务器应用程序。调用singleSock.SendData“quit”&vbCrLf只是一种注销方式。我将开始使用Wireshark捕获数据,但我想知道我是否正在尝试做一些根本错误的事情。
Oddly enough, if I set Cancel to True, and allow a timer I have running to do the logout command, then call another unload, it works, however in testing this configuration (different code), this prevents the user from logging out the first time. They have to initiate a logout, it doesn't do anything, then they logout again and my program is gone at that point. Also oddly enough, in Vista the logout goes through after briefly displaying a screen saying my program was preventing the logout. Most of my deployment is on XP, which has the two logouts problem.
奇怪的是,如果我将Cancel设置为True,并允许我运行的计时器执行logout命令,然后调用另一个卸载,它可以工作,但是在测试此配置(不同代码)时,这可以防止用户注销第一个时间。他们必须启动注销,它什么都不做,然后他们再次注销,我的程序在那时就消失了。同样奇怪的是,在Vista中,在短暂显示一个显示我的程序阻止注销的屏幕之后,注销就会完成。我的大多数部署都在XP上,它有两个注销问题。
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode = vbFormControlMenu Then
Me.WindowState = vbMinimized
Cancel = True
Else
If SHUTDOWN_FLAG = True Then
Cancel = False
Else
Cancel = True
SHUTDOWN_FLAG = True
End If
tmrSocket.Enabled = False
SHUTDOWN_FLAG = True
Sleep (1000)
singleSock.SendData "quit" & vbCrLf
Call pUnSubClass
'If singleSock.state <> sckConnected Then
' singleSock.Close
' tmrSocket.Enabled = False
' LogThis "tmrSocket turned off"
'End If
DoEvents
End If
End Sub
3 个解决方案
#1
You're not waiting for the Winsock control to actually send the "quit" message. The SendData
method is asynchronous: it can return before the data has actually been sent across the network. The data is buffered locally on your machine and sent at some later time by the network driver.
你不是在等Winsock控件实际发送“退出”消息。 SendData方法是异步的:它可以在数据实际通过网络发送之前返回。数据在您的计算机上本地缓冲,稍后由网络驱动程序发送。
In your case, you are trying to send the "quit" message and then closing the socket almost immediately afterwards. Because SendData
is asynchronous, the call might return before the "quit" message has actually been sent to the server, and therefore the code might close the socket before it has a chance to send the message.
在您的情况下,您尝试发送“退出”消息,然后几乎立即关闭套接字。由于SendData是异步的,因此调用可能在“退出”消息实际发送到服务器之前返回,因此代码可能会在有机会发送消息之前关闭套接字。
It works when you cancel the unloading of the form first and let the timer send the "quit" message because you're giving the socket enough extra time to send the message to the server before the socket is closed. However, I wouldn't count on this always working; it's a coincidence that the extra steps gave the socket enough time to send the message, and it's not guaranteed to always work out that way.
当您取消首先卸载表单并让计时器发送“退出”消息时,它会起作用,因为您在套接字关闭之前给套接字足够的额外时间将消息发送到服务器。但是,我不指望这一直在工作;巧合的是,额外的步骤给了套接字足够的时间来发送消息,并且不能保证总是以这种方式解决。
You can fix the problem by waiting for the socket to raise a SendCompleted
event after you send the "quit" message and before you close the socket. Below is a basic example. Note that the QueryUnload
code is much simpler.
您可以通过在发送“退出”消息之后和关闭套接字之前等待套接字引发SendCompleted事件来解决问题。以下是一个基本的例子。请注意,QueryUnload代码要简单得多。
Private m_bSendCompleted As Boolean
Private m_bSocketError As Boolean
Private Sub singleSock_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
'Set error flag so we know if a SendData call failed because of an error'
'A more robust event handler could also store the error information so that'
'it can be properly logged elsewhere'
m_bSocketError = True
End Sub
Private Sub singleSock_SendCompleted()
'Set send completed flag so we know when all our data has been sent to the server'
m_bSendCompleted = True
End Sub
'Helper routine. Use this to send data to the server'
'when you need to make sure that the client sends all the data.'
'It will wait until all the data is sent, or until an error'
'occurs (timeout, connection reset, etc.).'
Private Sub SendMessageAndWait(ByVal sMessage As String)
m_bSendCompleted = False
singleSock.SendData sMessage
singleSock.SendData sMessage
Do Until m_bSendCompleted or m_bSocketError
DoEvents
Loop
If m_bSocketError Then
Err.Raise vbObjectError+1024,,"Socket error. Message may not have been sent."
End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'This is (almost) all the code needed to properly send the quit message'
'and ensure that it is sent before the socket is closed. The only thing'
'missing is some error-handling (because SendMessageAndWait could raise an error).'
If UnloadMode = vbFormControlMenu Then
Me.WindowState = vbMinimized
Cancel = True
Else
SendMessageAndWait "quit" & vbCrLf
singleSock.Close
End If
End Sub
You can make the code cleaner by putting the logic to send a message and wait for it to be sent in a separate class. This keeps the private variables and the event handlers in one place, instead of having them litter your main code. It also makes it easier to re-use the code when you have multiple sockets. I called the class SynchronousMessageSender
for lack of a better name. This example also has more complete error handling:
您可以通过将逻辑发送到消息并等待它在单独的类中发送来使代码更清晰。这会将私有变量和事件处理程序保存在一个位置,而不是让它们丢失主代码。当您有多个套接字时,它还可以更轻松地重用代码。我把类SynchronousMessageSender叫做缺乏更好的名字。此示例还具有更完整的错误处理:
SynchronousMessageSender.cls
Private WithEvents m_Socket As Winsock
Private m_bAttached As Boolean
Private m_bSendCompleted As Boolean
Private m_bSocketError As Boolean
Private Type SocketError
Number As Integer
Description As String
Source As String
HelpFile As String
HelpContext As Long
End Type
Private m_LastSocketError As SocketError
'Call this method first to attach the SynchronousMessageSender to a socket'
Public Sub AttachSocket(ByVal socket As Winsock)
If m_bAttached Then
Err.Raise 5,,"A socket is already associated with this SynchronousMessageSender instance."
End If
If socket Is Nothing Then
Err.Raise 5,,"Argument error. 'socket' cannot be Nothing."
End If
Set m_Socket = socket
End Sub
Private Sub socket_SendCompleted()
m_bSendCompleted = True
End Sub
Private Sub socket_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
m_bSocketError = True
'Store error information for later use'
'Another option would be to create an Error event for this class'
'and re-raise it here.'
With m_lastSocketError
.Number = Number
.Description = Description
.Source = Source
.HelpFile = HelpFile
.HelpContext = HelpContext
End With
End Sub
'Sends the text in sMessage and does not return'
'until the data is sent or a socket error occurs.'
'If a socket error occurs, this routine will re-raise'
'the error back to the caller.'
Public Sub SendMessage(ByVal sMessage As String)
If Not m_bAttached Then
Err.Raise 5,,"No socket is associated with this SynchronousMessageSender. Call Attach method first."
End If
m_bSendCompleted = False
m_bSocketError = False
m_socket.SendData sMessage & vbCrLf
'Wait until the message is sent or an error occurs'
Do Until m_bSendCompleted Or m_bSocketError
DoEvents
Loop
If m_bSocketError Then
RaiseLastSocketError
End If
End Sub
Private Sub RaiseLastSocketError()
Err.Raise m_lastSocketError.Number, _
m_lastSocketError.Source, _
m_lastSocketError.Description, _
m_lastSocketError.HelpFile, _
m_lastSocketError.HelpContext
End Sub
Example Use
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim sender As New SynchronousMessageSender
'Ignore errors since the application is closing...'
On Error Resume Next
If UnloadMode = vbFormControlMenu Then
Me.WindowState = vbMinimized
Cancel = True
Else
Set sender = New SynchronousMessageSender
sender.AttachSocket singleSock
sender.SendMessage "quit"
singleSock.Close
End If
End Sub
By using a separate class, now all the necessary code can be placed in the Form_QueryUnload
, which keeps things tidier.
通过使用单独的类,现在可以将所有必需的代码放在Form_QueryUnload中,这样可以保持整洁。
#2
Wouldn't is be easier to just go without the QUIT command. In your server code just assume that the closing of a socket does the same thing as receiving a quit.
没有QUIT命令就不会更容易。在您的服务器代码中,假设关闭套接字与接收退出的操作相同。
I addition, one thing you want to watch out for is abrupt shut downs of the client software. For example, a machine that losses power or network connection or a machine that goes into sleep or hibernate mode.
此外,您要注意的一件事是客户端软件的突然关闭。例如,丢失电源或网络连接的机器或进入睡眠或休眠模式的机器。
In those cases you should be periodically checking the connection for all of the clients from the server and closing any connections that do not respond to some kind of ping command.
在这些情况下,您应该定期检查服务器中所有客户端的连接,并关闭任何不响应某种ping命令的连接。
#3
Why is the sub named Private Sub singleSock_SendCompleted() when the actual event is named _SendComplete() ?
当实际事件命名为_SendComplete()时,为什么子命名为Private Sub singleSock_SendCompleted()?
#1
You're not waiting for the Winsock control to actually send the "quit" message. The SendData
method is asynchronous: it can return before the data has actually been sent across the network. The data is buffered locally on your machine and sent at some later time by the network driver.
你不是在等Winsock控件实际发送“退出”消息。 SendData方法是异步的:它可以在数据实际通过网络发送之前返回。数据在您的计算机上本地缓冲,稍后由网络驱动程序发送。
In your case, you are trying to send the "quit" message and then closing the socket almost immediately afterwards. Because SendData
is asynchronous, the call might return before the "quit" message has actually been sent to the server, and therefore the code might close the socket before it has a chance to send the message.
在您的情况下,您尝试发送“退出”消息,然后几乎立即关闭套接字。由于SendData是异步的,因此调用可能在“退出”消息实际发送到服务器之前返回,因此代码可能会在有机会发送消息之前关闭套接字。
It works when you cancel the unloading of the form first and let the timer send the "quit" message because you're giving the socket enough extra time to send the message to the server before the socket is closed. However, I wouldn't count on this always working; it's a coincidence that the extra steps gave the socket enough time to send the message, and it's not guaranteed to always work out that way.
当您取消首先卸载表单并让计时器发送“退出”消息时,它会起作用,因为您在套接字关闭之前给套接字足够的额外时间将消息发送到服务器。但是,我不指望这一直在工作;巧合的是,额外的步骤给了套接字足够的时间来发送消息,并且不能保证总是以这种方式解决。
You can fix the problem by waiting for the socket to raise a SendCompleted
event after you send the "quit" message and before you close the socket. Below is a basic example. Note that the QueryUnload
code is much simpler.
您可以通过在发送“退出”消息之后和关闭套接字之前等待套接字引发SendCompleted事件来解决问题。以下是一个基本的例子。请注意,QueryUnload代码要简单得多。
Private m_bSendCompleted As Boolean
Private m_bSocketError As Boolean
Private Sub singleSock_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
'Set error flag so we know if a SendData call failed because of an error'
'A more robust event handler could also store the error information so that'
'it can be properly logged elsewhere'
m_bSocketError = True
End Sub
Private Sub singleSock_SendCompleted()
'Set send completed flag so we know when all our data has been sent to the server'
m_bSendCompleted = True
End Sub
'Helper routine. Use this to send data to the server'
'when you need to make sure that the client sends all the data.'
'It will wait until all the data is sent, or until an error'
'occurs (timeout, connection reset, etc.).'
Private Sub SendMessageAndWait(ByVal sMessage As String)
m_bSendCompleted = False
singleSock.SendData sMessage
singleSock.SendData sMessage
Do Until m_bSendCompleted or m_bSocketError
DoEvents
Loop
If m_bSocketError Then
Err.Raise vbObjectError+1024,,"Socket error. Message may not have been sent."
End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'This is (almost) all the code needed to properly send the quit message'
'and ensure that it is sent before the socket is closed. The only thing'
'missing is some error-handling (because SendMessageAndWait could raise an error).'
If UnloadMode = vbFormControlMenu Then
Me.WindowState = vbMinimized
Cancel = True
Else
SendMessageAndWait "quit" & vbCrLf
singleSock.Close
End If
End Sub
You can make the code cleaner by putting the logic to send a message and wait for it to be sent in a separate class. This keeps the private variables and the event handlers in one place, instead of having them litter your main code. It also makes it easier to re-use the code when you have multiple sockets. I called the class SynchronousMessageSender
for lack of a better name. This example also has more complete error handling:
您可以通过将逻辑发送到消息并等待它在单独的类中发送来使代码更清晰。这会将私有变量和事件处理程序保存在一个位置,而不是让它们丢失主代码。当您有多个套接字时,它还可以更轻松地重用代码。我把类SynchronousMessageSender叫做缺乏更好的名字。此示例还具有更完整的错误处理:
SynchronousMessageSender.cls
Private WithEvents m_Socket As Winsock
Private m_bAttached As Boolean
Private m_bSendCompleted As Boolean
Private m_bSocketError As Boolean
Private Type SocketError
Number As Integer
Description As String
Source As String
HelpFile As String
HelpContext As Long
End Type
Private m_LastSocketError As SocketError
'Call this method first to attach the SynchronousMessageSender to a socket'
Public Sub AttachSocket(ByVal socket As Winsock)
If m_bAttached Then
Err.Raise 5,,"A socket is already associated with this SynchronousMessageSender instance."
End If
If socket Is Nothing Then
Err.Raise 5,,"Argument error. 'socket' cannot be Nothing."
End If
Set m_Socket = socket
End Sub
Private Sub socket_SendCompleted()
m_bSendCompleted = True
End Sub
Private Sub socket_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
m_bSocketError = True
'Store error information for later use'
'Another option would be to create an Error event for this class'
'and re-raise it here.'
With m_lastSocketError
.Number = Number
.Description = Description
.Source = Source
.HelpFile = HelpFile
.HelpContext = HelpContext
End With
End Sub
'Sends the text in sMessage and does not return'
'until the data is sent or a socket error occurs.'
'If a socket error occurs, this routine will re-raise'
'the error back to the caller.'
Public Sub SendMessage(ByVal sMessage As String)
If Not m_bAttached Then
Err.Raise 5,,"No socket is associated with this SynchronousMessageSender. Call Attach method first."
End If
m_bSendCompleted = False
m_bSocketError = False
m_socket.SendData sMessage & vbCrLf
'Wait until the message is sent or an error occurs'
Do Until m_bSendCompleted Or m_bSocketError
DoEvents
Loop
If m_bSocketError Then
RaiseLastSocketError
End If
End Sub
Private Sub RaiseLastSocketError()
Err.Raise m_lastSocketError.Number, _
m_lastSocketError.Source, _
m_lastSocketError.Description, _
m_lastSocketError.HelpFile, _
m_lastSocketError.HelpContext
End Sub
Example Use
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim sender As New SynchronousMessageSender
'Ignore errors since the application is closing...'
On Error Resume Next
If UnloadMode = vbFormControlMenu Then
Me.WindowState = vbMinimized
Cancel = True
Else
Set sender = New SynchronousMessageSender
sender.AttachSocket singleSock
sender.SendMessage "quit"
singleSock.Close
End If
End Sub
By using a separate class, now all the necessary code can be placed in the Form_QueryUnload
, which keeps things tidier.
通过使用单独的类,现在可以将所有必需的代码放在Form_QueryUnload中,这样可以保持整洁。
#2
Wouldn't is be easier to just go without the QUIT command. In your server code just assume that the closing of a socket does the same thing as receiving a quit.
没有QUIT命令就不会更容易。在您的服务器代码中,假设关闭套接字与接收退出的操作相同。
I addition, one thing you want to watch out for is abrupt shut downs of the client software. For example, a machine that losses power or network connection or a machine that goes into sleep or hibernate mode.
此外,您要注意的一件事是客户端软件的突然关闭。例如,丢失电源或网络连接的机器或进入睡眠或休眠模式的机器。
In those cases you should be periodically checking the connection for all of the clients from the server and closing any connections that do not respond to some kind of ping command.
在这些情况下,您应该定期检查服务器中所有客户端的连接,并关闭任何不响应某种ping命令的连接。
#3
Why is the sub named Private Sub singleSock_SendCompleted() when the actual event is named _SendComplete() ?
当实际事件命名为_SendComplete()时,为什么子命名为Private Sub singleSock_SendCompleted()?