Attribute VB_Name = "WinSockLib"
Option Explicit

'Winsock DLL imports

Public Declare Function bind Lib "wsock32.dll" (ByVal S As Long, addr As sockaddr, ByVal namelen As Long) As Long
Public Declare Function closesocket Lib "wsock32.dll" (ByVal S As Long) As Long
Public Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Integer
Public Declare Function inet_addr Lib "wsock32.dll" (ByVal CP As String) As Long
Public Declare Function recvfrom Lib "wsock32.dll" (ByVal S As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long, from As sockaddr, fromlen As Long) As Long
Public Declare Function sendto Lib "wsock32.dll" (ByVal S As Long, buf As Any, ByVal buflen As Long, ByVal flags As Long, to_addr As sockaddr, ByVal tolen As Long) As Long
Public Declare Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long
Public Declare Function gethostbyname Lib "wsock32.dll" (ByVal host_name As String) As Long
Public Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVR As Long, lpWSAD As WSAdata) As Long
Public Declare Function WSACleanup Lib "wsock32.dll" () As Long
Public Declare Function WSAAsyncSelect Lib "wsock32.dll" (ByVal S As Long, ByVal hWnd As Long, ByVal wMsg As Long, ByVal lEvent As Long) As Long

Public Enum FD
    FD_READ = 1
    FD_WRITE = 2
    FD_OOB = 4
    FD_ACCEPT = 8
    FD_CONNECT = 16
    FD_CLOSE = 32
    FD_SETSIZE = 64
End Enum
Global Const FD_ALL = 1 Or 2 Or 4 Or 8 Or 16 Or 32 Or 64

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 hostent As hostent

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 WSAdata As WSAdata

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

'API calls

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Public Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long

'Constants

Private Const GWL_WNDPROC = -4
Private OldWndProc      As Long

'SSL structures

Public Type SecureMessage
    Message             As String
    ResendCount         As Integer
End Type
Public Secures(1 To 20) As SecureMessage
Private I               As Integer

'Socket Data structures

Public Type SocketData
    Remote              As sockaddr
    SockID              As Long
End Type
Public UDPMySock        As SocketData

'Winsock window handle

Private WinsockHandle   As Long

'Socket status

Public Enum SERVER_FORMAT
    GameServer = 0
    DirectoryServer = 1
    BillingServer = 2
End Enum
Public SERVER_TYPE As SERVER_FORMAT

'Init/Destroy

