Текущий архив: 2011.11.13;
Скачать: CL | DM;

Вниз

Сокеты. Гарантированное соединение. структура кода   Найти похожие ветки 

← →
Pcrepair ©   (2011-07-18 19:17) [0]

Добрый день! Продолжается разработка клиент-серверного приложения типа РАДМИН (D2010 + INDY10)
Предыдущая версия работает, но работает не по правилам - постоянно идет коннект-дисконект с сервером при передаче скрина экрана сервера и передаче данных мыши с клиента на сервер. Из-за этого идет торможение, дерганье экрана. Надо это исправить

Клиент должен работать следующим образом:
- при нажатии на кнопку CONNECT клиент подключается к серверу
- таймер (а может можно как то синхронизировать с дисплеем, чтоб изображение не дергалось?) отправляет на сервер координаты курсора мыши и информацию о нажатии кнопок мыши клиента, далее отправляет запросы на сервер о пересылке файла со скрином экрана сервера каждые 20 мС (или с частотой обновления экрана?) и отображает на TImage полученный файл
- это должно продолжаться пока не пойдет команда на отключение клиента от сервера оператором. вопрос - правильно ли это? постоянное подключение к серверу? MSRDP Client именно так ведь и работает
- при повторном нажатии на кнопку CONNECT, клиент отключается от сервера

Подскажите структуру кода клиента, обеспечивающую:
- гарантированное соединение клиента с сервером, при разрыве автоматически восстанавливающее соединение
- вывод сообщения, наверно на компонент LABEL? о разрыве соединения. или в отдельное модальное окно? как правильно?

пока есть вот такой код

unit main;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ComCtrls, ExtCtrls, IdBaseComponent, IdComponent,
 IdTCPConnection, IdTCPClient, Zlib;

type
 TForm1 = class(TForm)
   PageControl1: TPageControl;
   TabSheet1: TTabSheet;
   TabSheet2: TTabSheet;
   TabSheet3: TTabSheet;
   TabSheet4: TTabSheet;
   TabSheet5: TTabSheet;
   TabSheet6: TTabSheet;
   TabSheet7: TTabSheet;
   TabSheet8: TTabSheet;
   TabSheet9: TTabSheet;
   TabSheet10: TTabSheet;
   HOST: TEdit;
   PortNumber: TEdit;
   Label1: TLabel;
   Label2: TLabel;
   Label3: TLabel;
   Button1: TButton;
   Image1: TImage;
   IdTCPClient1: TIdTCPClient;
   Timer1: TTimer;
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
   procedure connect_to_server;
   procedure DecompressStream; //декомпрессия сжатого на стороне сервера файл.бмп
 end;

var
 Form1: TForm1;
 Stream: TMemoryStream;

implementation

{$R *.dfm}

procedure TForm1.DecompressStream;
var
pOut: Pointer;
outSize: Integer;
begin
ZDecompress(Stream.Memory, Stream.Size, pOut, outSize);
try
    Stream.Clear;
  Stream.WriteBuffer(pOut^, outSize);
finally
  FreeMem(pOut);
end;
end;

procedure TForm1.connect_to_server;
begin
IdTCPClient1.Host:=HOST.Text;
IdTCPClient1.Port:=StrToInt(PortNumber.Text);
IdTCPClient1.Connect;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  connect_to_server;
end;

end.

как то тут надо написать типа
with IdTCPClient1 do
или
while connected do
в общем, нужна подсказка

---

← →
SQLEXPRESS   (2011-07-19 08:35) [1]

скачайте любой с исходником и смотрите как сделано там
Вы извините уж за резкость, но писать радмин и постить TForm1 = class(TForm), интересоваться на лабель ли выводить или куда еще - несерьезно, как минимум

---

← →
Сергей М. ©   (2011-07-19 10:15) [2]

> Из-за этого идет торможение, дерганье экрана


Не только из-за этого, хотя и в том числе.
Бессмысленно передавать кадр целиком, если в нем по отношению к предыдущему кадру изменился блок в сотню-другую смежных пикселов. Его и надо жать и передавать, а на принимающей стороне соотв.образом обновлять кадр, показываемый юзеру. Обнаружением изменившихся участков растра занимаются зеркальные видеодрайвера (mirror drivers)

