unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    IdTCPServer1: TIdTCPServer;
    Timer1: TTimer;
    procedure IdTCPServer1Execute(AThread: TIdPeerThread);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{Процедура снимает копию экрана, преобразует полученной изображение к
заданному размеру и отправляет преобразованное изображение клиентской
программе}
procedure SendScreen(width: Integer; height: Integer;
 Connection: TIdTCPServerConnection);
var
  ScreenCopy: TCanvas;
  gr: TBitmap;
  stream: TMemoryStream;
  rcDest, rcSource: TRect;
begin
  rcDest := Rect(0, 0, width, height);  //Конечный размер изображения
  rcSource := Screen.DesktopRect;       //Исходный размер изображения

  //Создаем канву и присоединяем ее к контексту рабочего стола
  ScreenCopy := TCanvas.Create;
  ScreenCopy.Handle := GetDC(0);
  //Создаем объект для хранения копии экрана и копируем изображение
  gr := TBitmap.Create;
  gr.Height := height;
  gr.Width := width;
  gr.Canvas.CopyRect(rcDest, ScreenCopy,rcSource);
  ReleaseDC(0, ScreenCopy.Handle);
  //Сохраняем изображение в поток данных
  stream := TMemoryStream.Create;
  gr.SaveToStream(stream);
  //Отправляем изображение клиенту
  Connection.WriteStream(stream,True,True);

  stream.Clear;
  stream.Free;
  gr.Free;
end;

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var
  strText: string;
  width, height, i: Integer;
  dc: HDC;
begin
  //Принимаем от клиента строку
  strText := AThread.Connection.ReadLn;
  //Определяем, что нужно выполнить
  if (strText = 'get_screen_height') then
    //Возвратим высоту экрана
    Athread.Connection.WriteInteger(Screen.Height)
  else if (strText = 'get_screen_width') then
    //Возвратим ширину экрана
    Athread.Connection.WriteInteger(Screen.Width)
  else if (strText = 'get_screen_colors') then
  begin
    //Возвратим количество бит на точку
    dc := GetDC(0);
    Athread.Connection.WriteInteger(GetDeviceCaps(dc, BITSPIXEL));
    ReleaseDC(0, dc);
  end
  else if (strText = 'get_screen') then
    //Возвратим полноразмерную копию экрана
    SendScreen(Screen.Width, Screen.Height, AThread.Connection)
  else begin //строка вида 'get_screen:x,y'
    //Определеним значения высоты и ширины, переданные пользователем
    strText := Copy(strText, 12,Length(strText)-11);
    i := Pos(',', strText); //Положение запятой
    width := StrToInt(Copy(strText, 1, i-1));
    height := StrToInt(Copy(strText, i+1, Length(strText)-i));
    //Возвратим копию экрана
    SendScreen(width, height, AThread.Connection);
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  //При первом срабатывании таймера скрываем форму
  Hide;
  Timer1.Enabled := False;
end;

end.
