Форум по программированию Delphi Sources

 



Вернуться   Форум по программированию Delphi Sources > Разное > Исходники и статьи
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #16  
Старый 16.05.2011, 14:35
Человек_Борща Человек_Борща вне форума
Новичок
 
Регистрация: 17.09.2010
Адрес: Беларусь, г. Минск
Сообщения: 58
Версия Delphi: 7, 2010,XE
Репутация: 10
По умолчанию

Практически удагадал.. и не вызывал стд. обработчик. Видать на этом и замирало все. Кстати из за одинаковых портов:
Код:
    //UDPServer.DefaultPort:=APort;

вылетает AV о невозможности переключится на задаваемый aPort порт для UDP сервера.
Ответить с цитированием
  #17  
Старый 03.07.2011, 02:49
crash94 crash94 вне форума
Прохожий
 
Регистрация: 08.07.2009
Адрес: Архангельск
Сообщения: 26
Версия Delphi: 7
Репутация: 10
По умолчанию

Код:
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;

Готовый...Исходник ниже

Поизменял,получилось такое вот чудо

Последний раз редактировалось Admin, 03.07.2011 в 13:30.
Ответить с цитированием
  #18  
Старый 09.01.2012, 23:51
Alex_Gordon Alex_Gordon вне форума
Прохожий
 
Регистрация: 21.02.2011
Сообщения: 19
Репутация: 10
По умолчанию

Извините, что поднимаю эту тему, но я заметил, что эта программа не опрашивает серверы Day of defeat: Source и Team Fortress 2. Пожалуйста, помогите опрашивать и их!
Ответить с цитированием
Ответ



Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 11:07.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources", 2004-2019

ВКонтакте   Facebook   Twitter