vba - winsock 连接功能仅适用于高速连接

Question

我在我的 VB6 应用程序中使用 winsock，这是我的代码:

Private Sub Form_Load()  

  With Winsock1  
    .Close  
    .RemoteHost = Hostip
    .RemotePort = port number
    .Connect
  End With
End Sub

我的问题是，当我使用高速连接 (4G) 时，连接工作正常，但使用其他连接(如(3G，明智...)时，它返回以下消息:

the attempt to connect timed out

我该如何补救？

Answer 1

听起来您需要设置更长的连接超时时间。没有办法直接用控件来做到这一点。下面是一篇已停用的知识库文章中的修改示例。原始代码不包含 SO_SNDTIMEO 或 SO_RCVTIMEO 选项。

Option Explicit

' Error returned by Winsock API.
Const SOCKET_ERROR = -1

' Level number for (get/set)sockopt() to apply to socket itself.
Const SOL_SOCKET = 65535      ' Options for socket level.
Const IPPROTO_TCP = 6         ' Protocol constant for TCP.

' option flags per socket
Const SO_DEBUG = &H1&         ' Turn on debugging info recording
Const SO_ACCEPTCONN = &H2&    ' Socket has had listen() - READ-ONLY.
Const SO_REUSEADDR = &H4&     ' Allow local address reuse.
Const SO_KEEPALIVE = &H8&     ' Keep connections alive.
Const SO_DONTROUTE = &H10&    ' Just use interface addresses.
Const SO_BROADCAST = &H20&    ' Permit sending of broadcast msgs.
Const SO_USELOOPBACK = &H40&  ' Bypass hardware when possible.
Const SO_LINGER = &H80&       ' Linger on close if data present.
Const SO_OOBINLINE = &H100&   ' Leave received OOB data in line.

Const SO_DONTLINGER = Not SO_LINGER
Const SO_EXCLUSIVEADDRUSE = Not SO_REUSEADDR ' Disallow local address reuse.

' Additional options.
Const SO_SNDBUF = &H1001&     ' Send buffer size.
Const SO_RCVBUF = &H1002&     ' Receive buffer size.
Const SO_ERROR = &H1007&      ' Get error status and clear.
Const SO_TYPE = &H1008&       ' Get socket type - READ-ONLY.

' TCP Options
Const TCP_NODELAY = &H1&      ' Turn off Nagel Algorithm.

' linger structure
Private Type LINGER_STRUCT
  l_onoff As Integer          ' Is linger on or off?
  l_linger As Integer         ' Linger timeout in seconds.
End Type

'timeout structure
Private Type TIMEOUT_STRUCT
    tv_sec As Long  'seconds
    tv_usec As Long 'milliseconds
End Type

'Timeout options
Const SO_SNDTIMEO = &H1005& 'send timeout
Const SO_RCVTIMEO = &H1006& 'receive timeout

' Winsock API declares
Private Declare Function setsockopt Lib "wsock32.dll" (ByVal s As Long, ByVal level As Long, ByVal optname As Long, optval As Any, ByVal optlen As Long) As Long
Private Declare Function getsockopt Lib "wsock32.dll" (ByVal s As Long, ByVal level As Long, ByVal optname As Long, optval As Any, optlen As Long) As Long

Private Sub Command1_Click()
  ' Read all the options and present in a message box.
  Dim socket As Long

  socket = Winsock1.SocketHandle

  If socket = 0 Then
    MsgBox "No Socket"
  Else
    MsgBox "Socket Options:" & vbCrLf & _
           "    SO_DEBUG: " & CStr(GetSocketOption(socket, SOL_SOCKET, SO_DEBUG)) & vbCrLf & _
           "    SO_ACCEPTCONN: " & CStr(GetSocketOption(socket, SOL_SOCKET, SO_ACCEPTCONN)) & vbCrLf & _
           "    SO_REUSEADDR: " & CStr(GetSocketOption(socket, SOL_SOCKET, SO_REUSEADDR)) & vbCrLf & _
           "    SO_KEEPALIVE: " & CStr(GetSocketOption(socket, SOL_SOCKET, SO_KEEPALIVE)) & vbCrLf & _
           "    SO_DONTROUTE: " & CStr(GetSocketOption(socket, SOL_SOCKET, SO_DONTROUTE)) & vbCrLf & _
           "    SO_BROADCAST: " & CStr(GetSocketOption(socket, SOL_SOCKET, SO_BROADCAST)) & vbCrLf & _
           "    SO_USELOOPBACK: " & CStr(GetSocketOption(socket, SOL_SOCKET, SO_USELOOPBACK)) & vbCrLf & _
           "    SO_LINGER: " & CStr(GetSocketOption(socket, SOL_SOCKET, SO_LINGER)) & vbCrLf & _
           "    SO_OOBINLINE: " & CStr(GetSocketOption(socket, SOL_SOCKET, SO_OOBINLINE)) & vbCrLf & _
           "    SO_DONTLINGER: " & CStr(GetSocketOption(socket, SOL_SOCKET, SO_DONTLINGER)) & vbCrLf & _
           "    SO_EXCLUSIVEADDRUSE: " & CStr(GetSocketOption(socket, SOL_SOCKET, SO_EXCLUSIVEADDRUSE)) & vbCrLf & _
           "    SO_SNDBUF: " & CStr(GetSocketOption(socket, SOL_SOCKET, SO_SNDBUF)) & vbCrLf & _
           "    SO_RCVBUF: " & CStr(GetSocketOption(socket, SOL_SOCKET, SO_RCVBUF)) & vbCrLf & _
           "    SO_ERROR: " & CStr(GetSocketOption(socket, SOL_SOCKET, SO_ERROR)) & vbCrLf & _
           "    SO_TYPE: " & CStr(GetSocketOption(socket, SOL_SOCKET, SO_TYPE)) & vbCrLf & vbCrLf & _
           "TCP Options:" & vbCrLf & _
           "    TCP_NODELAY: " & CStr(GetSocketOption(socket, IPPROTO_TCP, TCP_NODELAY))
    End If
End Sub

Private Sub Command2_Click()
  Dim lResult As Long     ' Results of 1st option.
  Dim tout As TIMEOUT_STRUCT

  If (Winsock1.Protocol = sckTCPProtocol) Then
    tout.tv_sec = 10
    tout.tv_usec = 0

    lResult = setsockopt(Winsock1.SocketHandle, SOL_SOCKET, SO_SNDTIMEO, tout, LenB(tout))

    If (lResult = SOCKET_ERROR) Then
      MsgBox "Error setting SO_SNDTIMEO option: " & Translate_DLL_Error(Err.LastDllError)
    Else
      MsgBox "SO_SNDTIMEO option set."
    End If

  End If

End Sub

Public Function GetSocketOption(lSocket As Long, lLevel As Long, lOption As Long) As Long
  Dim lResult As Long       ' Result of API call.
  Dim lBuffer As Long       ' Buffer to get value into.
  Dim lBufferLen As Long    ' len of buffer.
  Dim linger As LINGER_STRUCT

  ' Linger requires a structure so we will get that option differently.
  If (lOption <> SO_LINGER) And (lOption <> SO_DONTLINGER) Then
    lBufferLen = LenB(lBuffer)
    lResult = getsockopt(lSocket, lLevel, lOption, lBuffer, lBufferLen)
  Else
    lBufferLen = LenB(linger)
    lResult = getsockopt(lSocket, lLevel, lOption, linger, lBufferLen)
    lBuffer = linger.l_onoff
  End If

  If (lResult = SOCKET_ERROR) Then
    GetSocketOption = Err.LastDllError
  Else
    GetSocketOption = lBuffer
  End If
End Function

Private Sub Form_Load()
  Winsock1.Bind 8377      ' Set up socket enough to get nonzero socket. handle
End Sub

您可以在 https://support.microsoft.com/en-us/kb/237688 找到原始文章