---

← →
Pcrepair ©   (2011-07-19 12:55) [3]

> Бессмысленно передавать кадр целиком, если в нем по отношению
> к предыдущему кадру изменился блок в сотню-другую смежных
> пикселов.


на самом деле все немного сложнее. нужен скрин экрана сервера целиком, для последующей обработки граф. файла в OCR. РАДМИН - это типа контрольный режим для процесса настройки, чтоб знать что есть соединение с сервером. никто и не собирался вилосипед изабритать.
возвращаясь к теме: как же все таки правильно обеспечить гарантированное подключение клиента к серверу в течение очень большого временного интервала - может недели. какая должна быть структура кода?

---

← →
SQLEXPRESS   (2011-07-19 12:59) [4]

имхо,
соединение рвется обычно самой OC, если ничего не происходит
значит, надо что бы происходило.
определить некий Idle и на onIdle спрашивать что-то, например, сколько будет 1+1.

---

← →
Pcrepair ©   (2011-07-19 13:10) [5]

> соединение рвется обычно самой OC, если ничего не происходит

вот это уже ближе к теме
временные интервалы между запросами скрина экрана сервера в рабочем режиме (с учетом обработки файла) могут составлять от... и до десятков минут

у кого то есть достоверная информация что ОС может принудительно закрывать сокет стороннего приложения, или это догадки?

---

← →
Сергей М. ©   (2011-07-19 13:36) [6]

> информация что ОС может принудительно закрывать сокет стороннего
> приложения


Какого такого "стороннего" ?
Ни одно приложение, исполняющееся под управлением ОС, "сторонним" для этой ОС не является, все эти приложения - "родные дети" для этой ОС.

Сокет закрывается и уничтожается
- либо по инициативе процесса , его создавшего
- либо по инициативе ОС, видящей что процесс завершился или "умер", не закрыв и не уничтожив перед этим созданные и открытые им сокеты.

---

← →
DiamondShark ©   (2011-07-19 15:18) [7]

> нужен скрин экрана сервера целиком, для последующей обработки
> граф. файла в OCR.

Да какая разница, для чего нужен экран?
Если изменилась только часть изображения, то и передавать надо только часть.

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

---

← →
Palladin ©   (2011-07-19 23:40) [8]

персонаж уже полгода бредит... ничего незная написать, что бы продать разумеется... да еще поди госструктурам... они на откад падкие.... хотя дальше Форм1 не пошол... а вы все ведетесь...

---

← →
Pcrepair ©   (2011-07-20 07:54) [9]

точно
эта для сколокова
цена проекта - мулльяад баксов

---

← →
Pcrepair ©   (2011-07-20 19:23) [10]

но сейчас речь не об этом
почему то при использовании ИНДИ10 (сервер-клиент) при установлении соединения с сервером удается передать на сервер только одну команду, остальные команды из клиента не выполняются.
приходится разрывать соединение и по новой его устанавливать для передачи следующей команды в сервер
кто то может дать комментарий?

---

← →
DiamondShark ©   (2011-07-21 10:52) [11]

> кто то может дать комментарий?

Да нет проблем.
Коментарий: У вас в программе ошибка.

Неконкретно? Ну уж извините. Кода отправки и получения сообщений ещё никто не видел. Всё какие-то невнятные огрызки.
Никого не интересуют ваши табшиты, батоны и лейблы. Напишите минимальный рабочий код, который можно скопировать, скомпилировать и попробовать. Или визуально разобрать. А с вашими портянками вида
TabSheet1: TTabSheet;
   TabSheet2: TTabSheet;
   TabSheet3: TTabSheet;
   TabSheet4: TTabSheet;
   TabSheet5: TTabSheet;
   TabSheet6: TTabSheet;
   TabSheet7: TTabSheet;
   TabSheet8: TTabSheet;
   TabSheet9: TTabSheet;
   TabSheet10: TTabSheet;
никто ковыряться не будет.

---

← →
Pcrepair ©   (2011-07-21 12:48) [12]

нет проблем
вот упрощенная версия клиента, который постоянно делает коннек-дисконнект

///+++++++++++++++++++++++++++++PROCEDURE++++++++++++++++++++++++++++++++++++++

