VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Arbiter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Ready As Boolean
Private sType As mSocketType
Private sBot As String
Private LastTransmission$
Public Sock As Long
Private msgRcvr&
Private OldWH As Long

Public Enum PuppetResult
    spOK
    spErrSockAllocate
    spErrSockSelect
    spErrBind
    spErrListen
End Enum

Private Type CreateSocketResult
    Sock As Long
    Result As PuppetResult
End Type

Private Sub Class_Initialize()
    Ready = False
End Sub

Private Sub Class_Terminate()
    If msgRcvr > 0 And OldWH > 0 Then _
        Call SetWindowLong(msgRcvr, GWL_WNDPROC, OldWH)
End Sub

Public Function Initialize(msgReciever As Long, Bot As String, SockType As mSocketType, _
    Optional ByVal SetNoDelay As Boolean = False) As Boolean
    Dim Result As CreateSocketResult
    Result = CreateSocket(msgReciever, Bot, SockType, SetNoDelay)
    If (Result.Result = PuppetResult.spOK) Then
        Initialize = True
        Ready = True
        sType = SockType
        sBot = Bot
        Sock = Result.Sock
        msgRcvr = msgReciever
    Else
        Initialize = False
    End If
End Function

Public Function Connect(Location As String, Port As Integer) As Boolean
    Connect = ConnectRaw(GetHostByNameAlias(Location), htons(Port))
End Function

Public Function ConnectRaw(IP As Long, Port As Integer) As Boolean
    Dim sockBuf As sockaddr, Host As HostEnt, RealError&
    sockBuf.sin_family = AF_INET
    sockBuf.sin_port = Port
    sockBuf.sin_addr = IP
    If (Winsock.Connect(Sock, sockBuf, Len(sockBuf)) = -1) Then
        RealError = WSAGetLastError()
        If (RealError <> WSAEWOULDBLOCK And RealError > 0) Then
            MsgBox "Socket Error " & RealError & ": " & GetWSAErrorString(RealError), vbExclamation, "Arbiter Network Class"
            ConnectRaw = False
        Else
            ConnectRaw = True
        End If
    Else
        ConnectRaw = True
    End If
End Function

Public Sub Disconnect()
    closesocket Sock
    'Call SetWindowLong(msgRcvr, GWL_WNDPROC, OldWH)
End Sub

Public Sub onDisconnect()
    Call SetWindowLong(msgRcvr, GWL_WNDPROC, OldWH)
    msgRcvr = 0
    OldWH = 0
End Sub

Public Function Send(Data As String, Optional PacketID As Byte, _
    Optional ByVal RawPacket As Boolean = False) As Boolean
    Dim sR&
    If RawPacket Then
        sR = SendData(Sock, Data)
    Else
        Select Case sType
            Case sBattleNet
                sR = SendData(Sock, Chr$(&HFF) & MakeByte(PacketID) & _
                    MakeWORD(Len(Data) + 4) & Data)
            Case sBNLS
                sR = SendData(Sock, MakeWORD(Len(Data) + 3) & MakeByte(PacketID) & Data)
            Case sMCP
                sR = SendData(Sock, MakeWORD(Len(Data) + 3) & MakeByte(PacketID) & Data)
            Case Else
                sR = SendData(Sock, Data)
        End Select
    End If
    
    If sR = SOCKET_ERROR Then
        Send = False
        BotEvent sBot, evError, "Send error: " & GetWSAErrorString(Err.LastDllError)
    ElseIf sR = 0 Then
        Send = False
    Else
        Send = True
    End If
End Function

Public Function ResendLast() As Boolean
    Dim sR&
    sR = SendData(Sock, LastTransmission)
    If sR = SOCKET_ERROR Then
        ResendLast = False
        BotEvent sBot, evError, "Send error: " & GetWSAErrorString(WSAGetLastError())
    Else
        ResendLast = True
    End If
End Function

Private Function CreateSocket(wh As Long, Bot As String, SockType As mSocketType, _
    Optional ByVal SetNoDelay As Boolean = False) As CreateSocketResult
    Dim socketBuffer As sockaddr, Host As HostEnt, RealError As Long, Sock As Long, ssor&
    Sock = Socket(AF_INET, SOCK_STREAM, 0)
    CreateSocket.Sock = Sock
    If Sock = -1 Then
        'MsgBox GetWSAErrorString(Err.LastDllError), vbExclamation, "Socket Allocation Error"
        CreateSocket.Result = spErrSockAllocate
    Else
        ReDim Preserve WindowMap(NextWindowMap) As whData
        With WindowMap(NextWindowMap)
            .Active = True
            .BotKey = Bot
            .SockType = SockType
            .WindowHandle = wh
        End With
        OldWH = GetWindowLong(wh, GWL_WNDPROC)
        NextWindowMap = NextWindowMap + 1
        Call SetWindowLong(wh, GWL_WNDPROC, AddressOf WindowProc)
        If (WSAAsyncSelect(Sock&, wh, ByVal WM_SOCKEVENT, ByVal FD_READ Or FD_CLOSE Or FD_CONNECT) = -1) Then
            CreateSocket.Result = spErrSockSelect
            Exit Function
        Else
            If SetNoDelay Then _
                Call setsockopt(Sock, IPPROTO_TCP, TCP_NODELAY, ssor, LenB(ssor))
            CreateSocket.Result = spOK
        End If
    End If
End Function

Private Function MakeByte(Data As Byte) As String
    Dim Result As String * 1
    CopyMemory ByVal Result, Data, 1
    MakeByte = Result
End Function

Private Function MakeWORD(Data As Integer) As String
    Dim Result As String * 2
    CopyMemory ByVal Result, Data, 2
    MakeWORD = Result
End Function
