我的XP SP2 在调用API函数时程序立刻就挂掉,如下面使用的代码,一到调用recv函数就出现死循环状态,只有关闭程序和VB。
Declare Function bind Lib "ws2_32.dll" (ByVal s As Long, addr As SOCK_ADDR, ByVal namelen As Long) As Long
Declare Function closesocket Lib "ws2_32.dll" (ByVal s As Long) As Long
Declare Function connect Lib "ws2_32.dll" (ByVal s As Long, Name As SOCK_ADDR, ByVal namelen As Integer) As Long
Declare Function inet_addr Lib "ws2_32.dll" (ByVal cp As String) As Long
Declare Function htons Lib "ws2_32.dll" (ByVal hostshort As Integer) As Integer
Declare Function recv Lib "ws2_32.dll" (ByVal s As Long, Buffer As Any, ByVal Length As Long, ByVal flags As Long) As Long
Declare Function send Lib "ws2_32.dll" (ByVal s As Long, Buffer As Any, ByVal Length As Long, ByVal flags As Long) As Long
Declare Function shutdown Lib "ws2_32.dll" (ByVal s As Long, ByVal how As Long) As Long
Declare Function ioctlsocket Lib "ws2_32.dll" (ByVal s As Long, ByVal v As Long, ut As Long) As Long
Declare Function socket Lib "ws2_32.dll" (ByVal af As Long, ByVal type_specification As Long, ByVal protocol As Long) As Long
Declare Function WSACancelBlockingCall Lib "ws2_32.dll" () As Long
Declare Function WSACleanup Lib "ws2_32.dll" () As Long
Declare Function WSAGetLastError Lib "ws2_32.dll" () As Long
Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequired As Integer, wsData As WSA_DATA) As Long
Declare Function WSASocketA Lib "ws2_32.dll" (ByVal af As Long, ByVal type1 As Long, ByVal protocol As Long, lpProtocolInfo As Long, g As Long, ByVal dwFlags As Long)
Declare Function WSAIoctl Lib "ws2_32.dll" (ByVal s As Long, ByVal dwIoControlCode As Long, lpvInBuffer As Long, ByVal cbInBuffer As Long, lpvOutBuffer As Long, ByVal cbOutBuffer As Long, lpcbBytesReturned As Long, lpOverlapped As Long, lpCompletionRoutine As Long) As Long
 Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)Public Const WSADescription_Len = 256
Public Const WSASYS_Status_Len = 128Type WSA_DATA
    wversion As Integer
    wHighVersion As Integer
    strDescription(WSADescription_Len + 1) As Byte
    strSystemStatus(WSASYS_Status_Len + 1) As Byte
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpVendorInfo As Long
End TypeType IN_ADDR
    S_addr As Long
End TypeType SOCK_ADDR
    sin_family As Integer
    sin_port As Integer
    sin_addr As IN_ADDR
    sin_zero(0 To 7) As Byte
End Type
Type IPHeader
    lenver As Byte
    tos As Byte
    len As Integer
    ident As Integer
    flags As Integer
    ttl As Byte
    proto As Byte
    checksum As Integer
    sourceIP As Long
    destIP As Long
End Type
    
Const AF_INET = 2
Const SOCK_RAW = 3
Const IPPROTO_IP = 0
Const IPPROTO_TCP = 6
Const IPPROTO_UDP = 17
Const MAX_PACK_LEN = 65535
Const SOCKET_ERROR = -1&
    
Private mwsaData As WSA_DATA
Private m_hSocket As Long
Private msaLocalAddr As SOCK_ADDRPrivate msaRemoteAddr As SOCK_ADDRConst WSANOERROR = 0
Const INVALID_SOCKET = -1
Dim blnStartFlag As Boolean
Dim blnLog As Boolean
Public Sub StartListen()
    
    Dim nResult As Long
    
    nResult = WSAStartup(&H202, mwsaData)
    If nResult <> WSANOERROR Then
      MsgBox "Error en WSAStartup"
      Exit Sub
    End If
    
    m_hSocket = socket(AF_INET, SOCK_RAW, IPPROTO_IP)
    If (m_hSocket = INVALID_SOCKET) Then
       MsgBox "Error in socket"
       Exit Sub
    End If
    
    
    msaLocalAddr.sin_family = AF_INET
    msaLocalAddr.sin_port = CLng(frmOpen2.txtPort.Text)
    msaLocalAddr.sin_addr.S_addr = inet_addr(frmOpen2.cob.Text)
    
    nResult = bind(m_hSocket, msaLocalAddr, Len(msaLocalAddr))
    If (nResult = SOCKET_ERROR) Then
       MsgBox "Error in bind"
       Exit Sub
    End If
    
    Dim InParamBuffer  As Long
    Dim BytesRet  As Long
    BytesRet = 0
    InParamBuffer = 1
    nResult = ioctlsocket(m_hSocket, &H98000001, 1)
    If nResult <> 0 Then
       MsgBox "ioctlsocket"
       Exit Sub
    End If
    
    
    Dim strData As String
    Dim nReceived As Long    
    
    
    Dim buff(0 To MAX_PACK_LEN) As Byte
    Dim IPH As IPHeader
    
    'Do Until False     
    Do While blnStartFlag = True
       DoEvents
       nResult = recv(m_hSocket, buff(0), MAX_PACK_LEN, 0)’这里出错
       If nResult = SOCKET_ERROR Then
           MsgBox "Error in RecvData::recv"
           Exit Do
       End If
       CopyMemory IPH, buff(0), Len(IPH) 
       Select Case IPH.proto
             Case IPPROTO_TCP
               'frmHookTcpip.Text1.SelText = HexIp2DotIp(IPH.sourceIP)
               'frmHookTcpip.Text1.SelText = "  ----->  "
               'frmHookTcpip.Text1.SelText = HexIp2DotIp(IPH.destIP)
               'frmHookTcpip.Text1.SelText = vbCrLf
               strData = HexIp2DotIp(IPH.sourceIP) & "  ----->  " & HexIp2DotIp(IPH.destIP)
               strData = strData & vbCrLf & "Checksum=" & IPH.checksum & ",Flags=" & IPH.flags & ",Ident=" & IPH.ident & _
                    ",Len=" & IPH.len & ",Lenver=" & IPH.lenver & ",Proto=" & IPH.proto & ",Tos=" & IPH.tos & ",ttl=" & IPH.ttl
               LogShow strData
       End Select
    Loop
    
    nResult = shutdown(m_hSocket, 2)
    nResult = closesocket(m_hSocket)
    nResult = WSACancelBlockingCall
    nResult = WSACleanup
    
End Sub
Function HexIp2DotIp(ByVal IP As Long) As String
    Dim s As String, p1 As String, p2 As String, p3 As String, p4 As String
    s = Right("00000000" & Hex(IP), 8)
    p1 = Val("&h" & Mid(s, 1, 2))
    p2 = Val("&h" & Mid(s, 3, 2))
    p3 = Val("&h" & Mid(s, 5, 2))
    p4 = Val("&h" & Mid(s, 7, 2))
    HexIp2DotIp = p4 & "." & p3 & "." & p2 & "." & p1
End FunctionPrivate Sub LogShow(str As String)
    
    frmOpen2.txt.Text = frmOpen2.txt.Text & "---------" & Now() & "---------" & vbCrLf & str & vbCrLf
    
End Sub
Public Sub StopListen() '''''''
    blnStartFlag = False
End Sub