Читаем Delphi. Трюки и эффекты полностью

• get_screen_colors – для получения значения установленной для монитора глубины цвета (бит на точку);

• get_screen – для получения полноразмерной копии экрана;

• get_screen: X, Y – для получения копии экрана, приведенной к размеру Хх Y.

Сначала рассмотрим реализацию сервера (проект SpyServer). Весь код, обеспечивающий работу сервера, помещен в модуле Unitl. pas формы Forml. Обработчик запросов клиентов – главная процедура для сервера – приводится в листинге 11.3.

...

Обработчик клиентских запросов

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;

Используемая в листинге 11.3 процедура SendScreen, отправляющая клиенту копию экрана, приведена в листинге 11.4.

...

Снятие копии экрана

//Процедура снимает копию экрана, приводит полученное

//изображение к заданному размеру и отправляет

//преобразованное изображение клиентской программе

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;