【Excel VBA（2013 64bit版対応）】Winsockを利用したUDPクライアント、UDPサーバーサンプル

「VBA_Winsock_UDP.zip」をダウンロード

参考１　や　参考２　や　 参考３　を参考にさせていただきながら作成したサンプル

VBAではマルチスレッドができないので、クライアント用excelブック、サーバー用exceｌブックとファイル毎に機能を分けて（マルチプロセス）で実装した。

またサーバーは、データ待ちでExcelシートが固まってしまうのが嫌なのでノンブロッキングモードのSleepで、受信タイミングを制御している。

ソケットプログラミングはずいぶん久しぶりだったので、勘をとりもどすのに手間取ってしまった。といっても、VC++やGCCで何回もソケットをつかったサンプルやらツールやらを作っていた過去があるだけだから、VBA（VB）としては初だ。

久しぶりに苦労したけど楽しかったな。

クライアントのサンプル（UDPSendで送信する）

Option Explicit

Private previousToken As Integer
Public tokenCount As Integer
Private Const reSendLimit As Integer = 3
Private Const reqLength As Long = 500
Private isComplete As Boolean

Public Const SOCKET_ERROR As Long = -1
Public Const IPPROTO_IP As Long = 0
Public Const IPPROTO_UDP As Long = 17
Public Const IP_ADD_MEMBERSHIP As Long = 12
Public Const IP_DROP_MEMBERSHIP As Long = 13
Public Const AF_INET = 2
Public Const SOCK_DGRAM = 2
Public Const FD_SETSIZE = 64
‘ Public Const FIONBIO = 2147772030#
Public Const SOCKADDR_SIZE = 16
Public Const SOCKADDR_IN_SIZE = 16
Public Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Public Const WS_VERSION_REQD As Long = &H101
Public Const IP_SUCCESS As Long = 0

Public Type WSAData
    wVersion As Integer
    wHighVersion As Integer
    szDescription As String * 257
    szSystemStatus As String * 129
    iMaxSockets As Integer
    iMaxUDPDG As Integer
    lpVendorInfo As Long
End Type

Public Type Hostent
     h_name As Long
     h_aliases As Long
     h_addrtype As Integer
     h_length As Integer
     h_addr_list As Long
End Type

Public Type SOCKADDR
    sin_family As Integer
    sin_zero As String * 14
End Type

Public Type SOCKADDR_IN
    sin_family As Integer
    sin_port As Integer
    sin_addr As Long
    sin_zero As String * 8
End Type

Public Type fd_set
    fd_count As LongPtr
    fd_array(FD_SETSIZE) As Long
End Type

Public Type timeval
    tv_sec As Long
    tv_usec As Long
End Type

Public Type ip_mreq
     imr_multiaddr As Long
     imr_interface As Long
End Type

Public ip As String
Public remotePort As Integer
Public listenPort As Integer
Public localHostName As String
Public localHostIP As String
Public remoteAddr As SOCKADDR_IN
Public recvBuffer As String * 2048
Public fromAddr As SOCKADDR_IN
Public fromAddrSize As Long

Public SendSocketHandle As Long
Public ListenSocketHandle As Long
Public Joined As Boolean

