Читать онлайн «Delphi. Трюки и эффекты». Страница 48

Листинг 11.2. Реализация простого клиента

procedure TForm1.Button1Click(Sender: TObject);

begin

//Соединяемся с сервером и посылаем ему введенную строку

IdTCPClient1.Host := txtServer.Text;

IdTCPClient1.Connect;

IdTCPClient1.WriteLn(txtMessage.Text);

txtMessage.Text := \'\

//Ожидаем ответ и закрываем соединение

txtResults.Lines.Append(IdTCPClient1.ReadLn);

IdTCPClient1.Disconnect;

end;

Примечание

Для простоты в реализации клиентского приложения не производится обработка исключений, генерация которых возможна, например, при неправильном указании компьютера, на котором запущено серверное приложение. В более сложных примерах, с которыми вы познакомитесь далее в этой главе, обработка указанных исключений реализована.

Листинг 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.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;

Листинг 11.5. Соединение с сервером

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;

Листинг 11.6.

Действия, выполняемые при соединении с сервером

procedure TForm1.IdTCPClient1Connected(Sender: TObject);

begin

txtServer.Enabled := False;

cmbConnect.Caption := \'Отключиться\

//Начинаем периодически запрашивать данные с сервера

Timer1.Enabled := True;

//Выполним первый запрос, не дожидаясь срабатывания таймера

Timer1Timer (Nil);

end;

Листинг 11.7.

Действия при отсоединении от сервера

procedure TForm1.IdTCPClient1Disconnected(Sender: TObject);

begin

txtServer.Enabled := True;

cmbConnect.Caption := \'Подключиться\

Timer1.Enabled := False;

end;

Листинг 11.8.

Запрос и обработка данных, полученных с сервера

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));