procedure TForm1.connect_to_server;
begin
IdTCPClient1.Host:=HOST.Text;
IdTCPClient1.Port:=StrToInt(PortNumber.Text);
IdTCPClient1.Connect;
end;

procedure TForm1.GetScreen;
var
Bitmap: TBitmap;
begin
IdTCPClient1.IOHandler.WriteLn("get_screen ");
with IdTCPClient1 do
begin
 FreeAndNil(Stream);
Stream := TMemoryStream.Create;
  while connected do
       IdTCPClient1.IOHandler.ReadStream(Stream,-1,true);
       Image1.Picture:=nil;
       Bitmap := TBitmap.Create;
         try
         Stream.Position := 0;
         Bitmap.LoadFromStream(Stream);
           Image1.Picture.Bitmap.Assign(Bitmap);
         finally
            Bitmap.Free;
         end;
     IdTCPClient1.Disconnect;
end;
end;

procedure TForm1.mouse_move;
var
Kursor:TPoint;
begin
 IdTCPClient1.IOHandler.WriteLn("mouse_move ");
 GetCursorPos(Kursor);
 IdTCPClient1.IOHandler.WriteLn("mouse_x "+IntToStr(Kursor.X));
 IdTCPClient1.IOHandler.WriteLn("mouse_y "+IntToStr(Kursor.Y));
 IdTCPClient1.Disconnect;
end;

///+++++++++++++++++++++++++++++PROCEDURE++++++++++++++++++++++++++++++++++++++
///+++++++++++++++++PROG++++++++++++++++++++++++++++++++++++++++++++++++++

procedure TForm1.connectClick(Sender: TObject);
begin
if connect.Caption="Connect" then
 begin
  connect.Caption:="DisConnect";
  Timer1.Enabled:=true;
 end
else
 begin
  connect.Caption:="Connect";
  Timer1.Enabled:=false;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin

 connect_to_server;
 mouse_move;

 connect_to_server;
 GetScreen;

end;

end.


если убрать из процедур IdTCPClient1.Disconnect; и поместить его в конец тамера

procedure TForm1.Timer1Timer(Sender: TObject);
begin

 connect_to_server;
 mouse_move;
 GetScreen;
     IdTCPClient1.Disconnect; - вот тут
end;


тогда не проходит картинка экрана при вызове GetScreen; при некоторых комбинациях выскакивает ошибка - соединение великолепно закрылось

вот код сервера

////+++++++++++++++ PROCEDURE +++++++++++++++++++++++++++++++++++++++++++++

procedure TForm1.Log(S:string);
begin
Memo1.Lines.Add(TimeToStr(Time)+"  "+S);
end;

procedure TForm1.GET_SCREEN;
var
 Desktop: TCanvas;
 B: TBitmap;
 W, H :Integer;
 Kursor:TPoint;
 TempRect:TRect;
begin
GetCursorPos(Kursor);
W:=Screen.Width;
H:=screen.Height;
TempRect:=Rect(Kursor.x,Kursor.y,Kursor.x+10,Kursor.y+10);
B:=TBitmap.Create;
B.Width:=W;
B.Height:=H;
Desktop:=TCanvas.Create;
try
 with Desktop do
  Handle := GetWindowDC(GetDesktopWindow);
  with B.Canvas do
   begin
    Brush.Color:=clGreen;
    CopyRect (Rect (0, 0, w, h),
              DeskTop,
              Rect (0, 0, w, h));
    FillRect(TempRect);
   end;
  FreeAndNil(Stream);
  Stream := TMemoryStream.create;
    B.SaveToStream(Stream);
finally
 DeskTop.Free;
 B.Free;
end;
end;
////+++++++++++++++ PROCEDURE +++++++++++++++++++++++++++++++++++++++++++++

////+++++++++++++++ PROGRAM +++++++++++++++++++++++++++++++++++++++++++++

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
 z: string;
 X,Y:integer;
 K:TPoint;

 begin
  z := AContext.Connection.IOHandler.ReadLn;
  if SameText(Copy(z, 1, 11), "get_screen ") then
  begin
   Log("Запрошен скриншот");
   GET_SCREEN;
     AContext.Connection.IOHandler.WriteBufferOpen(Stream.size);
   Log("Передаем файл s.bmp");
   AContext.Connection.IOHandler.Write(Stream);
   Log("Файл передан");
   AContext.Connection.IOHandler.Close;
  end;