Public Declare PtrSafe Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired&, lpWSADATA As WSAData) As Long
Public Declare PtrSafe Function WSACleanup Lib "wsock32.dll" () As Long
Public Declare PtrSafe Function gethostbyname Lib "wsock32.dll" (ByVal host_name As String) As Long
Public Declare PtrSafe Function gethostname Lib "wsock32.dll" (ByVal host_name As String, ByVal namelen As Integer) As Integer
Public Declare PtrSafe Function setsockopt Lib "wsock32.dll" (ByVal s As LongPtr, ByVal level As LongPtr, ByVal optname As LongPtr, optval As Any, ByVal optlen As LongPtr) As Long
Public Declare PtrSafe Function w_socket Lib "wsock32.dll" Alias "socket" (ByVal lngAf As LongPtr, ByVal lngType As LongPtr, ByVal lngProtocol As LongPtr) As Long
Public Declare PtrSafe Function w_closesocket Lib "wsock32.dll" Alias "closesocket" (ByVal socketHandle As LongPtr) As Long
Public Declare PtrSafe Function w_bind Lib "wsock32.dll" Alias "bind" (ByVal SOCKET As LongPtr, Name As SOCKADDR_IN, ByVal namelen As LongPtr) As Long
Public Declare PtrSafe Function w_connect Lib "wsock32.dll" Alias "connect" (ByVal SOCKET As LongPtr, Name As SOCKADDR_IN, ByVal namelen As LongPtr) As Long
Public Declare PtrSafe Function w_send Lib "wsock32.dll" Alias "send" (ByVal SOCKET As LongPtr, buf As Any, ByVal length As LongPtr, ByVal Flags As LongPtr) As Long
Public Declare PtrSafe Function w_sendTo Lib "wsock32.dll" Alias "sendto" (ByVal SOCKET As LongPtr, buf As Any, ByVal length As LongPtr, ByVal Flags As LongPtr, remoteAddr As SOCKADDR_IN, ByVal remoteAddrSize As LongPtr) As Long
Public Declare PtrSafe Function w_recv Lib "wsock32.dll" Alias "recv" (ByVal SOCKET As LongPtr, buf As Any, ByVal length As LongPtr, ByVal Flags As LongPtr) As Long
Public Declare PtrSafe Function w_recvFrom Lib "wsock32.dll" Alias "recvfrom" (ByVal SOCKET As LongPtr, buf As Any, ByVal length As LongPtr, ByVal Flags As Long, fromAddr As SOCKADDR_IN, fromAddrSize As Long) As Long
Public Declare PtrSafe Function w_select Lib "wsock32.dll" Alias "select" (ByVal nfds As Long, readFds As fd_set, writeFds As fd_set, exceptFds As fd_set, timeout As timeval) As Long
Public Declare PtrSafe Function w_getLastError Lib "wsock32.dll" Alias "WSAGetLastError" () As Integer
Public Declare PtrSafe Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Long
Public Declare PtrSafe Function ntohl Lib "wsock32.dll" (ByVal netlong As Long) As Long
Public Declare PtrSafe Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long
Public Declare PtrSafe Function ioctlsocket Lib "wsock32.dll" (ByVal s As Long, ByVal cmd As Long, argp As Long) As Long
Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Public Declare PtrSafe Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal Buffer As String, Size As Long) As Long
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

‘—ioctl Constants
‘Public Const FIONREAD = &H8004667F
Public Const FIONBIO = &H8004667E
‘Public Const FIOASYNC = &H8004667D

‘—async notification constants
Public Const FD_ACCEPT = &H8&
Public Const FD_CLOSE = &H20&
Public Const FD_CONNECT = &H10&
Public Const FD_READ = &H1&
Public Const FD_WRITE = &H2&

Private Const WSAEINTR = 10004
Private Const WSAEACCES = 10013
Private Const WSAEFAULT = 10014
Private Const WSAEINVAL = 10022
Private Const WSAEMFILE = 10024
Private Const WSAEWOULDBLOCK = 10035
Private Const WSAEINPROGRESS = 10036
Private Const WSAEALREADY = 10037
Private Const WSAENOTSOCK = 10038
Private Const WSAEDESTADDRREQ = 10039
Private Const WSAEMSGSIZE = 10040
Private Const WSAEPROTOTYPE = 10041
Private Const WSAENOPROTOOPT = 10042
Private Const WSAEPROTONOSUPPORT = 10043
Private Const WSAESOCKTNOSUPPORT = 10044
Private Const WSAEOPNOTSUPP = 10045
Private Const WSAEPFNOSUPPORT = 10046
Private Const WSAEAFNOSUPPORT = 10047
Private Const WSAEADDRINUSE = 10048
Private Const WSAEADDRNOTAVAIL = 10049
Private Const WSAENETDOWN = 10050
Private Const WSAENETUNREACH = 10051
Private Const WSAENETRESET = 10052
Private Const WSAECONNABORTED = 10053
Private Const WSAECONNRESET = 10054
Private Const WSAENOBUFS = 10055
Private Const WSAEISCONN = 10056
Private Const WSAENOTCONN = 10057
Private Const WSAESHUTDOWN = 10058
Private Const WSAETOOMANYREFS = 10059
Private Const WSAETIMEDOUT = 10060
Private Const WSAECONNREFUSED = 10061
Private Const WSAEHOSTDOWN = 10064
Private Const WSAEHOSTUNREACH = 10065
Private Const WSAEPROCLIM = 10067

