отправка прием картинки 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 а потом уже рисуй её куданить на форму... ну или на жёсткий сохрани...

 

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

 

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

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

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

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

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

 

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

 

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

 

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


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

 

жесть. читай файл в буфер и просто высылай буфер. а вообще пора забыть эти 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.


 

Ну почему ж:

Code:

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

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

 

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

 

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

[C] James Geoffrey