| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Сокеты. Гарантированное соединение. структура кода
Pcrepair © (2011-07-18 19:17:00)Добрый день! Продолжается разработка клиент-серверного приложения типа РАДМИН (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
в общем, нужна подсказка
Сергей М. (2011-07-25 09:22:00) [1]
> а со строкой - все работает как положено
>
Ну если "все работает как положено", тогда к чему ты всю эту бодягу развел ?)
Ну работает оно себе и работает - и аминь)
Palladin (2011-07-23 20:55:00) [2]
> Сергей М. © (21.07.11 20:57) [13]
вот так вот... не хотел тебя человек огорчать...
Pcrepair (2011-07-23 17:37:00) [3]
> 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;
Сергей М. (2011-07-21 20:57:00) [4]
> если команд две, то одна из них неправильно выполняется
> или вообще не выполняется
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-21 12:48:00) [5]нет проблем
вот упрощенная версия клиента, который постоянно делает коннек-дисконнект
///+++++++++++++++++++++++++++++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 +++++++++++++++++++++++++++++++++++++++++++++
в общем по таймеру соединение открывается, но только для отсылки одной команды с клиента на сервер, если команд две, то одна из них неправильно выполняется или вообще не выполняется
DiamondShark (2011-07-21 10:52:00) [6]
> кто то может дать комментарий?
Да нет проблем.
Коментарий: У вас в программе ошибка.
Неконкретно? Ну уж извините. Кода отправки и получения сообщений ещё никто не видел. Всё какие-то невнятные огрызки.
Никого не интересуют ваши табшиты, батоны и лейблы. Напишите минимальный рабочий код, который можно скопировать, скомпилировать и попробовать. Или визуально разобрать. А с вашими портянками вида
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
TabSheet4: TTabSheet;
TabSheet5: TTabSheet;
TabSheet6: TTabSheet;
TabSheet7: TTabSheet;
TabSheet8: TTabSheet;
TabSheet9: TTabSheet;
TabSheet10: TTabSheet;
никто ковыряться не будет.
Pcrepair (2011-07-20 19:23:00) [7]но сейчас речь не об этом
почему то при использовании ИНДИ10 (сервер-клиент) при установлении соединения с сервером удается передать на сервер только одну команду, остальные команды из клиента не выполняются.
приходится разрывать соединение и по новой его устанавливать для передачи следующей команды в сервер
кто то может дать комментарий?
Pcrepair (2011-07-20 07:54:00) [8]точно
эта для сколокова
цена проекта - мулльяад баксов
Palladin (2011-07-19 23:40:00) [9]персонаж уже полгода бредит... ничего незная написать, что бы продать разумеется... да еще поди госструктурам... они на откад падкие.... хотя дальше Форм1 не пошол... а вы все ведетесь...
DiamondShark (2011-07-19 15:18:00) [10]
> нужен скрин экрана сервера целиком, для последующей обработки
> граф. файла в OCR.
Да какая разница, для чего нужен экран?
Если изменилась только часть изображения, то и передавать надо только часть.
Весь экран нужен только при первом старте или при восстановлении при сбое соединения, т.е., чуть более, чем никогда.
Сергей М. (2011-07-19 13:36:00) [11]
> информация что ОС может принудительно закрывать сокет стороннего
> приложения
Какого такого "стороннего" ?
Ни одно приложение, исполняющееся под управлением ОС, "сторонним" для этой ОС не является, все эти приложения - "родные дети" для этой ОС.
Сокет закрывается и уничтожается
- либо по инициативе процесса , его создавшего
- либо по инициативе ОС, видящей что процесс завершился или "умер", не закрыв и не уничтожив перед этим созданные и открытые им сокеты.
Pcrepair (2011-07-19 13:10:00) [12]
> соединение рвется обычно самой OC, если ничего не происходит
вот это уже ближе к теме
временные интервалы между запросами скрина экрана сервера в рабочем режиме (с учетом обработки файла) могут составлять от... и до десятков минут
у кого то есть достоверная информация что ОС может принудительно закрывать сокет стороннего приложения, или это догадки?
SQLEXPRESS (2011-07-19 12:59:00) [13]имхо,
соединение рвется обычно самой OC, если ничего не происходит
значит, надо что бы происходило.
определить некий Idle и на onIdle спрашивать что-то, например, сколько будет 1+1.
Pcrepair (2011-07-19 12:55:00) [14]
> Бессмысленно передавать кадр целиком, если в нем по отношению
> к предыдущему кадру изменился блок в сотню-другую смежных
> пикселов.
на самом деле все немного сложнее. нужен скрин экрана сервера целиком, для последующей обработки граф. файла в OCR. РАДМИН - это типа контрольный режим для процесса настройки, чтоб знать что есть соединение с сервером. никто и не собирался вилосипед изабритать.
возвращаясь к теме: как же все таки правильно обеспечить гарантированное подключение клиента к серверу в течение очень большого временного интервала - может недели. какая должна быть структура кода?
Сергей М. (2011-07-19 10:15:00) [15]
> Из-за этого идет торможение, дерганье экрана
Не только из-за этого, хотя и в том числе.
Бессмысленно передавать кадр целиком, если в нем по отношению к предыдущему кадру изменился блок в сотню-другую смежных пикселов. Его и надо жать и передавать, а на принимающей стороне соотв.образом обновлять кадр, показываемый юзеру. Обнаружением изменившихся участков растра занимаются зеркальные видеодрайвера (mirror drivers)
SQLEXPRESS (2011-07-19 08:35:00) [16]скачайте любой с исходником и смотрите как сделано там
Вы извините уж за резкость, но писать радмин и постить TForm1 = class(TForm), интересоваться на лабель ли выводить или куда еще - несерьезно, как минимум
| |