Public Function SocketsInitialize() As Boolean
     Dim WSAD As WSAData
     SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
End Function

Private Sub SocketsCleanup()
     w_closesocket (ListenSocketHandle)
     w_closesocket (SendSocketHandle)
     If WSACleanup() <> 0 Then
         MsgBox "Windows Sockets error occurred in Cleanup.", vbExclamation
     End If
End Sub

Sub UDPSend()

  ‘  SocketsCleanup
     If (Not SocketsInitialize()) Then
         MsgBox "Error initializing WinSock"
         Return
     End If

     SendSocketHandle = w_socket(AF_INET, SOCK_DGRAM, IPPROTO_UDP)

     Dim ip As String: ip = "127.0.0.1"
     Dim remotePort As Long: remotePort = 65501
    
    remoteAddr.sin_family = AF_INET
    remoteAddr.sin_addr = inet_addr(ip)
    remoteAddr.sin_port = UnsignedLongToInteger(htons(remotePort))
    
    Dim strbuffer As String: strbuffer = "test"
    If strbuffer <> "" Then
‘         sendResult = w_sendTo(SendSocketHandle, ByVal strbuffer, Len(strbuffer), 0, remoteAddr, SOCKADDR_IN_SIZE)
        Debug.Print w_sendTo(SendSocketHandle, ByVal strbuffer, Len(strbuffer), 0, remoteAddr, SOCKADDR_IN_SIZE)
    End If
   
    SocketsCleanup

End Sub

Private Function GetPcName() As String
     Dim strBuf As String * 16, strPcName As String, lngPc As Long
     lngPc = GetComputerName(strBuf, Len(strBuf))
     If lngPc <> 0 Then
         strPcName = Left(strBuf, InStr(strBuf, vbNullChar) – 1)
         GetPcName = strPcName
     Else
         GetPcName = vbNullString
     End If
End Function

Private Function GetIPFromHostName(ByVal sHostName As String) As String
     ‘converts a host name to an IP address.
     Dim nbytes As Long
     Dim ptrHosent As Long ‘address of hostent structure
     Dim ptrName As Long ‘address of name pointer
     Dim ptrAddress As Long ‘address of address pointer
     Dim ptrIPAddress As Long
     Dim sAddress As String
     sAddress = Space$(4)
     ptrHosent = gethostbyname(sHostName & vbNullChar)
     If ptrHosent <> 0 Then
     ptrName = ptrHosent
     ptrAddress = ptrHosent + 12
     ‘get the IP address
     CopyMemory ptrName, ByVal ptrName, 4
     CopyMemory ptrAddress, ByVal ptrAddress, 4
     CopyMemory ptrIPAddress, ByVal ptrAddress, 4
     CopyMemory ByVal sAddress, ByVal ptrIPAddress, 4
     GetIPFromHostName = IPToText(sAddress)
     End If
End Function

Private Function IPToText(ByVal IPAddress As String) As String
     IPToText = CStr(Asc(IPAddress)) & "." & _
      CStr(Asc(Mid$(IPAddress, 2, 1))) & "." & _
      CStr(Asc(Mid$(IPAddress, 3, 1))) & "." & _
      CStr(Asc(Mid$(IPAddress, 4, 1)))
End Function

