Есть идея по созданию интересной программы?
вторник, 12 октября 2010 г.
Counter-Strike informer for Delphi
Получение информации о текущем состоянии сервера Counter-Strike в сети по средством выполнения Udp запроса.
Основная сложность состояла в разборе ответа сервера.
Проверял на работоспособность на серверах использующий 37 протокол, а на 47, 48 не проверял.
Исходный текст проекта
procedure TForm1.btnInfoClick(Sender: TObject);
var
tempS:string[255];
Reply,count,maxCount:string;
listReply:TStringList;
i:Integer;
begin
Memo1.Lines.Clear;
UdpSocket1.BlockMode:=bmNonBlocking;//неблокирующий режим
UdpSocket1.RemoteHost:=edtIp.Text;
UdpSocket1.RemotePort:=edtPort.Text;
listReply:=TStringList.Create;
try
UdpSocket1.Open;
UdpSocket1.Sendln('яяяяTSource Engine Query',' ');
UdpSocket1.ReceiveBuf(tempS,255);
UdpSocket1.WaitForData(1000);//сколько ждать данные
Reply:=Reply+tempS;
UdpSocket1.ReceiveBuf(tempS,255);
Reply:=Reply+tempS;
UdpSocket1.ReceiveBuf(tempS,255);
Reply:=Reply+tempS;
if Reply='' then
begin
Memo1.Lines.Add('Сервер недоступен!!!');
UdpSocket1.Close;
Exit;
end;
Delete(Reply,1,4);
for I := 0 to Length(Reply)-1 do
begin
if Reply[i]=#0 then
Reply[i]:=#13; //#6
end;
// Reply:=StringReplace(Reply,#6,#13#10,[rfReplaceAll,rfIgnoreCase]);
listReply.text:=Reply;
Memo1.Lines.Add('IP адрес сервера: '+listReply.Strings[0]);
Memo1.Lines.Add('Название сервера: '+listReply.Strings[1]);
Memo1.Lines.Add('Текущая карта: '+listReply.Strings[2]);
Memo1.Lines.Add('Директория игры: '+listReply.Strings[3]);
Memo1.Lines.Add('Описание: '+listReply.Strings[4]);
tempS:=listReply.Strings[5];//hex
count:=Copy(tempS,1,1);//Кол-во игроков на сервере
maxCount:=Copy(tempS,2,1);//Максимальное кол-во игроков
Memo1.Lines.Add('Кол-во игроков на сервере: '+IntToStr(HexToInt(count)));
Memo1.Lines.Add('Максимальное кол-во игроков: '+IntToStr(HexToInt(maxCount)));
finally
listReply.Free;
end;
end;
Данные все были в "нормальном" виде кроме значений кол-ва игроков которые были в hex
для того, чтобы их перевести в integer использовал:
function HexToInt(s: string): integer;
label
gte;
var
tempt: string;
i: integer;
begin
tempt := '';
if s = '' then
begin
HexToInt := 0;
goto gte;
end;
for i := 1 to Length(s) do
begin
tempt := tempt + IntToHex(Ord(s[i]), 2);
end;
HexToInt := StrToInt('$' + tempt);
gte:
end;
Спасибо GunSmoker'y!!! Без него до сих пор бы со структурой мучался!
Теперь работает и в Delphi 7, в 2010 работает и так и так))
Полный исходник можно скачать отсюда Download
Подписаться на:
Комментарии к сообщению (Atom)
Не работает. Покрайнемере исходник который скачал . Первую ошибку показал на строке:
ОтветитьУдалитьReply:=StringReplace(Reply,#6,#13#10,[rfReplaceAll,rfIgnoreCase]);
Пожалуйста проверьте на актуальность.
Николай версия delphi какая?
ОтветитьУдалитья лично писал ее на 2010! вот exe скомпилированного проекта который вы пробовали запустить у себя в среде http://narod.ru/disk/26055306000/Project1.exe.html
исправил теперь и в делфи 7 работает
ОтветитьУдалитьСпасибо :) Я думаю это единственный рабочий исходник во всем рунете :)
ОтветитьУдалитьспасибо, что мой труд не пропал даром
ОтветитьУдалитьА как сделать нормаль в D7 проверку на то что сервер в офлайне? Просто в обычном случае если сервак выключить программа просто виснет.
ОтветитьУдалитьИсправил.
ОтветитьУдалить))) Вот интересно, а как насчет списка игроков? На php это реализовано может попробуем портировать на delphi? :)
ОтветитьУдалитьесли просмотреть listReply дальше дальше 4 то там все есть)) только я пока не знаю как все вытащить оттуда красиво
ОтветитьУдалитьА так запросто можно реализовать.
вот тут же есть имена игроков
ОтветитьУдалить'яяяD'#$18#$D'buntyar.net'#$D#$D#$D#$D#$D'.‰2G'#$D'Coral(nikolaev)'#$D#4#$D#$D#$D'Ђ1'#6'D'#$D'w1nx^BlooM'#$D#$C#$D#$D#$D'а'#9#$18'E'#$D'Ho-Ha'#$D#$13#$D#$D#$D'@ХєD'#$D'B@K$!!!!!'#$D#1#$D#$D#$D'ЂИяC'#$D'xprogram'#$D#7#$D#$D#$D'@МLD'#$D'provalbnuu parenb'#$D#2#$D#$D#$D#$D'Щ4C'#$D'sasha rok'#$D#$D#$D#$D#$D#$D#$D'Н@'#$D'subbota'#$D#5#$D#$D#$D'Аі<D'#$D'YA ADMIN'#$D#$A#$D#$D#$D'ЂtBD'#$D'myas?!'#$D#$12#$D#$D#$D#$10'ЈЂE'#$D'@@STEP__AK47@@'#$D#3#$D#$D#$D'аЊPE'#$D'bunt^aka '#$D'яяяD'#$18#$D'buntyar.net'#$D#$D#$D#$D#$D'.‰2G'#$D'Coral(nikolaev)'#$D#4#$D#$D#$D'Ђ1'#6'D'#$D'w1nx^BlooM'#$D#$C#$D#$D#$D'а'#9#$18'E'#$D'Ho-Ha'#$D#$13#$D#$D#$D'@ХєD'#$D'B@K$!!!!!'#$D#1#$D#$D#$D'ЂИяC'#$D'xprogram'#$D#7#$D#$D#$D'@МLD'#$D'provalbnuu parenb'#$D#2#$D#$D#$D#$D'Щ4C'#$D'sasha rok'#$D#$D#$D#$D#$D#$D#$D'Н@'#$D'subbota'#$D#5#$D#$D#$D'Аі<D'#$D'YA ADMIN'#$D#$A#$D#$D#$D'ЂtBD'#$D'myas?!'#$D#$12#$D#$D#$D#$10'ЈЂE'#$D'@@STEP__AK47@@'#$D#3#$D#$D#$D'аЊPE'#$D'bunt^aka '#0#0'a
если можно напишите ссылку на рабочий пых пример в котором можно посмотреть разбор. его же можно перекинуть на delphi если вникнуть))
ОтветитьУдалить$fpl = @fsockopen ("udp://".$server,$port);
ОтветитьУдалитьif (!$fpl) {
echo "Сервер в дауне!";
} else {
stream_set_timeout($fpl, 1, 0);
// fwrite($fpl,"яяяяdetails\x00/яяяяplayers\x00".chr(10));
fwrite($fpl,"\377\377\377\377players".chr(10));
$st=fread($fpl,1);
$r=socket_get_status($fpl);
$r=$r["unread_bytes"];
$st.=@fread($fpl,$r);
fclose($fpl);
$playersn=ord(substr($st,5,1));
$st=substr($st,6);
if ($playersn !=0 )
{
echo"<@table id=blockplayers border=1 cellpadding=0 cellspacing=0 width=100% height=46 bordercolor=#333333 align=center@>
<@tr id=blockplayers@>
<@td id=blockplayers width=2% align=center@>#<@/td@>
<@td id=blockplayers width=52% align=center@><@b@>Имя:<@/b@><@/td@>
<@td id=blockplayers width=45% align=center@><@b@>Фраги:<@/b@><@/td@>
<@/tr@>";
for ($i=1;$i<@=$playersn;$i++)
{
$n=ord(substr($st,0,1));
$st=substr($st,1);
$name=SubStr($st,0,StrPos($st,chr(0)));
$kills=ord(substr($st,StrPos($st,chr(0))+1,1));
if ($kills==255){$kills=-1;}
if ($kills==254){$kills=-2;}
if ($kills==253){$kills=-3;}
if ($kills==252){$kills=-4;}
$st=substr($st,StrPos($st,chr(0)));
$st=substr($st,9);
$name = stripslashes($name);
$name = htmlspecialchars($name);
echo"<@tr id=blockplayers@>
<@td id=blockplayers width=2% align=center@>$n<@/td@>
<@td id=blockplayers width=52% align=center@>$name<@/td@>
<@td id=blockplayers width=45% align=center@>$kills<@/td@>
<@/tr@>";
}
echo "<@/table@>";
}
else
{
echo "<@center@>Сервер пустует.<@/center@>";
}
}
P.S. Знак @ уберёшь в коде - просто так комент парсинг не проходил.
ок попробуем но не сегодня
ОтветитьУдалитьНу что там? Есть новости? Я как не пробывал ники смотреть но все время возвращается пустота одна.
ОтветитьУдалитьP.S. Может перейдем на skype/icq? А то комментарии с модерацией немного раздражает :)
Всем привет. Еле нашел наверно единственный работающий исходник сканера.
ОтветитьУдалитьМожете объяснить в чем различие протоколов и как настроить сканер на 47 протокол.
я лично не смотрел снифером, что шлет сервак кс с 47 протоколом так кс имеется только с 37. да и сервака не знаю который работает на 47 протоколе. если есть адрес такого сервера то можно глянуть.
ОтветитьУдалитьнезнаю вроде все сейчас работают на 47 протоколе(по крайней мере в нашей сети)
ОтветитьУдалитьвот по теме может поможет
http://forum.sources.ru/index.php?showtopic=183029&view=showall
http://forum.sources.ru/index.php?showtopic=309848
попробуйте просто получить инфу о серваке кс этим примером, если ни чего не изменилось значит она будет работать, если изменилось то нет. просто у меня все только 37.
ОтветитьУдалитьполовину серверов не видит почемуто
ОтветитьУдалитьможет лучше было бы сделать через Udp Client?
напишите ip серверов которые он не видит
ОтветитьУдалитьЭтот комментарий был удален администратором блога.
ОтветитьУдалитьЛадно буду разбираться. Ip может дашь в инете который юзал
ОтветитьУдалитьну вот вроде работает с 48 протоколом
ОтветитьУдалитьprocedure TForm1.btnInfoClick(Sender: TObject);
var
tempS:string[255];
Reply,count,maxCount:string;
listReply:TStringList;
i:Integer;
begin
Memo1.Lines.Clear;
UdpSocket1.BlockMode:=bmNonBlocking;//неблокирующий режим
UdpSocket1.RemoteHost:=edtIp.Text;
UdpSocket1.RemotePort:=edtPort.Text;
listReply:=TStringList.Create;
try
UdpSocket1.Open;
UdpSocket1.Sendln('яяяяTSource Engine Query',' ');
UdpSocket1.ReceiveBuf(tempS,255);
UdpSocket1.WaitForData(1000);//сколько ждать данные
Reply:=Reply+tempS;
UdpSocket1.ReceiveBuf(tempS,255);
Reply:=Reply+tempS;
UdpSocket1.ReceiveBuf(tempS,255);
Reply:=Reply+tempS;
if Reply='' then
begin
Memo1.Lines.Add('Сервер недоступен!!!');
UdpSocket1.Close;
Exit;
end;
Delete(Reply,1,4);
for I := 0 to Length(Reply)-1 do
begin
if Reply[i]=#0 then
Reply[i]:=#13; //#6
end;
listReply.text:=Reply;
Memo1.Lines.Add('IP адрес сервера: '+listReply.Strings[0]);
Memo1.Lines.Add('Название сервера: '+listReply.Strings[1]);
Memo1.Lines.Add('Текущая карта: '+listReply.Strings[2]);
Memo1.Lines.Add('Директория игры: '+listReply.Strings[3]);
Memo1.Lines.Add('Описание: '+listReply.Strings[4]);
tempS:=listReply.Strings[5];//hex
if tempS='' then
begin
tempS:=listReply.Strings[6];
count:=Copy(tempS,5,1);//Максимальное кол-во игроков
maxCount:=Copy(tempS,1,1);
end
else
begin
count:=Copy(tempS,1,1);//Кол-во игроков на сервере
maxCount:=Copy(tempS,2,1);//Максимальное кол-во игроков
end;
Memo1.Lines.Add('Кол-во игроков на сервере: '+IntToStr(HexToInt(count)));
Memo1.Lines.Add('Максимальное кол-во игроков: '+IntToStr(HexToInt(maxCount)));
finally
listReply.Free;
end;
end;
Проверял тут написано типа 48 47 протоколы юзают эти сервы
# 91.203.39.201:27015
# 91.203.39.201:27017
# 91.203.39.201:27018
http://linkme.ufanet.ru/images/6eb77f3f9b32fd4f7b44c90d09d118c5.jpg
ОтветитьУдалитьвот посмотри проверял на 2-х активных серверах
в одном случае нормально а вдругом нет
p.s. я тут узнал что на запрос яяяяTSource Engine Query отвечают в основном старые версии серверов, а для новых нужен другой запрос.
p.s.s проверь на серверах http://cs-monitor.ru/
хорошо! как с сессией разберусь сразу все сделаю!
ОтветитьУдалитьвообщем то я тут протестил почти все серверы находят, только почему то в ип адресе все время выводится 172.0.0.1. Если у тебя времени нет то не нужно напрягаться и так ты уже сделал очень большую работу за что тебе спасибо.
ОтветитьУдалитьесли же будешь продолжать напиши аську чем смогу помогу.
#51713##6
ОтветитьУдалить#=2
На Indy v10 напишите плиз исходник, недавно перешел на эту версию и понял что нифига не знаю...
ОтветитьУдалитьСделал на Indy
ОтветитьУдалитьhttp://nilbag.ru/node/32
Кстати проблему решили, с правильным отображением количества игроков? А то замечал что иногда вместо каково то количество игроков показывает, ненадолго 0 игроков и макс. игроков тоже 0 (ну до того времени пока уменьшится или не увеличится данная цифра). Честно не помню уже все в деталях, т.к. недавно сервер восстановил и решил заодно информер обновить под него.
ОтветитьУдалитьP.S. Если что это Николай :)
кста а как насчет списка игроков ) кто то говорил что они дальше там идут и позже сделает :)
ОтветитьУдалитьу меня сейчас забота как мне на кладбище не попасть.(((
ОтветитьУдалитьспасибо отличный исходник)я его немного переделал и получился флудильщик на сервере)
ОтветитьУдалитьlistReply поглощает все 10 (#$A) значения с Reply и отображает их как перенос строки.
ОтветитьУдалитьпотому парсить надо сразу Reply. иначе если игроков допустим 10 то программа покажет 0
спс
УдалитьНу, что спустя три года я решил вернуться и оставить еще один комментарий :)
ОтветитьУдалитьP.s. Николай (первый комментарий) ^_^
с возвращением)).
Удалитьчто на этот раз случилось7
Ну что же Вы за 3 года так и не переписали проект ? (
Удалитьтак время такая вещь, которой всегда мало((
ОтветитьУдалитьПрисоединяюсь. + За года интересы и потребности уже меняются. Сейчас уже ушел в iOS разработку, а из Valve на Dota 2 перешел, хотя CS 1.6 это классика уже.. :)
Удалитькрасавец, в моно пишешь или в эклипсе?
Удалитьв последнее время, что то игры перестали доставлять удовольствие. хочется чего то другого
Eclipse для Java / Android'a же, а iOS это Objective-C и Xcode соответственно, хотя не панацея тоже. В основном разрабатываю клиенты для всяких веб-проектов, но давно уже к гейм дев'у присматриваюсь. Правда у меня не много не стандартные идеи для игровых проектов.. :)
Удалитьмолодец!!!
Удалитьнестандартность-залог успеха.
однообразность уже всех достала))