отправка прием картинки Socket Server&Client Delphi

#11
23.05.2008, 18:46
$Аватар для /Boom\$
/Boom\
Познающий
Регистрация: 14.02.2008
Сообщений: 62
Провел на форуме:
335706
Репутация: 4
PHP код:

		
			
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.
ANTICHAT — форум по информационной безопасности, OSINT и технологиям