Private Function UnsignedLongToInteger_mine(uLong As Long) As Integer
     If uLong > 32767 Then
         UnsignedLongToInteger_mine = uLong – 65536
     Else
         UnsignedLongToInteger_mine = uLong
     End If
End Function

Private Function UnsignedLongToInteger(uLong As Long) As Integer
     If uLong > 32767 Then
         UnsignedLongToInteger = uLong – 65536
     Else
         UnsignedLongToInteger = uLong
     End If
End Function

Private Function recvfromTimeOutUDP(socketHandle As Long, sec As Long, usec As Long) As Integer
     ‘Setup timeval variable
     Dim timeout As timeval
     Dim readFds As fd_set
     Dim writeFds As fd_set
     Dim exceptFds As fd_set

    timeout.tv_sec = sec
     timeout.tv_usec = usec

    ‘Setup fd_set structure
     readFds.fd_array(0) = socketHandle
     readFds.fd_count = 1
     writeFds.fd_count = 0
     exceptFds.fd_count = 0

    ‘Return value:
     ‘-1: error occurred
     ‘0: timed out
     ‘> 0: data ready to be read
     recvfromTimeOutUDP = w_select(0, readFds, writeFds, exceptFds, timeout)
    
End Function

Private Function Dotted2LongIP(DottedIP As String) As Variant
     ‘ errors will result in a zero value
     On Error Resume Next

    Dim i As Byte, pos As Integer
     Dim PrevPos As Integer, num As Integer

    ‘ string cruncher
     For i = 1 To 4
         ‘ Parse the position of the dot
         pos = InStr(PrevPos + 1, DottedIP, ".", 1)

        ‘ If its past the 4th dot then set pos to the last
         ‘position + 1

        If i = 4 Then pos = Len(DottedIP) + 1

       ‘ Parse the number from between the dots

        num = Int(Mid(DottedIP, PrevPos + 1, pos – PrevPos – 1))

        ‘ Set the previous dot position
         PrevPos = pos

        ‘ No dot value should ever be larger than 255
         ‘ Technically it is allowed to be over 255 -it just
         ‘ rolls over e.g.
          ‘256 => 0 -note the (4 – i) that’s the
          ‘proper exponent for this calculation

       Dotted2LongIP = ((num Mod 256) * (256 ^ (4 – i))) + _
          Dotted2LongIP

    Next

End Function

‘ convert long IP to dotted notation

Private Function LongIP2Dotted(ByVal LongIP As Variant) As String

    On Error GoTo ExitFun

    If LongIP = "" Or LongIP < 0 Then Err.Raise vbObjectError + 1

    Dim i As Integer, num As Currency

    ‘ big number cruncher
     For i = 1 To 4
         ‘ break off individual dot values – math out the wazoo
         num = Int(LongIP / 256 ^ (4 – i))

        ‘ sets up the value for the next calculation
         LongIP = LongIP – (num * 256 ^ (4 – i))

        ‘ a generic error to flag the exception handler –
         ‘no dot value should ever be larger than 255
         ‘ technically it is allowed to be over 255
         ‘ but it’s not possible from this calculation so
         ‘raise an error
         If num > 255 Then Err.Raise vbObjectError + 1

        ‘ string builder
         If i = 1 Then
             ‘ 1st dot value has no leading dot
             LongIP2Dotted = num
         Else
             ‘ other dot values have a leading dot
             LongIP2Dotted = num & "." & LongIP2Dotted
         End If
     Next

Exit Function
ExitFun:
      LongIP2Dotted = "0.0.0.0" ‘"Invalid Input" ‘ whatever
End Function

Public Function XORDecryption(ByRef a As Variant, ByRef b As Variant) As Variant
    XORDecryption = b
End Function

Public Function XOREncryption(ByRef a As Variant, ByRef b As Variant) As Variant
   ‘ Dim a As String
   
   
    XOREncryption = b

‘Dim i, a As Integer
‘
‘For i = 1 To Len(Text)
‘
‘a = i Mod Len(Key)
‘
‘If a = 0 Then a = Len(Key)
‘
”Transform = Transform & Chr(Asc(Mid(Key, a, 1)) Xor Asc(Mid(Text, i, 1)))

