想用VB6做一个UDP接收程序，可以接收局域网内所有终端向该程序指定端口发送的UDP数据。
目前使用下面的代码，遇到的问题是等待接收的时候，程序就会假死，无法进行任何其他操作。希望程序监听UDP数据的时候，可以正常处理其他请求。
在网上找到了用WINSOCK API实现同步非阻塞方式的网络通讯，但不知道如何改成我需要的。
请大家帮忙。
Attribute VB_Name = "modUDPRead"
Option Explicit
Private Const DEFAULT_QUEUE = 1024
Private Const DEFAULT_WAIT_TIME = 50
Private Const WSA_DescriptionLen = 256
Private Const WSA_DescriptionSize = WSA_DescriptionLen + 1
Private Const WSA_SYS_STATUS_LEN = 128
Private Const WSA_SysStatusSize = WSA_SYS_STATUS_LEN + 1
Private Const AF_INET = 2
Private Const SOCK_DGRAM = 2 'UDP
Private Const IPPROTO_UDP = 17 'UDP
Private Const INADDR_ANY As Long = &H0
Private Const IPPROTO_IP As Long = 0
Private Const IP_ADD_MEMBERSHIP As Long = 5
Private Const INADDR_NONE = &HFFFF
Private Const SOCKET_ERROR = -1
Private Type HostEnt
hName As Long
hAliases As Long
hAddrType As Integer
hLength As Integer
hAddrList As Long
End Type
Private Type SockAddr
Sin_Family As Integer
Sin_Port As Integer
Sin_Addr As Long
Sin_Zero(7) As Byte
End Type
Private Type WSADataType
wVersion As Integer
wHighVersion As Integer
szDescription As String * WSA_DescriptionSize
szSystemStatus As String * WSA_SysStatusSize
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type
Private Type IP_MREQ
imr_multiaddr As Long
imr_interface As Long
End Type
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Declare Function CloseSocket Lib "ws2_32.dll" Alias "closesocket" (ByVal hSocket As Long) As Long
Private Declare Function Connect Lib "ws2_32.dll" Alias "connect" (ByVal hSocket As Long, Addr As SockAddr, ByVal NameLen As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetHostByName Lib "ws2_32.dll" Alias "gethostbyname" (ByVal HostName As String) As Long
Private Declare Function Htons Lib "ws2_32.dll" Alias "htons" (ByVal HostShort As Integer) As Integer
Private Declare Function iNet_Addr Lib "wsock32.dll" Alias "inet_addr" (ByVal s As String) As Long
Private Declare Function Recv Lib "ws2_32.dll" Alias "recv" (ByVal hSocket As Long, Buf As Any, ByVal BufLen As Long, ByVal Flags As Long) As Long
Private Declare Function Send Lib "ws2_32.dll" Alias "send" (ByVal hSocket As Long, Buf As Any, ByVal BufLen As Long, ByVal Flags As Long) As Long
Private Declare Function Socket Lib "ws2_32.dll" Alias "socket" (ByVal af As Long, ByVal sType As Long, ByVal Protocol As Long) As Long
Private Declare Function WSACleanup Lib "ws2_32.dll" () As Long
Private Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVR As Long, lpWSAD As WSADataType) As Long
Private Declare Function bind Lib "wsock32.dll" (ByVal s As Long, Addr As SockAddr, ByVal NameLen As Long) As Long
Private Declare Function setsockopt Lib "wsock32.dll" (ByVal s As Long, ByVal level As Long, ByVal optname As Long, ByRef optval As Any, ByVal optlen As Long) As Long
Public Sub UDPClose(ByRef Handle As Long)
CloseSocket Handle
WSACleanup
Handle = -1
End Sub
Public Function UDPOpen(ByVal Host As String, Optional ByVal Port As Long = 502) As Long
Dim WSAData As WSADataType, SA As SockAddr, Result As Long, iResult As Long
If WSAStartup(&H202, WSAData) <> 0 Then
WSACleanup
Else
If (InStr(Host, ":") > 0) Then
If IsNumeric(Right(Host, Len(Host) - InStr(Host, ":"))) = True Then
Port = CLng(Right(Host, Len(Host) - InStr(Host, ":")))
End If
Host = Left(Host, InStr(Host, ":") - 1)
End If
Result = Socket(AF_INET, SOCK_DGRAM, IPPROTO_UDP)
Dim mreq As IP_MREQ
mreq.imr_multiaddr = iNet_Addr("224.0.0.1")
mreq.imr_interface = iNet_Addr(Host)
iResult = setsockopt(Result, IPPROTO_IP, IP_ADD_MEMBERSHIP, mreq, Len(mreq))
If iResult = -1 Then
CloseSocket Result
WSACleanup
Result = -1
End If
SA.Sin_Family = AF_INET
SA.Sin_Port = Htons(CInt("&H" & Hex(Port)))
SA.Sin_Addr = INADDR_ANY
iResult = bind(Result, SA, Len(SA))
If iResult = -1 Then
CloseSocket Result
WSACleanup
Result = -2
End If
End If
UDPOpen = Result
End Function
Public Function UDPReadByte(ByVal Handle As Long, Optional ByVal WaitTime As Long = DEFAULT_WAIT_TIME) As Byte()
Dim T As Double, Result() As Byte, I As Integer
If Handle = -1 Then Exit Function
ReDim Result(DEFAULT_QUEUE - 1)
If WaitTime > 0 Then
DoEvents
Sleep2 WaitTime
End If
I = Recv(Handle, Result(0), UBound(Result) + 1, 0)
If I > 0 Then
ReDim Preserve Result(I - 1)
UDPReadByte = Result
End If
End Function
Public Function UDPReadString(ByVal Handle As Long, Optional ByVal WaitTime As Long = DEFAULT_WAIT_TIME) As String
Dim Data() As Byte
Data = UDPReadByte(Handle, WaitTime)
UDPReadString = StrConv(Data, vbUnicode)
End Function
Public Function UDPReadHex(ByVal Handle As Long, Optional ByVal WaitTime As Long = DEFAULT_WAIT_TIME) As String
Dim Data() As Byte, Result As String, I As Long
Data = UDPReadByte(Handle, WaitTime)
For I = 0 To UBound(Data)
Result = Result & IIf(Data(I) < 16, "0", "") & UCase(Hex(Data(I)))
Next
UDPReadHex = Result
End Function
Public Function Sleep2(T As Long)
Dim Savetime As Long
Savetime = timeGetTime
While timeGetTime < Savetime + T
Call Sleep(1)
DoEvents
Wend
End Function
