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

Delphi Sources



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

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

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

Ищу исходник програмы показывающий как ожно опрашивать cs 1.6 сервер. Либо сервер cs:source. Если такойе есть, поделитесь пожалуйста. Заранее благодарен!
Ответить с цитированием
  #2  
Старый 16.05.2011, 08:59
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

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

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

как посталь тот же
Цитата:
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)

Последний раз редактировалось Человек_Борща, 16.05.2011 в 09:25.
Ответить с цитированием
  #4  
Старый 16.05.2011, 09:39
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

ну там и без него можно разобраться.
для поиска серверов отправляем широковещательный 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
Человек_Борща Человек_Борща вне форума
Новичок
 
Регистрация: 17.09.2010
Адрес: Беларусь, г. Минск
Сообщения: 58
Версия Delphi: 7, 2010,XE
Репутация: 10
По умолчанию

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

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

Код:
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;
Ответить с цитированием
  #6  
Старый 16.05.2011, 10:00
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

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

Это я уже понял.. вот же проверка:
Код:
  if not (s = '') then
  LogBox.lines.Add('Сервер работает!') else LogBox.lines.Add('Сервер не отвечает!');

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

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

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

Цитата:
Сообщение от Человек_Борща
А сообщение от событие от OnStatus может быть хоть какое-нибудь?
нет. делай так:
-отправляй запрос серверу
-жди секунд 10
-если ответа нет, считай, что он не работает
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #11  
Старый 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?
Ответить с цитированием
  #12  
Старый 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 просмотров)
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #13  
Старый 16.05.2011, 13:23
Человек_Борща Человек_Борща вне форума
Новичок
 
Регистрация: 17.09.2010
Адрес: Беларусь, г. Минск
Сообщения: 58
Версия Delphi: 7, 2010,XE
Репутация: 10
По умолчанию

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

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

Но не понимаю как понимает hEvent, что ему надо вернуть в UDPRead чтобы кусок с waitForSingleObject попал нужный результат..
Ответить с цитированием
  #14  
Старый 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 даже не переходит... что делаю не так?
Ответить с цитированием
  #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.
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
Ответ


Delphi Sources

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

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

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

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


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


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

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

ВКонтакте   Facebook   Twitter