‘Next i

End Function

‘サーバのサンプル（UDPRecv）

Option Explicit

Private previousToken As Integer
Public tokenCount As Integer
Private Const reSendLimit As Integer = 3
Private Const reqLength As Long = 500
Private isComplete As Boolean

Public Const SOCKET_ERROR As Long = -1
Public Const IPPROTO_IP As Long = 0
Public Const IPPROTO_UDP As Long = 17
Public Const IP_ADD_MEMBERSHIP As Long = 12
Public Const IP_DROP_MEMBERSHIP As Long = 13
Public Const AF_INET = 2
Public Const SOCK_DGRAM = 2
Public Const FD_SETSIZE = 64
‘ Public Const FIONBIO = 2147772030#
Public Const SOCKADDR_SIZE = 16
Public Const SOCKADDR_IN_SIZE = 16
Public Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Public Const WS_VERSION_REQD As Long = &H101
Public Const IP_SUCCESS As Long = 0

Public Type WSAData
    wVersion As Integer
    wHighVersion As Integer
    szDescription As String * 257
    szSystemStatus As String * 129
    iMaxSockets As Integer
    iMaxUDPDG As Integer
    lpVendorInfo As Long
End Type

Public Type Hostent
     h_name As Long
     h_aliases As Long
     h_addrtype As Integer
     h_length As Integer
     h_addr_list As Long
End Type

Public Type SOCKADDR
    sin_family As Integer
    sin_zero As String * 14
End Type

Public Type SOCKADDR_IN
    sin_family As Integer
    sin_port As Integer
    sin_addr As Long
    sin_zero As String * 8
End Type

Public Type fd_set
    fd_count As LongPtr
    fd_array(FD_SETSIZE) As Long
End Type

Public Type timeval
    tv_sec As Long
    tv_usec As Long
End Type

Public Type ip_mreq
     imr_multiaddr As Long
     imr_interface As Long
End Type

Public ip As String
Public remotePort As Integer
Public listenPort As Integer
Public localHostName As String
Public localHostIP As String
Public remoteAddr As SOCKADDR_IN
Public recvBuffer As String * 2048
Public fromAddr As SOCKADDR_IN
Public fromAddrSize As Long

Public SendSocketHandle As Long
Public ListenSocketHandle As Long
Public Joined As Boolean

