Передать поток по сети через indy компоненты
Добавлено: 31.01.2012 18:35:25Пытаюсь написать аналог радмин/vnc.
Помогите решить проблему, плз... Пишу клиент-сервер на lazarus 0.9.30.2. Использую компоненты idTCPClient и idTCPServer (indy 10.5.
. Уже запутался... Не могу сообразить: как как создать поток в idTCPServer, записать в него содержимое компонента Image и передать с сеть, и как потом прочитать этот поток на клиенте, и передать в Image клиента. Пробовал примеры из делфи, но они не подходят.
Код сервера:
Код клиента
Помогите решить проблему, плз... Пишу клиент-сервер на lazarus 0.9.30.2. Использую компоненты idTCPClient и idTCPServer (indy 10.5.
. Уже запутался... Не могу сообразить: как как создать поток в idTCPServer, записать в него содержимое компонента Image и передать с сеть, и как потом прочитать этот поток на клиенте, и передать в Image клиента. Пробовал примеры из делфи, но они не подходят.Код сервера:
- Код: Выделить всё
unit Server;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
LCLIntf, LCLType, IdTCPServer, IdCustomTCPServer, IdContext, idSocketHandle;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
IdTCPServer1: TIdTCPServer;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure IdTCPServer1Execute(AContext: TIdContext);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
//--- включаем сервер ---
procedure TForm1.FormCreate(Sender: TObject);
begin
idTCPServer1.Active:= true;
end;
//--- отключаем сервер ---
procedure TForm1.FormDestroy(Sender: TObject);
begin
idTCPServer1.Active:= false;
end;
//--- получаем картинку удалённого раблчего стола ---
procedure TForm1.Button1Click(Sender: TObject);
var
MyJpeg: TJpegImage;
ScreenDC: HDC;
My_SCR: TStream;
begin
idTCPServer1.Contexts.Create;
MyJpeg:= TJpegImage.Create;
My_SCR:= TMemoryStream.Create;
ScreenDC:= GetDC(0);
MyJpeg.LoadFromDevice(ScreenDC);
My_SCR.Position:= 0;
MyJpeg.SaveToStream(My_SCR);
My_SCR.Free;
MyJpeg.Free;
end;
//--- отправляем картинку ---
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
com_str: string;
begin
with AContext.Connection do
begin
Button1.Click;
end;
end;
Код клиента
- Код: Выделить всё
unit Client;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, LCLIntf, LCLType, IdTCPClient, idSocketHandle;
type
{ TForm1 }
TForm1 = class(TForm)
Bevel1: TBevel;
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
GroupBox1: TGroupBox;
IdTCPClient1: TIdTCPClient;
Image1: TImage;
Label1: TLabel;
Memo1: TMemo;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure IdTCPClient1Connected(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
//--- подключаемся к серверу ---
procedure TForm1.Button1Click(Sender: TObject);
begin
if Edit1.Text = ''then
Memo1.Lines.Add('Ввидите IP адрес сервера')
else
begin
IdTCPClient1.Host:= Edit1.Text;
try
Memo1.Lines.Add('Соединение устанавливается...');
IdTCPClient1.Connect(IdTCPClient1.Host, IdTCPClient1.Port);
Memo1.Lines.Add('Соединение установлено!');
except
Memo1.Lines.Add('Не удалось соединиться с сервером')
end;
end;
end;
//--- Действия выполняемые при соединении с сервером ---
procedure TForm1.IdTCPClient1Connected(Sender: TObject);
begin
Edit1.Enabled:= False;
//начинаем периодически запрашивать данные с сервера
Timer1.Enabled:= True;
//выполним первый запрос, не дожидаясь срабатыввания таймера
Timer1Timer(nil);
end;
//--- Действия при отсоединении от сервера ---
procedure TForm1.Button2Click(Sender: TObject);
begin
Memo1.Lines.Add('Соединение разрывается');
idTCPClient1.Disconnect;
Memo1.Lines.Add('Соединение разорвано');
Edit1.Enabled:= True;
Timer1.Enabled:= False;
end;
//--- Запрос и обработка данных, полученных от сервера ---
procedure TForm1.Timer1Timer(Sender: TObject);
var
MyJpeg: TJpegImage;
stream: TStream;
// My_SCR: TStream;
begin
with idTCPClient1 do
begin
// WriteLn('get_screen');
//--- получаем снимок ---
MyJpeg:= TJpegImage.Create;
stream:= TMemoryStream.Create;
// idTCPClient1.Socket.ReadLn;
// ReadStream(stream);
// stream.Position := 0;
// MyJpeg.LoadFromStream(stream);
stream.Position:= 0;
// My_SCR.Position := 0;
// MyJpeg.SaveToStream(stream);
Image1.Parent.DoubleBuffered:= true;
Image1.Picture.LoadFromStream(stream);
MyJpeg.Free;
stream.Free;
end;
end;
end.