Показать сообщение отдельно
  #15  
Старый 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.
__________________
Пишу программы за еду.
__________________
Ответить с цитированием