您並不等待Winsock控件實際發送「退出」消息。 SendData方法是異步的：它可以在數據實際上通過網絡發送之前返回。數據在本地緩存在您的機器上，稍後由網絡驅動程序發送。
在你的情況，你要發送的「跳槽」的消息，然後關閉套接字幾乎隨即。因爲SendData是異步的，所以在「退出」消息實際發送到服務器之前，調用可能會返回，因此代碼可能會在有機會發送消息之前關閉套接字。
當你第一次取消形式的卸載，並讓計時器發送「退出」消息，因爲你給插座足夠的額外時間將消息發送到服務器關閉套接字之前它的工作原理。不過，我不會指望這總是有效的;這是一個巧合，額外的步驟給套接字足夠的時間來發送消息，並且不能保證總是以這種方式工作。
您可以通過在發送「退出」消息並關閉套接字之前等待套接字引發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
您可以通過將邏輯來發送消息，並等待它在一個單獨的類被送到使代碼更乾淨。這將私有變量和事件處理程序保留在一個地方，而不是讓它們遺留在主代碼中。當您有多個套接字時，它還可以更輕鬆地重新使用代碼。我稱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
實施例使用
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
通過使用一個單獨的類，現在所有的必要的代碼可以被放置在Form_QueryUnload，保持事情更整潔。