Public Declare PtrSafe Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired&, lpWSADATA As WSAData) As Long
Public Declare PtrSafe Function WSACleanup Lib "wsock32.dll" () As Long
Public Declare PtrSafe Function gethostbyname Lib "wsock32.dll" (ByVal host_name As String) As Long
Public Declare PtrSafe Function gethostname Lib "wsock32.dll" (ByVal host_name As String, ByVal namelen As Integer) As Integer
Public Declare PtrSafe Function setsockopt Lib "wsock32.dll" (ByVal s As LongPtr, ByVal level As LongPtr, ByVal optname As LongPtr, optval As Any, ByVal optlen As LongPtr) As Long
Public Declare PtrSafe Function w_socket Lib "wsock32.dll" Alias "socket" (ByVal lngAf As LongPtr, ByVal lngType As LongPtr, ByVal lngProtocol As LongPtr) As Long
Public Declare PtrSafe Function w_closesocket Lib "wsock32.dll" Alias "closesocket" (ByVal socketHandle As LongPtr) As Long
Public Declare PtrSafe Function w_bind Lib "wsock32.dll" Alias "bind" (ByVal SOCKET As LongPtr, Name As SOCKADDR_IN, ByVal namelen As LongPtr) As Long
Public Declare PtrSafe Function w_connect Lib "wsock32.dll" Alias "connect" (ByVal SOCKET As LongPtr, Name As SOCKADDR_IN, ByVal namelen As LongPtr) As Long
Public Declare PtrSafe Function w_send Lib "wsock32.dll" Alias "send" (ByVal SOCKET As LongPtr, buf As Any, ByVal length As LongPtr, ByVal Flags As LongPtr) As Long
Public Declare PtrSafe Function w_sendTo Lib "wsock32.dll" Alias "sendto" (ByVal SOCKET As LongPtr, buf As Any, ByVal length As LongPtr, ByVal Flags As LongPtr, remoteAddr As SOCKADDR_IN, ByVal remoteAddrSize As LongPtr) As Long
Public Declare PtrSafe Function w_recv Lib "wsock32.dll" Alias "recv" (ByVal SOCKET As LongPtr, buf As Any, ByVal length As LongPtr, ByVal Flags As LongPtr) As Long
Public Declare PtrSafe Function w_recvFrom Lib "wsock32.dll" Alias "recvfrom" (ByVal SOCKET As LongPtr, buf As Any, ByVal length As LongPtr, ByVal Flags As Long, fromAddr As SOCKADDR_IN, fromAddrSize As Long) As Long
Public Declare PtrSafe Function w_select Lib "wsock32.dll" Alias "select" (ByVal nfds As Long, readFds As fd_set, writeFds As fd_set, exceptFds As fd_set, timeout As timeval) As Long
Public Declare PtrSafe Function w_getLastError Lib "wsock32.dll" Alias "WSAGetLastError" () As Integer
Public Declare PtrSafe Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Long
Public Declare PtrSafe Function ntohl Lib "wsock32.dll" (ByVal netlong As Long) As Long
Public Declare PtrSafe Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long
Public Declare PtrSafe Function ioctlsocket Lib "wsock32.dll" (ByVal s As Long, ByVal cmd As Long, argp As Long) As Long
Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Public Declare PtrSafe Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal Buffer As String, Size As Long) As Long
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

‘—ioctl Constants
‘Public Const FIONREAD = &H8004667F
Public Const FIONBIO = &H8004667E
‘Public Const FIOASYNC = &H8004667D

‘—async notification constants
Public Const FD_ACCEPT = &H8&
Public Const FD_CLOSE = &H20&
Public Const FD_CONNECT = &H10&
Public Const FD_READ = &H1&
Public Const FD_WRITE = &H2&

Private Const WSAEINTR = 10004
Private Const WSAEACCES = 10013
Private Const WSAEFAULT = 10014
Private Const WSAEINVAL = 10022
Private Const WSAEMFILE = 10024
Private Const WSAEWOULDBLOCK = 10035
Private Const WSAEINPROGRESS = 10036
Private Const WSAEALREADY = 10037
Private Const WSAENOTSOCK = 10038
Private Const WSAEDESTADDRREQ = 10039
Private Const WSAEMSGSIZE = 10040
Private Const WSAEPROTOTYPE = 10041
Private Const WSAENOPROTOOPT = 10042
Private Const WSAEPROTONOSUPPORT = 10043
Private Const WSAESOCKTNOSUPPORT = 10044
Private Const WSAEOPNOTSUPP = 10045
Private Const WSAEPFNOSUPPORT = 10046
Private Const WSAEAFNOSUPPORT = 10047
Private Const WSAEADDRINUSE = 10048
Private Const WSAEADDRNOTAVAIL = 10049
Private Const WSAENETDOWN = 10050
Private Const WSAENETUNREACH = 10051
Private Const WSAENETRESET = 10052
Private Const WSAECONNABORTED = 10053
Private Const WSAECONNRESET = 10054
Private Const WSAENOBUFS = 10055
Private Const WSAEISCONN = 10056
Private Const WSAENOTCONN = 10057
Private Const WSAESHUTDOWN = 10058
Private Const WSAETOOMANYREFS = 10059
Private Const WSAETIMEDOUT = 10060
Private Const WSAECONNREFUSED = 10061
Private Const WSAEHOSTDOWN = 10064
Private Const WSAEHOSTUNREACH = 10065
Private Const WSAEPROCLIM = 10067

