winsock Verbindungsfunktion nur auf High-Speed-Verbindung funktioniert

Question

Ich winsock in meiner VB6-Anwendung, dies ist mein Code:

Private Sub Form_Load() 

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

Mein Problem ist, wenn ich eine Hochgeschwindigkeitsverbindung (4G) mit die Verbindung funktioniert gut, aber mit anderen Verbindungen wie (3G, weise ...) es gibt die folgende Meldung:

den Versuch timed

zu verbinden out

Ho W tue ich Abhilfe?

Answer 1

Es klingt wie Sie müssen ein längeres Verbindungstimeout festlegen. Es gibt keine Möglichkeit, dies direkt mit dem Steuerelement zu tun. Im Folgenden finden Sie eine modifizierte Probe aus einem zurückgezogenen KB-Artikel. Der Quellcode enthält nicht die Optionen SO_SNDTIMEO oder 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 

Sie können die Original-Artikel auf https://support.microsoft.com/en-us/kb/237688