unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    imgScreen: TImage;
    GroupBox1: TGroupBox;
    txtServer: TEdit;
    IdTCPClient1: TIdTCPClient;
    cmbConnect: TButton;
    GroupBox2: TGroupBox;
    Label1: TLabel;
    Label3: TLabel;
    lblResolution: TLabel;
    lblColors: TLabel;
    Timer1: TTimer;
    procedure cmbConnectClick(Sender: TObject);
    procedure IdTCPClient1Connected(Sender: TObject);
    procedure IdTCPClient1Disconnected(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.cmbConnectClick(Sender: TObject);
begin
  if (cmbConnect.Caption = 'Подключиться') then
  begin
    if (txtServer.Text = '') then
      //Не введено имя сервера
      MessageDlg('Введите имя машины-сервера в текстовое поле',
       mtInformation, [mbOK], 0)
    else begin
      //Подключаемся к серверу
      IdTCPClient1.Host := txtServer.Text;
      try
        IdTCPClient1.Connect;
      except
        MessageDlg('Не удается соединиться с указанным сервером',
         mtError, [mbOK], 0);
        Exit;
      end;
    end
  end
  else begin
    //Отключается от сервера
    IdTCPClient1.Disconnect;
  end;
end;

procedure TForm1.IdTCPClient1Connected(Sender: TObject);
begin
  txtServer.Enabled := False;
  cmbConnect.Caption := 'Отключиться';
  //Начинаем периодически запрашивать данные с сервера
  Timer1.Enabled := True;
  //Выполним первый запрос сами
  Timer1Timer (Nil);
end;

procedure TForm1.IdTCPClient1Disconnected(Sender: TObject);
begin
  txtServer.Enabled := True;
  cmbConnect.Caption := 'Подключиться';
  Timer1.Enabled := False;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  stream: TMemoryStream;
begin
  //Запрашиваем у сервера данные о наблюдаемом компьютере
  with (IdTCPClient1) do
  begin
    //...разрешение
    WriteLn('get_screen_width');
    WriteLn('get_screen_height');
    lblResolution.Caption := IntToStr(ReadInteger) + 'x'
     + IntToStr(ReadInteger);

    //...глубина цвета
    WriteLn('get_screen_colors');
    lblColors.Caption := IntToStr(ReadInteger);

    //...копия экрана
    //.....первый вариант - копирование экрана без сжатия
//    WriteLn('get_screen');
    //.....второй вариант - сжатие на стороне сервера
    WriteLn('get_screen:' + IntToStr(imgScreen.Width) + ',' +
     IntToStr(imgScreen.Height));
    //....получаем данные
    stream := TMemoryStream.Create;
    ReadStream(stream);
    stream.Position := 0;
    //....формируем изображение
    imgScreen.Picture.Bitmap.LoadFromStream(stream);
    stream.Clear;
    stream.Free;
  end;

end;

end.