Public Sub StartWinsock()
    WSAStartup 257, WSAdata
    WinsockHandle = CreateWindowEx(0, "#32770", "SSBot Winsock", 0&, 0, 0, 1, 1, 0&, 0&, App.hInstance, 0&)
    OldWndProc = SetWindowLong(WinsockHandle, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub EndWinsock()
    Call SetWindowLong(WinsockHandle, GWL_WNDPROC, OldWndProc)
    Call DestroyWindow(WinsockHandle)
    Call WSACleanup
End Sub

'Secure socket language

Public Sub AddSecure(Message As String)
    For I = 1 To 20
        If Secures(I).ResendCount = 0 Then
            Secures(I).Message = Message
            Secures(I).ResendCount = 1
            Exit Sub
        End If
    Next
End Sub

Public Sub ReceivedACK(ACKMessage As String)
    For I = 1 To 20
        If Mid(Secures(I).Message, 3, 2) = Mid(ACKMessage, 3, 2) Then
            Secures(I).ResendCount = 0
            Exit Sub
        End If
    Next
End Sub

Public Sub ResendMessages()
    For I = 1 To 20
        If Secures(I).ResendCount <> 0 Then
            UDPSendNE UDPMySock.Remote, Secures(I).Message

            Secures(I).ResendCount = Secures(I).ResendCount + 1
            If Secures(I).ResendCount > 5 Then Secures(I).ResendCount = 0
        End If
    Next
End Sub

Public Sub ClearSecures()
    For I = 1 To 20
        Secures(I).ResendCount = 0
    Next
End Sub

'UDP stuff

Private Sub UDPOnRecv(Sender As sockaddr, Message As String)
    If Left(Message, 2) = Chr(0) + Chr(3) Then UDPSendNE Sender, Chr(0) + Chr(4) + Mid(Message, 3, 4)
    If Left(Message, 2) = Chr(0) + Chr(4) Then ReceivedACK Message: Exit Sub

    'Call Decrypt(Message)

    Select Case SERVER_TYPE
        Case SERVER_FORMAT.GameServer: Call HandlePacket(Sender, Message)
        Case SERVER_FORMAT.DirectoryServer: Call HandleDServ(Sender, Message)
        Case SERVER_FORMAT.BillingServer 'Unhandled
    End Select
End Sub

Public Sub UDPSend(SockData As sockaddr, Message As String)
    'Call Encrypt(Message)
    Call sendto(UDPMySock.SockID, ByVal Message, Len(Message), 0, SockData, 16)
    If Asc(Mid(Message, 2, 1)) = 3 Then AddSecure Message
End Sub

Public Sub UDPSendNE(SockData As sockaddr, Message As String)
    Call sendto(UDPMySock.SockID, ByVal Message, Len(Message), 0, SockData, 16)
End Sub

Public Function UDPMakeSocket(Port As Integer) As SocketData
    Dim RetStruct As SocketData, S As Long

    S = socket(2, 2, 17)
        sockaddr.sin_family = 2
        sockaddr.sin_port = htons(Port)
        sockaddr.sin_addr = 0
    Call bind(S, sockaddr, 16)
        RetStruct.SockID = S
        RetStruct.Remote.sin_family = 2
    Call WSAAsyncSelect(S, WinsockHandle, 5150, FD_ALL)

    UDPMakeSocket = RetStruct
End Function

Public Function UDPRoute(Port As Integer, IP As String) As sockaddr
    sockaddr.sin_addr = IP2Long(IP)
    sockaddr.sin_family = 2
    sockaddr.sin_port = htons(Port)
    UDPRoute = sockaddr
End Function

Public Sub UDPDestroySocket(SockData As SocketData)
    Call WSAAsyncSelect(SockData.SockID, WinsockHandle, 0, 0)
    closesocket SockData.SockID
End Sub

'Winsock window callback

Private Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim mStr As String * 520, mLen As Integer

    Select Case uMsg
        Case 5150
            'If Connected = False Then MsgBox "packet ignored": Exit Function

            Select Case WSAGetSelectEvent(lParam)
                Case FD.FD_READ
                    mLen = recvfrom(wParam, ByVal mStr, 520, 0, sockaddr, 16)
                    If mLen > 0 Then UDPOnRecv sockaddr, Left(mStr, mLen)
                Case FD.FD_CONNECT
                Case FD.FD_CLOSE
                Case FD.FD_ACCEPT
            End Select
        Case Else
            WindowProc = CallWindowProc(OldWndProc, hWnd, uMsg, wParam, ByVal lParam)
    End Select
End Function

'Winsock utilities

Public Function WSAGetSelectEvent(ByVal lParam As Long) As Long
    WSAGetSelectEvent = Int(lParam Mod 65536)
End Function

Function Long2IP(Address As Long) As String
    Dim S As String * 4

    S = GetString(Address)
    Long2IP = CStr(Asc(Mid(S, 1, 1))) + "." + CStr(Asc(Mid(S, 2, 1))) + "." + CStr(Asc(Mid(S, 3, 1))) + "." + CStr(Asc(Mid(S, 4, 1)))
End Function

Public Function IP2Long(ByVal HostName As String) As Long
    Dim phe As Long, addrList As Long, retIP As Long

    retIP = inet_addr(HostName)
    If retIP = &HFFFF Then
        phe = gethostbyname(HostName)
        If phe <> 0 Then
            CopyMemory ByVal hostent, phe, 16
            CopyMemory ByVal addrList, hostent.h_addr_list, 4
            CopyMemory ByVal retIP, addrList, hostent.h_length
        Else
            retIP = &HFFFF
        End If
    End If

    IP2Long = retIP
End Function
