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

Delphi Sources



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

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

я пытаюсь написать функцию проверки...
Код:
function CheckServer(aHost, aPort: string): Boolean;
var
  UPD: TidUDPServer;
  SendData: array of Char;
  s: string;
begin
  Result := False;
  if (aPort = '') or (aHost = '') or (StrToInt(aPort) > 35555) or (StrToInt(aPort) <= 0) then
    Exit;
  UPD := TIdUDPServer.Create(nil);
  try
    UPD.DefaultPort := StrToInt(aPort);
    s := #255#255#255#255'TSource Engine Query'#0;
    SetLength(SendData, Length(s));
    StrPCopy(@sendData[0], s);
    UPD.SendBuffer(aHost, StrToInt(aPort), SendData[0], Length(SendData));
  finally
    FreeAndNil(UPD);
  end;
end;

как привельно её дать процедуру OnRead?
Ответить с цитированием
  #2  
Старый 16.05.2011, 11:46
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

Код:
uses UnitCheckServer;

procedure TForm1.Button100500Click(Sender: TObject);
begin
  if CheckServer('10.4.84.102', 27015) then
    ShowMessage('ok')
  else
    ShowMessage('err');
end;
Вложения
Тип файла: rar UnitCheckServer.rar (1.8 Кбайт, 35 просмотров)
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #3  
Старый 16.05.2011, 13:23
Человек_Борща Человек_Борща вне форума
Новичок
 
Регистрация: 17.09.2010
Адрес: Беларусь, г. Минск
Сообщения: 58
Версия Delphi: 7, 2010,XE
Репутация: 10
По умолчанию

можно глянуть исходник?

Интересна реализация..
При помощи события и waitForSingleObject ...

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

Вот врое как сам пытаюсь..

Код:
unit CheckServerUnit;

interface

uses IdSocketHandle,IdUDPServer,SysUtils,Windows,StdCtrls,Classes;

type
  TServerCheckEvent = class(TObject)
  public
    Result:Boolean;
    hEvent:THandle;
    constructor create;
    destructor Destroy; override;
    procedure OnUDPRead(Sender: TObject; AData: TStream; ABinding: TIdSocketHandle);
  end;


function CheckServer(aHost:string; aPort:Integer; Seconds:Integer):Boolean;

implementation

var
  hEvent:THandle;

function CheckServer(aHost:string; aPort:Integer; Seconds:Integer):Boolean;
var
  UDP:TIdUDPServer;
  Data:array of Char;
  s:string;
  CS:TServerCheckEvent;
  ms:DWORD;
begin
  Result:=False;
    if (aHost = '') or (aPort > 35555) or (aPort <= 0) or (ms <= 0) then
    Exit;
  UDP:=TIdUDPServer.Create(nil);
  CS:=TServerCheckEvent.create;
  UDP.DefaultPort:=35555;
  try
    UDP.OnUDPRead:=CS.OnUDPRead;
    ms:=Seconds*1000; //miliseconds
  s:=#255#255#255#255'TSource Engine Query'#0;
  SetLength(data, Length(s));
  StrPCopy(@data[0], s);
  UDP.SendBuffer(aHost, aPort, data[0], Length(data));
  if (WaitForSingleObject(hEvent,ms)  = WAIT_OBJECT_0) then
  begin
  Result:=True;
  end else
  Result:=False;
  finally
    FreeAndNil(UDP);
    CS.Destroy;
  end;
end;



{ TServerCheckEvent }

constructor TServerCheckEvent.create;
begin
  //Создаём событие
  hEvent:=CreateEvent(nil,True,False,nil);
end;

destructor TServerCheckEvent.Destroy;
begin
  //закрываем
   CloseHandle(hEvent);
  inherited;
end;

procedure TServerCheckEvent.OnUDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
var
  c:Char;
  s:string;
begin
  while AData.Read(c, 1)<>0 do if (c>=#32) and (c<=#255) then s:=s+c;
  If(s = '') then
  ResetEvent(hEvent)
  else
  SetEvent(hEvent);
end;

но всегда false а в процедуру UDPRead даже не переходит... что делаю не так?
Ответить с цитированием
  #5  
Старый 16.05.2011, 14:23
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

Код:
unit UnitCheckServer;

{$DEBUGINFO OFF}

interface

uses
  IdSocketHandle, IdUDPServer,
  Windows, Messages,
  SysUtils, Classes;

type
  TCheckServerObject = class
    Result: Boolean;
    HEvent: THandle;
    constructor Create;
    destructor Destroy; override;
    procedure UDPRead(Sender: TObject; AData: TStream;
      ABinding: TIdSocketHandle);
  end;

function CheckServer(const AHost: String; const APort: Integer;
  const Milliseconds: DWORD = 10000): Boolean;

implementation

function CheckServer(const AHost: String; const APort: Integer;
  const Milliseconds: DWORD = 10000): Boolean;
var
  CheckServerObject: TCheckServerObject;
  UDPServer: TIdUDPServer;
  data: array of Char;
  s: String;
begin
  CheckServerObject:=TCheckServerObject.Create;
  UDPServer:=TIdUDPServer.Create(nil);
  UDPServer.ThreadedEvent:=True;
  UDPServer.OnUDPRead:=CheckServerObject.UDPRead;
  try
    UDPServer.DefaultPort:=APort;
    s:=#255#255#255#255'TSource Engine Query'#0;
    SetLength(data, Length(s));
    StrPCopy(@data[0], s);
    UDPServer.SendBuffer(AHost, APort, data[0], Length(data));
    WaitForSingleObject(CheckServerObject.HEvent, Milliseconds);
    Result:=CheckServerObject.Result;
  finally
    UDPServer.Free;
    CheckServerObject.Free;
  end;
end;

constructor TCheckServerObject.Create;
begin
  inherited Create;
  Result:=False;
  HEvent:=CreateEvent(nil, True, False, nil);
end;

destructor TCheckServerObject.Destroy;
begin
  CloseHandle(HEvent);
  inherited Destroy;
end;

procedure TCheckServerObject.UDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
begin
  Result:=True;
  SetEvent(HEvent);
end;

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

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

вылетает AV о невозможности переключится на задаваемый aPort порт для UDP сервера.
Ответить с цитированием
  #7  
Старый 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.
Ответить с цитированием
Ответ


Delphi Sources

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

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

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

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


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


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025