VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "CUDP"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Event NewData(Data() As Byte, ByVal Bytes As Long)
Event NullDataGram()

Private Const ChunkSize& = 6000

Public hSocket&
Private Addr&(3), mRemoteIP$, mRemotePort&
Private mReceive&, mCancelSend&, mRecvBufSize&, RecvBuf() As Byte

Public Property Get RecvBufSize() As Long
  RecvBufSize = mRecvBufSize
End Property
Public Property Let RecvBufSize(ByVal NewVal As Long)
  mRecvBufSize = NewVal
  If mRecvBufSize < 100 Then mRecvBufSize = 100
  If mRecvBufSize > 131072 Then mRecvBufSize = 131072
  ReDim Preserve RecvBuf(mRecvBufSize - 1)
End Property

Public Property Get RemoteIP() As String
  RemoteIP = mRemoteIP
End Property
Public Property Let RemoteIP(ByVal NewVal As String)
  mRemoteIP = NewVal
  Addr(1) = inet_addr(mRemoteIP)
  If hSocket = 0 Then hSocket = GetSocket
End Property

Public Property Get RemotePort() As Long
  RemotePort = mRemotePort
End Property
Public Property Let RemotePort(ByVal NewVal As Long)
  mRemotePort = NewVal: Addr(0) = 2
  RtlMoveMemory ByVal VarPtr(Addr(0)) + 3, mRemotePort And &HFF, 1
  RtlMoveMemory ByVal VarPtr(Addr(0)) + 2, mRemotePort \ 256, 1
  If hSocket = 0 Then hSocket = GetSocket
End Property

Public Property Get Receive() As Boolean
  Receive = mReceive
End Property
Public Property Let Receive(ByVal NewVal As Boolean)
  If NewVal And mReceive = 0 Then CallWithDelay Me
  mReceive = NewVal
End Property

Public Function Bind(ByVal IP$, ByVal Port&) As Boolean
Dim Addr&(3)
  Cleanup
  hSocket = GetSocket: If hSocket = -1 Then Cleanup: Exit Function
  mRemotePort = Port: Addr(0) = 2
  RtlMoveMemory ByVal VarPtr(Addr(0)) + 3, mRemotePort And &HFF, 1
  RtlMoveMemory ByVal VarPtr(Addr(0)) + 2, mRemotePort \ 256, 1
  Addr(1) = inet_addr(IP)
  If sBind(hSocket, Addr(0), 16) Then Cleanup: Exit Function
  Bind = True
End Function

Private Function GetSocket&()
Dim S&, BufSize&
BufSize = 120000
  If hSocket Then closesocket hSocket: hSocket = 0
  S = Socket(2, 2, 17)
  setsockopt S, 65535, SO_SNDBUF, BufSize, 4
  setsockopt S, 65535, SO_RCVBUF, BufSize, 4
  GetSocket = S
End Function

Public Sub SendNullDataGram()
  sendto hSocket, ByVal 0&, 0, 0, Addr(0), 16
End Sub

Public Function SendData(B() As Byte, ByVal TimeOutmSec#) As Long
Dim BOut&, Bytes&, Ret&, CC&, T#, TT#, UB&, sArr&(1), sTOut&(1), TMO&
  UB = UBound(B)
  T = HPTimer: TimeOutmSec = TimeOutmSec / 1000
  mCancelSend = 0
  Do
    sArr(0) = 1: sArr(1) = hSocket: sTOut(1) = 5000 'uSec Timeout
    Ret = WaitSelect(0, ByVal 0&, sArr(0), ByVal 0&, sTOut(0))
    If Ret > 0 Then 'send will not block
      BOut = UB + 1 - CC: If BOut > ChunkSize Then BOut = ChunkSize
      Bytes = sendto(hSocket, B(CC), BOut, 0, Addr(0), 16)
      If Bytes > 0 Then CC = CC + Bytes Else Exit Do
    End If
    TT = HPTimer
    TMO = (TT - T) > TimeOutmSec
    If CC <= UB Then Do: DoEvents: Loop Until HPTimer - TT > 0.001
  Loop Until CC > UB Or mCancelSend + TMO < 0
  SendData = CC
End Function

Public Sub WaitCallBack()
Dim I&, Ret&, Bytes&, sArr&(1), sTOut&(1)
  Do
    Do
      sArr(0) = 1: sArr(1) = hSocket: sTOut(1) = 2000 'uSec
      Ret = WaitSelect(0, sArr(0), ByVal 0&, ByVal 0&, sTOut(0))
      If Ret <= 0 Then Exit Do
      Bytes = recv(hSocket, RecvBuf(0), mRecvBufSize, 0)
      If Bytes = 0 Then RaiseEvent NullDataGram
      If Bytes > 0 Then RaiseEvent NewData(RecvBuf, Bytes)
    Loop
    DoEvents
  Loop Until mReceive = 0
End Sub

Public Function GetIP(ByVal sHostName$) As String
Dim I&, lpHost&, Host&(3), IP&, tmpIP(3) As Byte
  On Error Resume Next
  lpHost = gethostbyname(sHostName)
  If lpHost = 0 Then Exit Function
  RtlMoveMemory Host(0), ByVal lpHost, 16
  RtlMoveMemory IP, ByVal Host(3), 4
  RtlMoveMemory tmpIP(0), ByVal IP, 4
  For I = 0 To 3
    GetIP = GetIP & tmpIP(I) & IIf(I = 3, "", ".")
  Next
  Err.Clear
End Function

Private Sub Class_Initialize()
Dim W&(100)
  If WSAStartup(514, W(0)) Then WSAStartup 257, W(0)
  mRecvBufSize = 65536: ReDim RecvBuf(mRecvBufSize - 1)
End Sub

Private Sub Class_Terminate()
  Cleanup
  WSACleanup
End Sub

Public Sub Cleanup()
  If hSocket Then closesocket hSocket: hSocket = 0
  mReceive = 0: mCancelSend = True
End Sub

Public Sub CancelSend()
  mCancelSend = True
End Sub