Public Function SocketsInitialize() As Boolean
     Dim WSAD As WSAData
     SocketsInitialize = WSAStartup(WS_VERSION_REQD, WSAD) = IP_SUCCESS
End Function

Private Sub SocketsCleanup()
     w_closesocket (ListenSocketHandle)
     w_closesocket (SendSocketHandle)
     If WSACleanup() <> 0 Then
         MsgBox "Windows Sockets error occurred in Cleanup.", vbExclamation
     End If
End Sub

Sub UDPRecv()
    Dim ip As String: ip = "127.0.0.1"
    Dim listenPort As Long: listenPort = 65500
    Dim remotePort As Long: remotePort = 65501
      
     ‘FinalizeSilverlightConnection
     If (Not SocketsInitialize()) Then
         MsgBox "Error initializing WinSock"
         Return
     End If
     ListenSocketHandle = w_socket(AF_INET, SOCK_DGRAM, IPPROTO_UDP)
    
     remoteAddr.sin_family = AF_INET
     remoteAddr.sin_addr = inet_addr(ip)
     remoteAddr.sin_port = UnsignedLongToInteger(htons(remotePort))
         
     Dim bindResult As Long
     bindResult = w_bind(ListenSocketHandle, remoteAddr, SOCKADDR_IN_SIZE)
     If bindResult = SOCKET_ERROR Then
         MsgBox "Error binding listener socket: " & CStr(Err.LastDllError)
         GoTo EXIT_POINT
‘         Call SocketsCleanup
‘         Return
     End If
       
     Dim recvresult As Long
    
     ‘ioctlsocket
     Dim lngRet As Long
     Dim Enabled As Long: Enabled = 1
     lngRet = ioctlsocket(ListenSocketHandle, FIONBIO, Enabled)
     If lngRet = SOCKET_ERROR Then
        MsgBox "Error nonblocking mode Setting"
        GoTo EXIT_POINT
    End If
    
    Do While True
        DoEvents
        Sleep 1000
        recvresult = w_recvFrom(ListenSocketHandle, ByVal recvBuffer, Len(recvBuffer), 0, remoteAddr, SOCKADDR_IN_SIZE)
        If (recvresult > 0) Then
            MsgBox "サーバー受信成功:" & recvBuffer
            Exit Do ‘受信成功したらループを抜ける
        ElseIf recvresult = SOCKET_ERROR Then ‘ノンンブロッキングもの以外のエラーはループを抜ける。
            If Not Err.LastDllError = WSAEWOULDBLOCK Then
                GoTo EXIT_POINT:
            End If
        End If
    Loop
    
EXIT_POINT:
     SocketsCleanup
End Sub

Private Function GetPcName() As String
     Dim strBuf As String * 16, strPcName As String, lngPc As Long
     lngPc = GetComputerName(strBuf, Len(strBuf))
     If lngPc <> 0 Then
         strPcName = Left(strBuf, InStr(strBuf, vbNullChar) – 1)
         GetPcName = strPcName
     Else
         GetPcName = vbNullString
     End If
End Function

Private Function GetIPFromHostName(ByVal sHostName As String) As String
     ‘converts a host name to an IP address.
     Dim nbytes As Long
     Dim ptrHosent As Long ‘address of hostent structure
     Dim ptrName As Long ‘address of name pointer
     Dim ptrAddress As Long ‘address of address pointer
     Dim ptrIPAddress As Long
     Dim sAddress As String
     sAddress = Space$(4)
     ptrHosent = gethostbyname(sHostName & vbNullChar)
     If ptrHosent <> 0 Then
     ptrName = ptrHosent
     ptrAddress = ptrHosent + 12
     ‘get the IP address
     CopyMemory ptrName, ByVal ptrName, 4
     CopyMemory ptrAddress, ByVal ptrAddress, 4
     CopyMemory ptrIPAddress, ByVal ptrAddress, 4
     CopyMemory ByVal sAddress, ByVal ptrIPAddress, 4
     GetIPFromHostName = IPToText(sAddress)
     End If
