Блог по программированию в среде Delphi

Поиск по блогу

Есть идея по созданию интересной программы?

Опиши тут и я по возможности постараюсь это реализовать специально для тебя! Без $ ))

вторник, 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

43 комментария:

  1. Не работает. Покрайнемере исходник который скачал . Первую ошибку показал на строке:
    Reply:=StringReplace(Reply,#6,#13#10,[rfReplaceAll,rfIgnoreCase]);

    Пожалуйста проверьте на актуальность.

    ОтветитьУдалить
  2. Николай версия delphi какая?
    я лично писал ее на 2010! вот exe скомпилированного проекта который вы пробовали запустить у себя в среде http://narod.ru/disk/26055306000/Project1.exe.html

    ОтветитьУдалить
  3. исправил теперь и в делфи 7 работает

    ОтветитьУдалить
  4. Спасибо :) Я думаю это единственный рабочий исходник во всем рунете :)

    ОтветитьУдалить
  5. спасибо, что мой труд не пропал даром

    ОтветитьУдалить
  6. А как сделать нормаль в D7 проверку на то что сервер в офлайне? Просто в обычном случае если сервак выключить программа просто виснет.

    ОтветитьУдалить
  7. ))) Вот интересно, а как насчет списка игроков? На php это реализовано может попробуем портировать на delphi? :)

    ОтветитьУдалить
  8. если просмотреть listReply дальше дальше 4 то там все есть)) только я пока не знаю как все вытащить оттуда красиво
    А так запросто можно реализовать.

    ОтветитьУдалить
  9. вот тут же есть имена игроков
    'яяя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

    ОтветитьУдалить
  10. если можно напишите ссылку на рабочий пых пример в котором можно посмотреть разбор. его же можно перекинуть на delphi если вникнуть))

    ОтветитьУдалить
  11. $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. Знак @ уберёшь в коде - просто так комент парсинг не проходил.

    ОтветитьУдалить
  12. ок попробуем но не сегодня

    ОтветитьУдалить
  13. Ну что там? Есть новости? Я как не пробывал ники смотреть но все время возвращается пустота одна.

    P.S. Может перейдем на skype/icq? А то комментарии с модерацией немного раздражает :)

    ОтветитьУдалить
  14. Всем привет. Еле нашел наверно единственный работающий исходник сканера.
    Можете объяснить в чем различие протоколов и как настроить сканер на 47 протокол.

    ОтветитьУдалить
  15. я лично не смотрел снифером, что шлет сервак кс с 47 протоколом так кс имеется только с 37. да и сервака не знаю который работает на 47 протоколе. если есть адрес такого сервера то можно глянуть.

    ОтветитьУдалить
  16. незнаю вроде все сейчас работают на 47 протоколе(по крайней мере в нашей сети)

    вот по теме может поможет
    http://forum.sources.ru/index.php?showtopic=183029&view=showall

    http://forum.sources.ru/index.php?showtopic=309848

    ОтветитьУдалить
  17. попробуйте просто получить инфу о серваке кс этим примером, если ни чего не изменилось значит она будет работать, если изменилось то нет. просто у меня все только 37.

    ОтветитьУдалить
  18. половину серверов не видит почемуто

    может лучше было бы сделать через Udp Client?

    ОтветитьУдалить
  19. напишите ip серверов которые он не видит

    ОтветитьУдалить
  20. Этот комментарий был удален администратором блога.

    ОтветитьУдалить
  21. Ладно буду разбираться. Ip может дашь в инете который юзал

    ОтветитьУдалить
  22. ну вот вроде работает с 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

    ОтветитьУдалить
  23. http://linkme.ufanet.ru/images/6eb77f3f9b32fd4f7b44c90d09d118c5.jpg

    вот посмотри проверял на 2-х активных серверах
    в одном случае нормально а вдругом нет

    p.s. я тут узнал что на запрос яяяяTSource Engine Query отвечают в основном старые версии серверов, а для новых нужен другой запрос.

    p.s.s проверь на серверах http://cs-monitor.ru/

    ОтветитьУдалить
  24. хорошо! как с сессией разберусь сразу все сделаю!

    ОтветитьУдалить
  25. вообщем то я тут протестил почти все серверы находят, только почему то в ип адресе все время выводится 172.0.0.1. Если у тебя времени нет то не нужно напрягаться и так ты уже сделал очень большую работу за что тебе спасибо.
    если же будешь продолжать напиши аську чем смогу помогу.

    ОтветитьУдалить
  26. На Indy v10 напишите плиз исходник, недавно перешел на эту версию и понял что нифига не знаю...

    ОтветитьУдалить
  27. Сделал на Indy
    http://nilbag.ru/node/32

    ОтветитьУдалить
  28. Кстати проблему решили, с правильным отображением количества игроков? А то замечал что иногда вместо каково то количество игроков показывает, ненадолго 0 игроков и макс. игроков тоже 0 (ну до того времени пока уменьшится или не увеличится данная цифра). Честно не помню уже все в деталях, т.к. недавно сервер восстановил и решил заодно информер обновить под него.

    P.S. Если что это Николай :)

    ОтветитьУдалить
  29. кста а как насчет списка игроков ) кто то говорил что они дальше там идут и позже сделает :)

    ОтветитьУдалить
  30. у меня сейчас забота как мне на кладбище не попасть.(((

    ОтветитьУдалить
  31. спасибо отличный исходник)я его немного переделал и получился флудильщик на сервере)

    ОтветитьУдалить
  32. listReply поглощает все 10 (#$A) значения с Reply и отображает их как перенос строки.
    потому парсить надо сразу Reply. иначе если игроков допустим 10 то программа покажет 0

    ОтветитьУдалить
  33. Ну, что спустя три года я решил вернуться и оставить еще один комментарий :)
    P.s. Николай (первый комментарий) ^_^

    ОтветитьУдалить
    Ответы
    1. с возвращением)).
      что на этот раз случилось7

      Удалить
    2. Ну что же Вы за 3 года так и не переписали проект ? (

      Удалить
  34. так время такая вещь, которой всегда мало((

    ОтветитьУдалить
    Ответы
    1. Присоединяюсь. + За года интересы и потребности уже меняются. Сейчас уже ушел в iOS разработку, а из Valve на Dota 2 перешел, хотя CS 1.6 это классика уже.. :)

      Удалить
    2. красавец, в моно пишешь или в эклипсе?
      в последнее время, что то игры перестали доставлять удовольствие. хочется чего то другого

      Удалить
    3. Eclipse для Java / Android'a же, а iOS это Objective-C и Xcode соответственно, хотя не панацея тоже. В основном разрабатываю клиенты для всяких веб-проектов, но давно уже к гейм дев'у присматриваюсь. Правда у меня не много не стандартные идеи для игровых проектов.. :)

      Удалить
    4. молодец!!!
      нестандартность-залог успеха.
      однообразность уже всех достала))

      Удалить