Форум АНТИЧАТ - отправка прием картинки 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.

Цитата:

Сообщение от Hellsp@wn

а строка под буфер, это нонсенс...

Ну почему ж: :)

Код:

setlength(s, 1024);

recv(тра-ля-ля, @s[1], 1024, тра-ля-ля);

s := PChar(s);

Разврат - это первый шаг на пути к ДАО! :)

разврат - это первый шаг на пути к отуплению)

Hellsp@wn, это техника для избранных :)

Цитата:

Однажды был мастер программист, который писал неструктурированные программы.
Программист новичок, пытаясь подражать ему тоже стал писать неструктурированные программы. Когда же новичок попросил мастера оценить его успех, мастер раскритиковал его за то, что он пишет неструктурированные программы, сказав:
- То что подходит для мастера, не подходит для новичка. Ты должен понять Дао, прежде чем переступать через структуру.

[C] James Geoffrey