![]() |
|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
![]() |
|
Опции темы | Поиск в этой теме | Опции просмотра |
|
#1
|
|||
|
|||
![]() я пытаюсь написать функцию проверки...
Код:
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
|
||||
|
||||
![]() Код:
uses UnitCheckServer; procedure TForm1.Button100500Click(Sender: TObject); begin if CheckServer('10.4.84.102', 27015) then ShowMessage('ok') else ShowMessage('err'); end; Пишу программы за еду. __________________ |
#3
|
|||
|
|||
![]() можно глянуть исходник?
![]() Интересна реализация.. При помощи события и waitForSingleObject ... Но не понимаю как понимает hEvent, что ему надо вернуть в UDPRead чтобы кусок с waitForSingleObject попал нужный результат.. |
#4
|
|||
|
|||
![]() Вот врое как сам пытаюсь..
Код:
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
|
||||
|
||||
![]() Код:
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
|
|||
|
|||
![]() Практически удагадал.. и не вызывал стд. обработчик. Видать на этом и замирало все. Кстати из за одинаковых портов:
Код:
//UDPServer.DefaultPort:=APort; вылетает AV о невозможности переключится на задаваемый aPort порт для UDP сервера. |
#7
|
|||
|
|||
![]() Код:
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. |