program SimpleTests;
{$APPTYPE CONSOLE}
{$R *.res}
uses
IdGlobal, IdUDPClient,
StrUtils, SysUtils,
SourceQuery
in '
SourceQuery.pas';
procedure ParseInfoResponse( AResponse: TSourceQueryBytes );
var
LID: SQUShort;
LEDF: SQByte;
begin
Writeln( '
Parse-Data:' );
Writeln;
Writeln( '
Protocol-Header ', AResponse.ReadLong );
Writeln( '
Packet-Header ', AResponse.ReadChar );
Writeln( '
Protocol ', AResponse.ReadByte );
Writeln( '
Name ', AResponse.ReadString );
Writeln( '
Map ', AResponse.ReadString );
Writeln( '
Folder ', AResponse.ReadString );
Writeln( '
Game ', AResponse.ReadString );
LID := AResponse.ReadUShort;
Writeln( '
ID ', LID );
Writeln( '
Players ', AResponse.ReadByte );
Writeln( '
Max. Players ', AResponse.ReadByte );
Writeln( '
Bots ', AResponse.ReadByte );
Writeln( '
Server Type ', AResponse.ReadChar );
Writeln( '
Environment ', AResponse.ReadChar );
Writeln( '
Visibility ', AResponse.ReadByte );
Writeln( '
VAC ', AResponse.ReadByte );
// Testen auf "The Ship"
if ( LID >= 2400 )
and ( LID <= 2499 )
then
begin
Writeln( '
Mode ', AResponse.ReadByte );
Writeln( '
Witnesses ', AResponse.ReadByte );
Writeln( '
Duration ', AResponse.ReadByte );
end;
Writeln( '
Version ', AResponse.ReadString );
if not AResponse.Eof
then
begin
LEDF := AResponse.ReadByte;
Writeln( '
EDF ', LEDF );
if LEDF
and $80 = $80
then
begin
Writeln( '
Port ', AResponse.ReadShort );
end;
if LEDF
and $10 = $10
then
begin
Writeln( '
SteamID ', AResponse.ReadLongLong );
end;
if LEDF
and $40 = $40
then
begin
Writeln( '
Port ', AResponse.ReadShort );
Writeln( '
Name ', AResponse.ReadString );
end;
if LEDF
and $20 = $20
then
begin
Writeln( '
Keywords ', AResponse.ReadString );
end;
if LEDF
and $01 = $01
then
begin
Writeln( '
GameID ', AResponse.ReadLongLong );
end;
end;
end;
procedure TestInfoResponse;
var
LResponse: TSourceQueryBytes;
begin
Writeln( '
Example response for Counter Strike: Source:' );
Writeln;
LResponse.SetData(
{AData} HexStrToBytes(
{AHexStr} StringReplace(
{} '
FF FF FF FF 49 02 67 61 6D 65 32 78 73 2E 63 6F' +
{} '
6D 20 43 6F 75 6E 74 65 72 2D 53 74 72 69 6B 65' +
{} '
20 53 6F 75 72 63 65 20 23 31 00 64 65 5F 64 75' +
{} '
73 74 00 63 73 74 72 69 6B 65 00 43 6F 75 6E 74' +
{} '
65 72 2D 53 74 72 69 6B 65 3A 20 53 6F 75 72 63' +
{} '
65 00 F0 00 05 10 04 64 6C 00 00 31 2E 30 2E 30' +
{} '
2E 32 32 00',
{OldPattern} '
',
{NewPattern} '
',
{Flags} [rfReplaceAll] ) ) );
ParseInfoResponse( LResponse );
end;
procedure RealInfoRequest;
var
LRequest, LResponse: TSourceQueryBytes;
LUdp: TIdUDPClient;
LBuffer: TIdBytes;
LResponseSize: Integer;
begin
// Prepare Request
LRequest.WriteLong( SQ_SIMPLEPACKET_PROTOCOL_HEADER );
LRequest.WriteByte( SQ_INFO_REQUEST_HEADER );
LRequest.WriteString( '
Source Engine Query' );
Writeln( '
REQUEST-DATA:' );
Writeln;
Writeln( LRequest.ToString );
Writeln;
LBuffer := LRequest.GetData;
LUdp := TIdUDPClient.Create(
nil );
try
// Send Request
Write( '
Sending ... ' );
LUdp.SendBuffer( '
5.45.97.44', 2301, LBuffer );
// Receive Response
SetLength( LBuffer, SQ_PACKET_MAXSIZE );
Write( '
Receiving ... ' );
LResponseSize := LUdp.ReceiveBuffer( LBuffer );
Writeln( LResponseSize, '
Bytes' );
SetLength( LBuffer, LResponseSize );
Writeln;
finally
LUdp.Free;
end;
Writeln( '
RESPONSE-DATA:' );
Writeln;
Writeln( DumpBuffer( LBuffer ) );
Writeln;
// Parse Response
LResponse.SetData( LBuffer );
ParseInfoResponse( LResponse );
end;
procedure RealMasterQueryRequest;
var
LRequest, LResponse: TSourceQueryBytes;
LBuffer: TIdBytes;
LBufferSize: Integer;
LUdp: TIdUDPClient;
LServerAddress: TSQServerAddressBlock;
LCount, LRetries: Integer;
begin
LServerAddress.IP1 := 0;
LServerAddress.IP2 := 0;
LServerAddress.IP3 := 0;
LServerAddress.IP4 := 0;
LServerAddress.Port := 0;
LUdp := TIdUDPClient.Create(
nil );
try
LCount := 0;
repeat // Daten abrufen ...
LRequest.Clear;
LRequest.WriteByte( $31 );
// Message Type
LRequest.WriteByte( SQ_REGIONCODE_RESTOFTHEWORLD );
// Region Code
LRequest.WriteString( LServerAddress.ToString );
// IP-Address
LRequest.WriteString( '
\gamedir\arma2arrowpc' );
// Filter
LBuffer := LRequest.GetData;
// Send Request
LUdp.SendBuffer( '
hl2master.steampowered.com', 27011, LBuffer );
LRetries := 0;
repeat
if LRetries >= 3
then
raise Exception.Create( '
Too many retries' );
SetLength( LBuffer, SQ_PACKET_MAXSIZE );
LBufferSize := LUdp.ReceiveBuffer( LBuffer, 2000 );
Inc( LRetries );
until LBufferSize > 0;
SetLength( LBuffer, LBufferSize );
LResponse.SetData( LBuffer );
Assert( LResponse.ReadLong = SQ_SIMPLEPACKET_PROTOCOL_HEADER );
Assert( LResponse.ReadByte = $66 );
Assert( LResponse.ReadByte = $0A );
// Parse the Server-Addresses
while not LResponse.Eof
do
begin
Inc( LCount );
LServerAddress.IP1 := LResponse.ReadByte;
LServerAddress.IP2 := LResponse.ReadByte;
LServerAddress.IP3 := LResponse.ReadByte;
LServerAddress.IP4 := LResponse.ReadByte;
LServerAddress.Port := swap( LResponse.ReadUShort );
// swap weil die Doku das sagt
Writeln( LCount:7, '
. ', LServerAddress.ToString );
end;
until ( LServerAddress.ToString = '
0.0.0.0:0' );
// ... bis die leere Adresse zurückkommt
finally
LUdp.Free;
end;
end;
begin
try
TestInfoResponse;
RealInfoRequest;
RealMasterQueryRequest;
except
on E:
Exception do
Writeln( E.ClassName, '
: ', E.
Message );
end;
ReadLn;
end.