diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 0000000..cc57407 --- /dev/null +++ b/.gitattributes @@ -0,0 +1,60 @@ +# Default to binary (no diff) + +* binary + +# VB6 source files (show diff + keep CRLF in zip download) + +.bas text=auto eol=crlf +.cls text=auto eol=crlf +.ctl text=auto eol=crlf +.dob text=auto eol=crlf +.dsr text=auto eol=crlf +.frm text=auto eol=crlf +.pag text=auto eol=crlf +.vbg text=auto eol=crlf +.vbl text=auto eol=crlf +.vbp text=auto eol=crlf +.vbr text=auto eol=crlf +.vbw text=auto eol=crlf + +# Other source files (show diff + LF only in zip download) + +.asm text=auto +.asp text=auto +.bat text=auto +.c text=auto +.cpp text=auto +.dsp text=auto +.dsw text=auto +.h text=auto +.idl text=auto +.java text=auto +.js text=auto +.manifest text=auto +.odl text=auto +.php text=auto +.php3 text=auto +.rc text=auto +.sln text=auto +.sql text=auto +.vb text=auto +.vbs text=auto + +# Text files but keep as binary (no diff) + +# .cfg text=auto +# .conf text=auto +# .csi text=auto +# .css text=auto +# .csv text=auto +# .def text=auto +# .htm text=auto +# .html text=auto +# .inf text=auto +# .ini text=auto +# .log text=auto +# .reg text=auto +# .rtf text=auto +# .txt text=auto +# .url text=auto +# .xml text=auto diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..2d6493b --- /dev/null +++ b/.gitignore @@ -0,0 +1,6 @@ +*.scc +*.dca +*.oca +*.obj +vb*.tmp +@PSC* diff --git a/PIC2005119113755769.jpg b/PIC2005119113755769.jpg new file mode 100644 index 0000000..f334f51 Binary files /dev/null and b/PIC2005119113755769.jpg differ diff --git a/README.md b/README.md new file mode 100644 index 0000000..0e463bd --- /dev/null +++ b/README.md @@ -0,0 +1,33 @@ +
+ +## GS Browser \- Get Serverlists from GameSpy + + +
+ +### Description + +Get Serverlists from the public GameSpy Master! + +### More Info + + + + | +--- |--- +**Submitted On** |2004-10-15 17:49:06 +**By** |[Thomas Reiser](https://github.com/Planet-Source-Code/PSCIndex/blob/master/ByAuthor/thomas-reiser.md) +**Level** |Beginner +**User Rating** |5.0 (15 globes from 3 users) +**Compatibility** |VB 6\.0 +**Category** |[Internet/ HTML](https://github.com/Planet-Source-Code/PSCIndex/blob/master/ByCategory/internet-html__1-34.md) +**World** |[Visual Basic](https://github.com/Planet-Source-Code/PSCIndex/blob/master/ByWorld/visual-basic.md) +**Archive File** |[GS\_Browser1841661192005\.zip](https://github.com/Planet-Source-Code/thomas-reiser-gs-browser-get-serverlists-from-gamespy__1-58372/archive/master.zip) + + + + + + + + diff --git a/frmMain.frm b/frmMain.frm new file mode 100644 index 0000000..9b8f4d3 --- /dev/null +++ b/frmMain.frm @@ -0,0 +1,652 @@ +VERSION 5.00 +Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "mswinsck.ocx" +Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx" +Begin VB.Form frmMain + BorderStyle = 1 'Fest Einfach + Caption = "GS Browser [Alpha 0.1]" + ClientHeight = 8400 + ClientLeft = 45 + ClientTop = 435 + ClientWidth = 7680 + LinkTopic = "Form1" + MaxButton = 0 'False + ScaleHeight = 8400 + ScaleWidth = 7680 + StartUpPosition = 2 'Bildschirmmitte + Begin MSComDlg.CommonDialog dlgSave + Left = 6360 + Top = 6840 + _ExtentX = 847 + _ExtentY = 847 + _Version = 393216 + End + Begin VB.Timer tmrCheck2 + Enabled = 0 'False + Interval = 15000 + Left = 5280 + Top = 6720 + End + Begin VB.Timer tmrCheck + Interval = 1 + Left = 4800 + Top = 6720 + End + Begin VB.Frame fraLog + Caption = "Log:" + Height = 1330 + Left = 120 + TabIndex = 5 + Top = 6960 + Width = 7455 + Begin VB.TextBox txtLog + Height = 950 + Left = 120 + Locked = -1 'True + MultiLine = -1 'True + ScrollBars = 2 'Vertikal + TabIndex = 6 + Top = 240 + Width = 7215 + End + End + Begin VB.Frame fraServers + Caption = "Servers:" + Height = 6735 + Left = 5040 + TabIndex = 3 + Top = 120 + Width = 2535 + Begin VB.CommandButton cmdSaveServers + Caption = "Save Servers" + Height = 375 + Left = 480 + TabIndex = 9 + Top = 6240 + Width = 1575 + End + Begin VB.ListBox lstServers + Height = 5910 + Left = 120 + TabIndex = 4 + Top = 240 + Width = 2295 + End + End + Begin VB.Frame fraGames + Caption = "Games:" + Height = 6735 + Left = 120 + TabIndex = 0 + Top = 120 + Width = 4815 + Begin MSWinsockLib.Winsock wskTCP + Left = 4320 + Top = 120 + _ExtentX = 741 + _ExtentY = 741 + _Version = 393216 + End + Begin VB.CheckBox chkSave + Caption = "Save" + Height = 255 + Left = 1800 + TabIndex = 8 + Top = 6300 + Value = 1 'Aktiviert + Width = 1215 + End + Begin VB.CommandButton cmdUpdateServers + Caption = "Update Serverlist" + Height = 375 + Left = 3120 + TabIndex = 7 + Top = 6240 + Width = 1575 + End + Begin VB.CommandButton cmdUpdateGames + Caption = "Update Gamelist" + Height = 375 + Left = 120 + TabIndex = 2 + Top = 6240 + Width = 1575 + End + Begin VB.ListBox lstGames + Height = 5910 + Left = 120 + Sorted = -1 'True + TabIndex = 1 + Top = 240 + Width = 4575 + End + End +End +Attribute VB_Name = "frmMain" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +Option Explicit + +'======================================= +' +' This piece of Code really sucks, +' but I hope it's useful... :-P +' +' - Thomas Reiser +'======================================= + +Private Type Server + IP As String + Port As Long +End Type + +Private Enum Socket_State + RequestingGames + ReceivingGamelist + ReceivingGameinfos + RequestingValidateKey + ReceivingServers + Idle +End Enum + +'--------------------------------------- +' GameSpy Servers.. +'--------------------------------------- +'MotD-Master +Const GSMOTDMasterHost As String = "motd.gamespy.com" +Const GSMOTDMasterPort As Integer = 80 + +'Server-Master +Const GSServerMasterHost As String = "master.gamespy.com" +Const GSServerMasterPort As Integer = 28900 + +'---- + +Dim MOTDRequest As String +Dim Gamelist(1) As String +Dim Game() As GameData +Dim TempFilters() As GameData +Dim Serverlist As String +Dim Servers() As Server +Dim SocketState As Socket_State + +'---------------------------------------- +' Save Serverlist +'---------------------------------------- +Private Sub cmdSaveServers_Click() +Dim F As Integer +Dim IPs As String +Dim i As Integer + +With dlgSave + .DialogTitle = "Save Serverlist to.." + .Filter = "*.* (All files)|*.*" 'Accept all files + .CancelError = False + .ShowSave + + If .FileName = "" Then 'Abort-Button pressed + Exit Sub + Else + If GetUBound2(Servers()) < 0 Then + AddLog vbCrLf & "Serverlist is empty!" + Exit Sub + Else + For i = 0 To GetUBound2(Servers()) + IPs = IPs & Servers(i).IP & ":" & Servers(i).Port & vbCrLf + Next + End If + IPs = Left$(IPs, Len(IPs) - 2) + + 'Save IPs to file + F = FreeFile 'Get new File-Number + Open .FileName For Output As #F 'Open the file + Print #F, Left$(IPs, Len(IPs) - 1) 'Write Serverlist to file + Close #F 'Close + + AddLog vbCrLf & "Serverlist saved to " & Chr$(34) & .FileName & Chr$(34) & "!" + End If +End With +End Sub + +'---------------------------------------- +' Update Gamelist +'---------------------------------------- +Private Sub cmdUpdateGames_Click() +Dim i As Integer + +For i = 0 To GetUBound(Game()) + ReDim Preserve TempFilters(i) + TempFilters(i).Filter = Game(i).Filter + TempFilters(i).Gamename = Game(i).Gamename +Next + +wskTCP.Close + +'Connect to motd.gamespy.com:80.. +wskTCP.Connect GSMOTDMasterHost, GSMOTDMasterPort +lstGames.Clear +SocketState = RequestingGames +MOTDRequest = "" '!!! + +AddLog vbCrLf & "Connecting to " & GSMOTDMasterHost & ":" & GSMOTDMasterPort & "... (Gamelist)" +End Sub + +'---------------------------------------- +' Update Serverlist +'---------------------------------------- +Private Sub cmdUpdateServers_Click() +Dim RetVal As String 'Inputbox return value + +If lstGames.ListIndex = -1 Then + 'No Game selected.. + Exit Sub +Else + RetVal = InputBox("Filters for '" & Game(lstGames.ItemData(lstGames.ListIndex)).FullName & "':", _ + "Filter...", Game(lstGames.ItemData(lstGames.ListIndex)).Filter) + + If StrPtr(RetVal) = 0 Then + Exit Sub + Else + 'Add the new Filter to the Array: + Game(lstGames.ItemData(lstGames.ListIndex)).Filter = RetVal + End If +End If + +wskTCP.Close + +'Connect to master.gamespy.com:28900.. +wskTCP.Connect GSServerMasterHost, GSServerMasterPort + +AddLog vbCrLf & "Trying to get the Serverlist for '" & Game(lstGames.ItemData(lstGames.ListIndex)).FullName & "'..." +SocketState = RequestingValidateKey +End Sub + +'---------------------------------------- +' Form_Load-Event +'---------------------------------------- +Private Sub Form_Load() +Dim RetVal As String +Dim i As Long + +If Dir$(App.Path & "\serverlist.dat") <> "" Then + RetVal = ReadServerlist(Game()) + + If RetVal = "" Then + 'OK + AddLog "Reading Serverlist..." + For i = 0 To UBound(Game) + lstGames.AddItem Game(i).FullName + lstGames.ItemData(lstGames.NewIndex) = i + Next + AddLog " Done!" & vbCrLf & "GS Browser successfully started!" + Else + 'Error + AddLog "[ERROR] " & RetVal & vbCrLf & "Error while loading the Serverlist!" + End If +Else + AddLog "GS Browser successfully started!" +End If + +SocketState = Idle +End Sub + +'---------------------------------------- +' Form_Unload-Event +'---------------------------------------- +Private Sub Form_Unload(Cancel As Integer) +If chkSave.Value = vbChecked Then + 'Save the Serverlist (!!FILTERS!!) + SaveServerlist Game() +End If +End Sub + +'---------------------------------------- +' Check if the Buttons are available +'---------------------------------------- +Private Sub tmrCheck_Timer() +If SocketState = Idle Then + cmdUpdateGames.Enabled = True + + If lstGames.ListCount > 0 Then + cmdUpdateServers.Enabled = True + Else + cmdUpdateServers.Enabled = False + End If +Else + cmdUpdateGames.Enabled = False + cmdUpdateServers.Enabled = False +End If + +If lstGames.ListCount = 0 Then + cmdUpdateServers.Enabled = False +Else + cmdUpdateServers.Enabled = True +End If +End Sub + +'---------------------------------------- +' 15 seconds Timeout (Serverlist request) +'---------------------------------------- +Private Sub tmrCheck2_Timer() +If Len(Serverlist) = 0 Then + wskTCP.Close + SocketState = Idle + + AddLog " Done! (0 Servers found!)" +End If + +tmrCheck2.Enabled = False +End Sub + +'---------------------------------------- +' Request the Gamelist +'---------------------------------------- +Private Sub wskTCP_Connect() +AddLog vbCrLf & "Connected! Requesting Data..." + +If SocketState = RequestingGames Then + 'Request the Games: + wskTCP.SendData "GET /software/services/index.aspx" & MOTDRequest & " HTTP/1.0" & vbCrLf & _ + "Host: " & GSMOTDMasterHost & vbCrLf & _ + "User-Agent: GS Browser/0.1" & vbCrLf & vbCrLf +End If +End Sub + +'---------------------------------------- +' Parse IPs in an 6-Byte-IP Packet +'---------------------------------------- +Private Function DecompressIps(ByRef Servers() As Server, ByVal Data As String) As Boolean +Dim IP(3) As String +Dim Port(1) As Long +Dim i As Long +Dim c As Long + +If Len(Data) = 0 Then + DecompressIps = False + Exit Function +Else + Data = Replace$(Data, "\final\", "") +End If + +i = 1 +While i < Len(Data) - 6 + 'IP: + IP(0) = Asc(Mid$(Data, i, 1)) 'XXX.000.000.000 + IP(1) = Asc(Mid$(Data, i + 1, 1)) '000.XXX.000.000 + IP(2) = Asc(Mid$(Data, i + 2, 1)) '000.000.XXX.000 + IP(3) = Asc(Mid$(Data, i + 3, 1)) '000.000.000.XXX + + 'Port: + Port(0) = Asc(Mid$(Data, i + 4, 1)) + Port(1) = Asc(Mid$(Data, i + 5, 1)) + + c = GetUBound2(Servers) + 1 + ReDim Preserve Servers(c) + + With Servers(c) + .IP = IP(0) & "." & IP(1) & "." & IP(2) & "." & IP(3) + .Port = (Port(0) * 256) + Port(1) + End With + + i = i + 6 +Wend + +DecompressIps = True +End Function + +'---------------------------------------- +' Receive TCP-Data +'---------------------------------------- +Private Sub wskTCP_DataArrival(ByVal bytesTotal As Long) +Dim Data As String +Dim Splitted() As String +Dim i As Long + +wskTCP.GetData Data, vbString, bytesTotal + +Select Case SocketState + Case Idle 'Do nothing + Exit Sub + Case RequestingValidateKey + Dim ValidateKey As String + Dim Index As Integer + + If Left$(Data, 15) = "\basic\\secure\" Then + Index = lstGames.ItemData(lstGames.ListIndex) + + 'Create the Validate-Key: + ValidateKey = makeValidate(Right$(Data, 7), getHandoff(Game(Index).Handoff)) + + 'Request the Serverlist: + wskTCP.SendData createPacket(Game(Index).Gamename, ValidateKey, _ + Game(Index).Filter, True) + SocketState = ReceivingServers + Serverlist = "" + + Erase Servers + tmrCheck2.Enabled = True + AddLog vbCrLf & "Receiving Serverlist..." + End If + Case ReceivingServers + tmrCheck2.Enabled = False + Serverlist = Serverlist & Data + AddLog "." + + 'Check if all Servers are received: + If InStr(1, Serverlist, "\final\", vbBinaryCompare) > 0 Then + Serverlist = Replace$(Serverlist, "\final\", "") + wskTCP.Close + + AddLog " OK!" & vbCrLf & "Decompressing Servers..." + lstServers.Clear '!!! + + 'Decompress the IPs (4 Byte IP, 2 Byte Port) + If DecompressIps(Servers(), Serverlist) = True Then + If GetUBound2(Servers()) > -1 Then + For i = 0 To UBound(Servers) + 'Add Server to listbox + lstServers.AddItem Servers(i).IP & ":" & Servers(i).Port + Next + AddLog " Done! (" & UBound(Servers) + 1 & " Servers found!)" + Else + GoTo NoServers + End If + Else +NoServers: + AddLog " Done! (0 Servers found!)" + End If + + SocketState = Idle + End If + Case RequestingGames + Dim HeaderLen As Integer + + AddLog "." + + 'Split Header/Data + Splitted() = Split(Data, vbCrLf & vbCrLf, 2, vbTextCompare) + HeaderLen = Len(Splitted(0)) + Gamelist(1) = Splitted(1) + + 'Split the Header + Splitted() = Split(Data, vbCrLf, , vbTextCompare) + For i = 0 To UBound(Splitted) + + 'Get the Content-Length: + If Left$(Splitted(i), 16) = "Content-Length: " Then + Gamelist(0) = CLng(Mid$(Splitted(i), 17)) - (bytesTotal - HeaderLen) + Exit For + End If + Next + + If Len(MOTDRequest) = 0 Then + SocketState = ReceivingGamelist + Else + SocketState = ReceivingGameinfos + End If + Case ReceivingGamelist 'Parse the incoming Gamelist.. + Gamelist(0) = Gamelist(0) - bytesTotal + Gamelist(1) = Gamelist(1) & Data + AddLog "." + + 'Check if all Data is received: + If Gamelist(0) <= 0 Then + AddLog " Done!" + + Dim Split2() As String + + wskTCP.Close + MOTDRequest = "?mode=full&services=" + + 'Parse the Gamelist + Splitted() = Split(Gamelist(1), vbLf, , vbTextCompare) + For i = 0 To UBound(Splitted) + If Len(Splitted(i)) > 0 Then + Split2() = Split(Splitted(i), " - ", 2, vbTextCompare) + + 'Filter invalid games: + If Left$(Split2(0), 2) <> "g_" And _ + Left$(Split2(0), 4) <> "test" And _ + Left$(Split2(0), 1) <> "_" And _ + Split2(0) <> "fileplanet" Then + + MOTDRequest = MOTDRequest & Split2(0) & "\" 'Add game to our Request-String + End If + End If + Next + + 'Remove the "\" at the end: + MOTDRequest = Left$(MOTDRequest, Len(MOTDRequest) - 1) + + 'Connect to motd.gamespy.com:80.. + wskTCP.Connect GSMOTDMasterHost, GSMOTDMasterPort + + AddLog vbCrLf & "Connecting to " & GSMOTDMasterHost & ":" & GSMOTDMasterPort & "... (Gameinfos)" + Erase Game + SocketState = RequestingGames + End If + Case ReceivingGameinfos + Gamelist(0) = Gamelist(0) - bytesTotal + Gamelist(1) = Gamelist(1) & Data + AddLog "." + + Dim FirstSection As Boolean + Dim Key() As String + Dim c As Integer + Dim j As Integer + Dim Temp As GameData + + FirstSection = True + c = 0 + + 'Check if all Data is received: + If Gamelist(0) <= 0 Then + AddLog " OK." & vbCrLf & "Parsing Gameinfos..." + Splitted() = Split(Gamelist(1), vbLf, , vbTextCompare) + + 'Parse the INI-Strings + For i = 0 To UBound(Splitted) + Splitted(i) = Trim$(Splitted(i)) + If Left$(Splitted(i), 1) = "[" Then + '-------------------------- + ' INI-Section + '-------------------------- + If FirstSection = True Then + 'Gamename + Temp.Gamename = Mid$(Splitted(i), 2, Len(Splitted(i)) - 2) + FirstSection = False + Else + 'Check for invalid INI-Keys: + If Len(Temp.Gamename) > 0 And _ + Len(Temp.Handoff) > 0 And _ + Len(Temp.FullName) > 0 Then + + 'Add the valid game to our Array: + c = GetUBound(Game) + 1 + ReDim Preserve Game(c) + + With Game(c) + .Gamename = Temp.Gamename + .FullName = Temp.FullName + .Handoff = Temp.Handoff + + For j = 0 To GetUBound(TempFilters()) + If TempFilters(j).Gamename = Temp.Gamename Then + Game(c).Filter = TempFilters(j).Filter + Exit For + End If + Next + + lstGames.AddItem Temp.FullName + lstGames.ItemData(lstGames.NewIndex) = c + + 'Delete the Temp-Array: + Temp.Gamename = Mid$(Splitted(i), 2, Len(Splitted(i)) - 2) + Temp.FullName = "" + Temp.Handoff = "" + End With + End If + End If + Else + '-------------------------- + ' INI-Key + '-------------------------- + Key() = Split(Splitted(i), "=", 2, vbTextCompare) + If UBound(Key) > 0 Then + If LCase$(Key(0)) = "handoff" Then + Temp.Handoff = Key(1) + ElseIf LCase$(Key(0)) = "fullname" Then + Temp.FullName = Key(1) + End If + End If + End If + Next + + Dim RetVal As String + If chkSave.Value = vbChecked Then + AddLog vbCrLf & "Saving Gamelist... " + + RetVal = SaveServerlist(Game()) + If RetVal <> "" Then + 'Error + AddLog vbCrLf & "[ERROR] " & RetVal & vbCrLf + End If + End If + + AddLog "Done!" + SocketState = Idle + End If +End Select +End Sub + +'---------------------------------------- +' Log-Sub :D +'---------------------------------------- +Private Sub AddLog(ByVal Text As String) +If Len(Text) > 0 Then + txtLog.Text = txtLog.Text & Text + txtLog.SelStart = Len(txtLog.Text) +End If +End Sub + +'GRML: +Private Function GetUBound(ByRef Arr() As GameData) As Long +On Error GoTo IndexError + +GetUBound = UBound(Arr) +Exit Function + +IndexError: + GetUBound = -1 +End Function + +Private Function GetUBound2(ByRef Arr() As Server) As Long +On Error GoTo IndexError + +GetUBound2 = UBound(Arr) +Exit Function + +IndexError: + GetUBound2 = -1 +End Function diff --git a/modSave.bas b/modSave.bas new file mode 100644 index 0000000..ac15a95 --- /dev/null +++ b/modSave.bas @@ -0,0 +1,74 @@ +Attribute VB_Name = "modSave" +Option Explicit + +Public Type GameData + Gamename As String + FullName As String + Handoff As String + Filter As String +End Type + +'---------------------------------------- +' Save the Serverlist +'---------------------------------------- +Public Function SaveServerlist(ByRef Game() As GameData) As String +Dim Data As String +Dim F As Integer +Dim i As Long + +On Error GoTo SaveError +Data = "" + +For i = 0 To UBound(Game) + Data = Data & Game(i).FullName & Chr$(0) & _ + Game(i).Gamename & Chr$(0) & Game(i).Handoff & _ + Chr$(0) & Game(i).Filter & Chr$(0) +Next + +F = FreeFile 'Get new File-Number +Open App.Path & "\serverlist.dat" For Output As #F 'Open the file +Print #F, Left$(Data, Len(Data) - 1) 'Write Serverlist to file +Close #F 'Close + +Exit Function +SaveError: + SaveServerlist = "(" & Err.Number & ") " & Err.Description +End Function + +'---------------------------------------- +' Read the Serverlist +'---------------------------------------- +Public Function ReadServerlist(ByRef Game() As GameData) As String +Dim Data As String +Dim Splitted() As String +Dim F As Integer +Dim i As Long +Dim j As Long + +On Error GoTo ReadError + +F = FreeFile 'Get new File-Number +Open App.Path & "\serverlist.dat" For Binary As #F 'Open the file +Data = Space$(LOF(F)) 'Fill the String with spaces.. +Get #F, , Data 'Get the Serverlist +Close #F 'Close + +Splitted() = Split(Data, Chr$(0), , vbTextCompare) +For i = 0 To UBound(Splitted) Step 4 + ReDim Preserve Game(j) + + 'Fill the array: + With Game(j) + .FullName = Splitted(i) + .Gamename = Splitted(i + 1) + .Handoff = Splitted(i + 2) + .Filter = Splitted(i + 3) + End With + + j = j + 1 +Next + +Exit Function +ReadError: + ReadServerlist = "(" & Err.Number & ") " & Err.Description +End Function diff --git a/prjGSBrowser.vbp b/prjGSBrowser.vbp new file mode 100644 index 0000000..cfdc299 --- /dev/null +++ b/prjGSBrowser.vbp @@ -0,0 +1,47 @@ +Type=Exe +Form=frmMain.frm +Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\WINDOWS\system32\stdole2.tlb#OLE Automation +Module=modGameSpy; vbGSMSALG.bas +Module=modSave; modSave.bas +Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCTL.OCX +Object={248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0; mswinsck.ocx +Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; comdlg32.ocx +IconForm="frmMain" +Startup="frmMain" +HelpFile="" +Title="GS Browser" +ExeName32="GS Browser.exe" +Command32="" +Name="prjGSBrowser" +HelpContextID="0" +Description="GameSpy Browser" +CompatibleMode="0" +MajorVer=0 +MinorVer=0 +RevisionVer=1 +AutoIncrementVer=0 +ServerSupportFiles=0 +VersionComments=":-P" +VersionCompanyName="ò_Ó" +VersionFileDescription="GameSpy Serverbrowser" +VersionLegalCopyright="Copyright © 2004 FiRe^ (fire_1@gmx.de)" +VersionLegalTrademarks="All brand and product names are trademarks and/or registered trademarks of their respective holders." +VersionProductName="GS Browser" +CompilationType=0 +OptimizationType=0 +FavorPentiumPro(tm)=0 +CodeViewDebugInfo=0 +NoAliasing=0 +BoundsCheck=0 +OverflowCheck=0 +FlPointCheck=0 +FDIVCheck=0 +UnroundedFP=0 +StartMode=0 +Unattended=0 +Retained=0 +ThreadPerObject=0 +MaxNumberOfThreads=1 + +[MS Transaction Server] +AutoRefresh=1 diff --git a/vbGSMSALG.bas b/vbGSMSALG.bas new file mode 100644 index 0000000..b85a075 --- /dev/null +++ b/vbGSMSALG.bas @@ -0,0 +1,191 @@ +Attribute VB_Name = "modGameSpy" +'+---------------------------------------------------------------------------- +'| modGameSpy v0.4.1 +'| +'| Written by FiRe^ (fire_1@gmx.de) +'| Last edit: 2004-11-04 +'+---------------------------------------------------------------------------- +'| Information: +'| The algorithm for the function makeValidate() was converted from +'| Luigi Auriemma's C-Code gsmsalg.h (http://aluigi.altervista.org/papers/gsmsalg.h) +'| +'| +'| Public functions: +'| Create the Validate-Key: +'| str makeValidate(str SecureKey, str Handoff) +'| +'| Create a valid 6-char Handoff: +'| str getHandoff(str Handoff) +'| +'| Create a Master Packet: +'| str createPacket(str Gamename, str ValidateKey [, str Filter [, bool CompressedServers = False]]) +'| +'| +'| License (http://www.gnu.org/licenses/gpl.txt): +'| 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 +'+---------------------------------------------------------------------------- + +Option Explicit + +'+---------------------------------------------------------------------------- +'| Function: getHandoff +'| Params: Handoff: 14-char Handoff +'| Return: 6-char Handoff +'+---------------------------------------------------------------------------- +Public Function getHandoff(ByVal Handoff As String) As String +Dim newHandoff As String '// The new 6-char Handoff +Dim i As Byte '// Loop-var + +'// Handoff is too short: +If Len(Handoff) < 13 Then + getHandoff = Handoff ':-( + Exit Function +End If + +For i = 3 To 13 Step 2 + '// Add next char to the new Handoff + newHandoff = newHandoff & Mid$(Handoff, i, 1) +Next + +getHandoff = newHandoff +End Function + +'+---------------------------------------------------------------------------- +'| 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 +'| 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 Key() As Byte '// (Secure)Key +Dim Length(1) As Byte '// Length(0): Handoff length + '// Length(1): SecureKey length +Dim Temp(3) As Integer '// Some temporary variables +Dim i As Integer '// Loop-var +Dim Validate As String '// ValidateKey + +For i = 0 To 255 + Table(i) = i '// Fill the Buffer +Next + +'// Add the length of the Keys to the array +Length(0) = Len(Handoff) '// Should be 6 chars +Length(1) = Len(SecureKey) '// Default is 6 chars + +For i = 0 To 255 + '// Scramble the Table with the Handoff: + Temp(0) = (Temp(0) + Table(i) + Asc(Mid$(Handoff, (i Mod Length(0)) + 1, 1))) And 255 + Temp(1) = Table(Temp(0)) + + '// Update the buffer: + Table(Temp(0)) = Table(i) + Table(i) = Temp(1) +Next + +Temp(0) = 0 + +ReDim Key(Length(1) - 1) '// Set the Array-Size to the SecureKey-Length +Length(1) = Length(1) \ 3 + +'// Scramble the SecureKey with the Table: +For i = 0 To UBound(Key) + '// Add the next char to the Array + Key(i) = Asc(Mid$(SecureKey, i + 1, 1)) + + Temp(0) = (Temp(0) + Key(i) + 1) And 255 + Temp(1) = Table(Temp(0)) + + Temp(2) = (Temp(2) + Temp(1)) And 255 + Temp(3) = Table(Temp(2)) + + Table(Temp(2)) = Temp(1) + Table(Temp(0)) = Temp(3) + + '// XOR the Key with the Buffer: + Key(i) = Key(i) Xor Table((Temp(1) + Temp(3)) And 255) + + '// Encoding Type 2 (Completely useless) + 'Key(i) = Key(i) Xor Asc(Mid$(Handoff, (i Mod Length(0)) + 1, 1)) +Next + +i = 0 +'// Create the valid ValidateKey: +While Length(1) >= 1 '// Default are 3 loops + Length(1) = Length(1) - 1 + + Temp(1) = Key(i) + Temp(3) = Key(i + 1) + + '// VB has no >> << Operators :-( + addChar Validate, RShift(Temp(1), 2) + addChar Validate, LShift(Temp(1) And 3, 4) Or RShift(Temp(3), 4) + + Temp(1) = Key(i + 2) + + addChar Validate, LShift(Temp(3) And 15, 2) Or RShift(Temp(1), 6) + addChar Validate, Temp(1) And 63 + + i = i + 3 +Wend + +makeValidate = Validate '// Return the valid ValidateKey +End Function + +Private Sub addChar(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