[Поиск] Исходники мониторинга cs 1.6,css серверов

Человек_Борща · #1 16.05.2011, 01:26

Здравствуйте!

Ищу исходник програмы показывающий как ожно опрашивать cs 1.6 сервер. Либо сервер cs:source. Если такойе есть, поделитесь пожалуйста. Заранее благодарен!

NumLock · #2 16.05.2011, 08:59

Мониторинг серверов cs 1.6 глянь

Человек_Борща · #3 16.05.2011, 09:12

уже смотрел. сылка на сырец не пашет. Смотрю доки по запросам к серверу. Я не имею понятия как их посылать....
Допусти как проверит что сервер жив?

как посталь тот же

Цитата:

A2A_PING
Ping the server to see if it exists, this can be used to calculate the latency to the server.

Request format Data Type Value
Heading byte 'i' (0x69)

Reply format
Goldsource servers Data Type Value
Heading byte 'j' (0x6A)
Content string Null

Source servers Data Type Value
Heading byte 'j' (0x6A)

NumLock · #4 16.05.2011, 09:39

ну там и без него можно разобраться.
для поиска серверов отправляем широковещательный udp:
IdUDPServer1.Broadcast(#255#255#255#255'TSource Engine Query'#0, 27015);
затем в OnUDPRead у IdUDPServer ловим ответы всех найденых серверов.

Код:

unit Unit1;

interface

uses
  IdSocketHandle,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdUDPBase, IdUDPServer;

type
  TForm1 = class(TForm)
    IdUDPServer1: TIdUDPServer;
    MemoServers: TMemo;
    Button1: TButton;
    procedure IdUDPServer1UDPRead(Sender: TObject; AData: TStream;
      ABinding: TIdSocketHandle);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.IdUDPServer1UDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
var
  c: Char;
  s: String;
begin
  MemoServers.Lines.Add(ABinding.PeerIP+':'+IntToStr(ABinding.PeerPort));
  while AData.Read(c, 1)<>0 do if (c>=#32) and (c<=#255) then s:=s+c;
  MemoServers.Lines.Add(s);
end;

procedure TForm1.Button1Click(Sender: TObject);
//var
//  data: array of Char;
//  s: String;
begin
  IdUDPServer1.Broadcast(#255#255#255#255'TSource Engine Query'#0, 27015);
{
  IdUDPServer1.DefaultPort:=27015;
  s:=#255#255#255#255'TSource Engine Query'#0;
  SetLength(data, Length(s));
  StrPCopy(@data[0], s);
  IdUDPServer1.SendBuffer('10.4.84.102', 27015, data[0], Length(data));
}
end;

end.

только, как я уже писал, для какого это протокола не помню. да и не в этом суть...

Человек_Борща · #5 16.05.2011, 09:57

Допустим а если сервера по указаному порту не существует? как это определить?

Определяет что сервер только работает. А вот что он не работает, программа не пишет.

Код:

procedure TForm1.ConnectBtnClick(Sender: TObject);
var
  data: array of Char;
     s: String;
begin
  UPD.Broadcast(#255#255#255#255'TSource Engine Query'#0, 27020);
  UPD.DefaultPort:=27020;
  s:=#255#255#255#255'TSource Engine Query'#0;
  SetLength(data, Length(s));
  StrPCopy(@data[0], s);
  UPD.SendBuffer('10.1.22.95', 27020, data[0], Length(data));
end;

procedure TForm1.UPDUDPRead(Sender: TObject; AData: TStream; ABinding: TIdSocketHandle);
var
  c: Char;
  s: String;
begin
  //LogBox.lines.Add(ABinding.PeerIP+':'+IntToStr(ABinding.PeerPort));
  s:='';
  while AData.Read(c, 1)<>0 do if (c>=#32) and (c<=#255) then s:=s+c;
  if not (s = '') then
  LogBox.lines.Add('Сервер работает!') else LogBox.lines.Add('Сервер не отвечает!');

end;

procedure TForm1.UPDStatus(ASender: TObject; const AStatus: TIdStatus;
  const AStatusText: String);
begin
LogBox.Lines.Add(AStatusText);
end;

NumLock · #6 16.05.2011, 10:00

ну так если сервер не ответит значит он и не работает

Человек_Борща · #7 16.05.2011, 10:03

Это я уже понял.. вот же проверка:

Код:

  if not (s = '') then
  LogBox.lines.Add('Сервер работает!') else LogBox.lines.Add('Сервер не отвечает!');

но ничего не происходит. И в onStatus тоже ничего не происходит. А вот когда сервер работает, инфа приходит.. и видно сообщение "сервер работает" в случае что он отключен должно быть "сервер не работает!"

NumLock · #8 16.05.2011, 10:08

все правильно - никакого события UPDUDPRead не будет вообще, т.к. сервер ничего не отправит - он же не работает!!! протокол UDP работает без установки соединения!!!

Человек_Борща · #9 16.05.2011, 10:11

хорошо. А сообщение от событие от OnStatus может быть хоть какое-нибудь?

NumLock · #10 16.05.2011, 10:21

Цитата:

Сообщение от Человек_Борща

А сообщение от событие от OnStatus может быть хоть какое-нибудь?

нет. делай так:
-отправляй запрос серверу
-жди секунд 10
-если ответа нет, считай, что он не работает

Человек_Борща · #11 16.05.2011, 11:03

я пытаюсь написать функцию проверки...

Код:

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?

NumLock · #12 16.05.2011, 11:46

Код:

uses UnitCheckServer;

procedure TForm1.Button100500Click(Sender: TObject);
begin
  if CheckServer('10.4.84.102', 27015) then
    ShowMessage('ok')
  else
    ShowMessage('err');
end;

Человек_Борща · #13 16.05.2011, 13:23

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

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

Но не понимаю как понимает hEvent, что ему надо вернуть в UDPRead чтобы кусок с waitForSingleObject попал нужный результат..

Человек_Борща · #14 16.05.2011, 14:17

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

Код:

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 даже не переходит... что делаю не так?

NumLock · #15 16.05.2011, 14:23

Код:

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.

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	RSS лента	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Новости сайта Новости форума	Ссылки и Баннеры Donate О сайте Реклама Контакты