Attribute VB_Name = "modGameSpy"
'+----------------------------------------------------------------------------
'| GameSpy VB6 Masterserver Functions v1.1
'|
'| Written by:
'|  Thomas Reiser alias FiRe^
'|  <www.mg34.net/code - fire_1@gmx.de>
'|
'| Orginal code by:
'|  Luigi Auriemma
'|  <aluigi.altervista.org - aluigi@autistici.org> 
'|
'| LICENSE:
'|  This program is free software; you can redistribute it and/or modify
'|  it under the terms of the GNU General Public License as published by
'|  the Free Software Foundation; either version 2 of the License, or
'|  (at your option) any later version.
'|
'|  This program is distributed in the hope that it will be useful,
'|  but WITHOUT ANY WARRANTY; without even the implied warranty of
'|  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'|  GNU General Public License for more details.
'|
'|  You should have received a copy of the GNU General Public License
'|  along with this program; if not, write to the Free Software
'|  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
'|
'|  http://www.gnu.org/licenses/gpl.txt
'|
'| NOTE:
'|  The GPL requires you the release your project's source code with the
'|  compiled stuff!
'|
'| FUNCTIONS:
'|  Create the Validate-Key:
'|    str makeValidate(str SecureKey, str Handoff)
'|
'|  Create a Master Packet:
'|    str createPacket(str Gamename, str ValidateKey [, str Filter [, bool CompressedServers = False]])
'+----------------------------------------------------------------------------

Option Explicit

'+----------------------------------------------------------------------------
'| Function: createPacket
'| Params:   Gamename: The internal Gamename (bfield1942, quake3, ...)
'|           ValidateKey: The ValidateKey (created with makeValidate!)
'|           [Filter]: Apply some Filters..
'|           [CompressedServers]: 'True' will return an 6-Byte-IP Packet
'|           [EncodingType]: 1 or 0; Default is 1
'| Return:   A valid GameSpy Master-Packet
'+----------------------------------------------------------------------------
Public Function createPacket(ByVal Gamename As String, _
                             ByVal ValidateKey As String, _
                             Optional ByVal Filter As String, _
                             Optional ByVal CompressedServers As Boolean) As String
'// This small function will create a GSMaster-Packet for you :)
createPacket = _
"\gamename\" & Gamename & "\enctype\0\validate\" & ValidateKey & _
"\final\" & "\queryid\1.1\list\" & IIf(CompressedServers = True, "cmp", "") & _
"\gamename\" & Gamename & IIf(Len(Filter) > 0, "\where\" & Filter, "") & "\final\"
End Function

'+----------------------------------------------------------------------------
'| Function: makeValidate
'| Params:   SecureKey: The Key received from the GS Master
'|           Handoff: Your game's handoff
'| Return:   Validate-Key
'+----------------------------------------------------------------------------
Public Function makeValidate(ByVal SecureKey As String, _
                             ByVal Handoff As String) As String
Dim Table(255)  As Byte     '// Buffer
Dim Secure(5)   As Byte     '// (Secure)Key
Dim Temp(3)     As Integer  '// Some temporary variables
Dim i           As Integer  '// Loop-var
Dim j           As Byte     '// Loop-var
Dim Validate    As String   '// ValidateKey
Dim Gamekey(5)  As Byte     '// The new 6-byte Handoff

If Len(SecureKey) < 6 Or Len(Handoff) < 6 Then
    Exit Function
End If

For i = 3 To 13 Step 2
    '// Add the next byte to the array
    Gamekey(j) = Asc(Mid$(Handoff, i, 1))
    j = j + 1
Next

For i = 0 To 255
    Table(i) = i '// Fill the Buffer
Next

For i = 0 To 255
    '// Scramble the Table with the Handoff:
    Temp(0) = (Temp(0) + Table(i) + Gamekey(i Mod 6)) And 255
    Temp(1) = Table(Temp(0))
    
    '// Update the buffer:
    Table(Temp(0)) = Table(i)
    Table(i) = Temp(1)
Next

Temp(0) = 0

'// Scramble the SecureKey with the Table:
For i = 0 To 5
    '// Add the next byte to the array
    Secure(i) = Asc(Mid$(SecureKey, i + 1, 1))
    
    Temp(0) = (Temp(0) + Secure(i) + 1) And 255
    Temp(1) = Table(Temp(0))
    Temp(2) = (Temp(2) + Temp(1)) And 255
    Temp(3) = Table(Temp(2))
    
    '// XOR the key with the buffer:
    Secure(i) = Secure(i) Xor Table((Temp(1) + Temp(3)) And 255)
    
    '// Update the buffer:
    Table(Temp(0)) = Temp(3)
    Table(Temp(2)) = Temp(1)
Next

i = 0
'// Create the valid validatekey:
For j = 0 To 1:
    Temp(1) = Secure(i)
    Temp(3) = Secure(i + 1)
    
    createChar Validate, RShift(Temp(1), 2)
    createChar Validate, LShift(Temp(1) And 3, 4) Or RShift(Temp(3), 4)
    
    Temp(1) = Secure(i + 2)
    
    createChar Validate, LShift(Temp(3) And 15, 2) Or RShift(Temp(1), 6)
    createChar Validate, Temp(1) And 63
    
    i = i + 3
Next

makeValidate = Validate '// Return the valid ValidateKey
End Function

Private Sub createChar(ByRef Validate As String, ByVal Number As Byte)
Dim newChar As String * 1

'// Check the Charcode, create a new Char ...
Select Case Number
    Case Is < 26
        newChar = Chr$(Number + 65)
    Case Is < 52
        newChar = Chr$(Number + 71)
    Case Is < 62
        newChar = Chr$(Number - 4)
    Case 62
        newChar = "+"
    Case 63
        newChar = "/"
End Select

'// ... and add it to the ValidateKey
Validate = Validate & newChar
End Sub

'// The << (LShift) and >> (RShift) functions:
Private Function LShift(ByVal Value As Byte, ByVal Shift As Byte) As Byte
LShift = Value * (2 ^ Shift)
End Function

Private Function RShift(ByVal Value As Byte, ByVal Shift As Byte) As Byte
RShift = Value \ (2 ^ Shift)
End Function