begin
 with AContext.Connection do
  if SameText(Copy(z, 1, 11), "mouse_move ") then
  begin
   z := AContext.Connection.IOHandler.ReadLn;
   if SameText(Copy(z, 1, 8), "mouse_x ") then
   X:=StrToInt(Copy(z,9,4));
   z := AContext.Connection.IOHandler.ReadLn;
   if SameText(Copy(z, 1, 8), "mouse_y ") then
   Y:=StrToInt(Copy(z,9,4));
   Log("Перемещение мыши");
   SetCursorPos(X,Y);
 end;
 AContext.Connection.Disconnect;
end;
end;

end.
////+++++++++++++++ PROGRAM +++++++++++++++++++++++++++++++++++++++++++++

в общем по таймеру соединение открывается, но только для отсылки одной команды с клиента на сервер, если команд две, то одна из них неправильно выполняется или вообще не выполняется

---

← →
Сергей М. ©   (2011-07-21 20:57) [13]

> если команд две, то одна из них неправильно выполняется
> или вообще не выполняется


procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
..
begin
 z := AContext.Connection.IOHandler.ReadLn;
 if SameText(Copy(z, 1, 11), "get_screen ") then
 begin
  Log("Запрошен скриншот");
  GET_SCREEN;
    AContext.Connection.IOHandler.WriteBufferOpen(Stream.size);
  Log("Передаем файл s.bmp"); // за это расстрел - записсь в Мемо происходит НЕ в основном потоке.
  AContext.Connection.IOHandler.Write(Stream);
  Log("Файл передан"); // за это контрольный выстрел
  AContext.Connection.IOHandler.Close; // это ЧТО ? И после ЭТОГО ты еще удивляешься ?)
 end;
...

end;

---

← →
Pcrepair ©   (2011-07-23 17:37) [14]

> AContext.Connection.IOHandler.Close; // это ЧТО ? И после
> ЭТОГО ты еще удивляешься ?)
>  end;
> ...

не хочется тебя огорчать, но прийдется - без этой строки соединение клиент-сервер виснет, а со строкой - все работает как положено

вот целиком рабочий код компонента СЕРВЕР ТСП

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
 z: string;
 X,Y:integer;
 K:TPoint;

 begin
 z := AContext.Connection.IOHandler.ReadLn;
 if SameText(Copy(z, 1, 11), "mouse_move ") then
  begin
   z := AContext.Connection.IOHandler.ReadLn;
   if SameText(Copy(z, 1, 8), "mouse_x ") then
   X:=StrToInt(Copy(z,9,4));
   z := AContext.Connection.IOHandler.ReadLn;
   if SameText(Copy(z, 1, 8), "mouse_y ") then
   Y:=StrToInt(Copy(z,9,4));
   Log("Перемещение мыши");
   SetCursorPos(X,Y);
 end;

 begin
  z := AContext.Connection.IOHandler.ReadLn;
  if SameText(Copy(z, 1, 11), "get_screen ") then
  begin
   Log("Запрошен скриншот");
   GET_SCREEN;
   AContext.Connection.IOHandler.WriteBufferOpen(Stream.size);
   Log("Передаем файл s.bmp");
   AContext.Connection.IOHandler.Write(Stream);
   Log("Файл передан");
   AContext.Connection.IOHandler.Close;
 end;
end;
end;



---

← →
Palladin ©   (2011-07-23 20:55) [15]

> Сергей М. ©   (21.07.11 20:57) [13]

вот так вот... не хотел тебя человек огорчать...

---

← →
Сергей М. ©   (2011-07-25 09:22) [16]

> а со строкой - все работает как положено
>


Ну если "все работает как положено", тогда к чему ты всю  эту бодягу развел ?)
Ну работает оно себе и работает - и аминь)

---

Страницы: 1 вся ветка

Текущий архив: 2011.11.13;
Скачать: CL | DM;

Наверх

Память: 0.53 MB
Время: 0.012 c