我的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
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
解决方案 »
- CreateFileMapping( ) 有限制大小 至少 要多少吗 ?
- 用picturebox预览access报表
- 请问怎样让光标自动定位?
- 请教关于DataGrid刷新的问题。
- 想在ACCESS数据库中的一个字段放置职员相片并使用DATE控件或DAO在窗体上浏览,请问字段设置成什么类型,VB相关代码如何编写?
- 小问题(在线等)
- shockwaveflash1.0控件怎样设置flash的播放速度
- 求代码例子,生成上下班记录
- 什么是句柄?有什么用?怎么用?
- 用VB如何实现探测OICQ用户的状态?(在线,离线,隐身)
- 百分求教小问题(资源文件和打包问题)
- 求助:关于文件浏览器,?? (初来乍到,请多多指教!!!)
==>
Dim buff(0 To MAX_PACK_LEN-1) As Byte
MEMCOPY NT(2000/XP)
在2000,XP下建议使用MEMCOPY,
Dim buff(0 To MAX_PACK_LEN) As Byte
==>
Dim buff(0 To MAX_PACK_LEN-1) As Byte
楼上的说的很好哦,指出鸟你的错误哦