Форум АНТИЧАТ - отправка прием картинки Socket Server&Client Delphi

Форум АНТИЧАТ (https://forum.antichat.xyz/index.php)

- С/С++, C#, Delphi, .NET, Asm (https://forum.antichat.xyz/forumdisplay.php?f=24)

- - отправка прием картинки Socket Server&Client Delphi (https://forum.antichat.xyz/showthread.php?t=71126)

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

отправляю:

PHP код:


		
			
       fs:=TMemoryStream.Create;

       Image1.Picture.Bitmap.SaveToStream(fs);

       ServerSocket1.Socket.SendStream(fs);

принимаю:

PHP код:


		
			
procedure TForm1.Button1Click(Sender: TObject);

begin

ClientSocket1.Active:=true;

end;



procedure TForm1.Button2Click(Sender: TObject);

begin

ClientSocket1.Active:=false;

end;



procedure TForm1.ClientSocket1Read(Sender: TObject;

  Socket: TCustomWinSocket);

  var

  s: string;

begin

  s:=Socket.ReceiveText;

  Reciving:=true;

  ClientSocket1.Socket.ReceiveBuf(s,DataSize);

  fs.WriteBuffer(s,DataSize);

  Image1.Picture.Bitmap.LoadFromStream(fs);

  end;

что не правильно в приеме

картинка должна передаваться не сразу куском, а по блокам определённого размера...
и думаю стоит поменять s : string; на buf : array [0..1024] of byte;
и если учесть что TImage - это штука глючная, то лучше загружай картинку через TBitmap а потом уже рисуй её куданить на форму... ну или на жёсткий сохрани...

имхо тоже , лучше разбить по байтам , и имхо еще лучше сделать опознавательный байт в начале блока , чтобы пакеты картинки от других фильтровать ...

Цитата:

Сообщение от Jes

имхо тоже , лучше разбить по байтам

Зачем же разбивать, она итак отправляется по блокам... через SendBuf...

а вообще я делал так....

если передаём с сервера картинку, оповещаем клиента об её ожидании... посылая клиенту сообщение через SendText, 'imgXXXXXXXX'
где XXXXXXXX - размер картинки в HEX виде...
затем устанавливаем флаг (в клиенте) о приёме оной и занося в какую либо переменную размер картинки
RecvImage := True
ImageSize := XXXXXXXX

далее просто от общего размера, есстественно отнимаем то число, которое показывает размер блока что был принят...

ну и всё... вроде...

это имхо (+ приверженство к hand made )

Ещё, если уж потоки - это тру, то имхо (:)) лучше уж использовать TStrtingStream

2 Flame
не разбираясь в делфи!
>> s:=Socket.ReceiveText;
ноль ограниченный режим или чего это за шняга?

/// одним словом непохек работать с сокетом на высоком уровне! :cool:

жесть. читай файл в буфер и просто высылай буфер. а вообще пора забыть эти TServerSocket & TClientSocket, юзай модуль WinSock.

не используйте Stream'ы, это от лукавого :) пишите на апи - это хек! а строка под буфер, это нонсенс...

велком ->> http://www.delphikingdom.com/

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.