End Function

Private Function IPToText(ByVal IPAddress As String) As String
     IPToText = CStr(Asc(IPAddress)) & "." & _
      CStr(Asc(Mid$(IPAddress, 2, 1))) & "." & _
      CStr(Asc(Mid$(IPAddress, 3, 1))) & "." & _
      CStr(Asc(Mid$(IPAddress, 4, 1)))
End Function

Private Function UnsignedLongToInteger_mine(uLong As Long) As Integer
     If uLong > 32767 Then
         UnsignedLongToInteger_mine = uLong – 65536
     Else
         UnsignedLongToInteger_mine = uLong
     End If
End Function

Private Function UnsignedLongToInteger(uLong As Long) As Integer
     If uLong > 32767 Then
         UnsignedLongToInteger = uLong – 65536
     Else
         UnsignedLongToInteger = uLong
     End If
End Function

Private Function recvfromTimeOutUDP(socketHandle As Long, sec As Long, usec As Long) As Integer
     ‘Setup timeval variable
     Dim timeout As timeval
     Dim readFds As fd_set
     Dim writeFds As fd_set
     Dim exceptFds As fd_set

    timeout.tv_sec = sec
     timeout.tv_usec = usec

    ‘Setup fd_set structure
     readFds.fd_array(0) = socketHandle
     readFds.fd_count = 1
     writeFds.fd_count = 0
     exceptFds.fd_count = 0

    ‘Return value:
     ‘-1: error occurred
     ‘0: timed out
     ‘> 0: data ready to be read
     recvfromTimeOutUDP = w_select(0, readFds, writeFds, exceptFds, timeout)
    
End Function

Private Function Dotted2LongIP(DottedIP As String) As Variant
     ‘ errors will result in a zero value
     On Error Resume Next

    Dim i As Byte, pos As Integer
     Dim PrevPos As Integer, num As Integer

    ‘ string cruncher
     For i = 1 To 4
         ‘ Parse the position of the dot
         pos = InStr(PrevPos + 1, DottedIP, ".", 1)

        ‘ If its past the 4th dot then set pos to the last
         ‘position + 1

        If i = 4 Then pos = Len(DottedIP) + 1

       ‘ Parse the number from between the dots

        num = Int(Mid(DottedIP, PrevPos + 1, pos – PrevPos – 1))

        ‘ Set the previous dot position
         PrevPos = pos

        ‘ No dot value should ever be larger than 255
         ‘ Technically it is allowed to be over 255 -it just
         ‘ rolls over e.g.
          ‘256 => 0 -note the (4 – i) that’s the
          ‘proper exponent for this calculation

       Dotted2LongIP = ((num Mod 256) * (256 ^ (4 – i))) + _
          Dotted2LongIP

    Next

End Function

‘ convert long IP to dotted notation

Private Function LongIP2Dotted(ByVal LongIP As Variant) As String

    On Error GoTo ExitFun

    If LongIP = "" Or LongIP < 0 Then Err.Raise vbObjectError + 1

    Dim i As Integer, num As Currency

    ‘ big number cruncher
     For i = 1 To 4
         ‘ break off individual dot values – math out the wazoo
         num = Int(LongIP / 256 ^ (4 – i))

        ‘ sets up the value for the next calculation
         LongIP = LongIP – (num * 256 ^ (4 – i))

        ‘ a generic error to flag the exception handler –
         ‘no dot value should ever be larger than 255
         ‘ technically it is allowed to be over 255
         ‘ but it’s not possible from this calculation so
         ‘raise an error
         If num > 255 Then Err.Raise vbObjectError + 1

        ‘ string builder
         If i = 1 Then
             ‘ 1st dot value has no leading dot
             LongIP2Dotted = num
         Else
             ‘ other dot values have a leading dot
             LongIP2Dotted = num & "." & LongIP2Dotted
         End If
     Next

Exit Function
ExitFun:
      LongIP2Dotted = "0.0.0.0" ‘"Invalid Input" ‘ whatever
End Function