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

Discussion in 'С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby' started by Flame of Soul, 22 May 2008.

  1. Flame of Soul

    Flame of Soul Elder - Старейшина

    Joined:
    25 May 2007
    Messages:
    185
    Likes Received:
    146
    Reputations:
    45
    отправляю:
    PHP:
           fs:=TMemoryStream.Create;
           
    Image1.Picture.Bitmap.SaveToStream(fs);
           
    ServerSocket1.Socket.SendStream(fs);
    принимаю:
    PHP:
    procedure TForm1.Button1Click(SenderTObject);
    begin
    ClientSocket1
    .Active:=true;
    end;

    procedure TForm1.Button2Click(SenderTObject);
    begin
    ClientSocket1
    .Active:=false;
    end;

    procedure TForm1.ClientSocket1Read(SenderTObject;
      
    SocketTCustomWinSocket);
      var
      
    sstring;
    begin
      s
    :=Socket.ReceiveText;
      
    Reciving:=true;
      
    ClientSocket1.Socket.ReceiveBuf(s,DataSize);
      
    fs.WriteBuffer(s,DataSize);
      
    Image1.Picture.Bitmap.LoadFromStream(fs);
      
    end;
    что не правильно в приеме
     
  2. x0man

    x0man Elder - Старейшина

    Joined:
    24 Feb 2006
    Messages:
    33
    Likes Received:
    13
    Reputations:
    0
    картинка должна передаваться не сразу куском, а по блокам определённого размера...
    и думаю стоит поменять s : string; на buf : array [0..1024] of byte;
    и если учесть что TImage - это штука глючная, то лучше загружай картинку через TBitmap а потом уже рисуй её куданить на форму... ну или на жёсткий сохрани...
     
    1 person likes this.
  3. Jes

    Jes Elder - Старейшина

    Joined:
    16 Apr 2007
    Messages:
    370
    Likes Received:
    391
    Reputations:
    34
    имхо тоже , лучше разбить по байтам , и имхо еще лучше сделать опознавательный байт в начале блока , чтобы пакеты картинки от других фильтровать ...
     
    3 people like this.
  4. x0man

    x0man Elder - Старейшина

    Joined:
    24 Feb 2006
    Messages:
    33
    Likes Received:
    13
    Reputations:
    0
    Зачем же разбивать, она итак отправляется по блокам... через SendBuf...

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

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

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

    ну и всё... вроде...
     
    #4 x0man, 22 May 2008
    Last edited: 22 May 2008
  5. Jes

    Jes Elder - Старейшина

    Joined:
    16 Apr 2007
    Messages:
    370
    Likes Received:
    391
    Reputations:
    34
    это имхо (+ приверженство к hand made )
     
    3 people like this.
  6. desTiny

    desTiny Elder - Старейшина

    Joined:
    4 Feb 2007
    Messages:
    1,005
    Likes Received:
    444
    Reputations:
    94
    Ещё, если уж потоки - это тру, то имхо :))) лучше уж использовать TStrtingStream
     
    1 person likes this.
  7. Delimiter

    Delimiter Banned

    Joined:
    8 Apr 2005
    Messages:
    317
    Likes Received:
    173
    Reputations:
    12
    2 Flame
    не разбираясь в делфи!
    >> s:=Socket.ReceiveText;
    ноль ограниченный режим или чего это за шняга?


    /// одним словом непохек работать с сокетом на высоком уровне! :cool:
     
    #7 Delimiter, 22 May 2008
    Last edited: 22 May 2008
    2 people like this.
  8. t04

    t04 Elder - Старейшина

    Joined:
    10 Jan 2007
    Messages:
    137
    Likes Received:
    40
    Reputations:
    8
    жесть. читай файл в буфер и просто высылай буфер. а вообще пора забыть эти TServerSocket & TClientSocket, юзай модуль WinSock.
     
    2 people like this.
  9. Hellsp@wn

    Hellsp@wn Elder - Старейшина

    Joined:
    29 Apr 2007
    Messages:
    402
    Likes Received:
    153
    Reputations:
    48
    не используйте Stream'ы, это от лукавого :) пишите на апи - это хек! а строка под буфер, это нонсенс...

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

    /Boom\ Elder - Старейшина

    Joined:
    14 Feb 2008
    Messages:
    21
    Likes Received:
    2
    Reputations:
    0
    PHP:
    unit Unit1;

    interface

    uses
      Windows
    MessagesSysUtilsVariantsClassesGraphicsControlsForms,
      
    DialogsExtCtrlsStdCtrlsIdBaseComponentIdComponent,
      
    IdTCPConnectionIdTCPClient;

    type
      TForm1 
    = class(TForm)
        
    imgScreenTImage;
        
    GroupBox1TGroupBox;
        
    txtServerTEdit;
        
    IdTCPClient1TIdTCPClient;
        
    cmbConnectTButton;
        
    GroupBox2TGroupBox;
        
    Label1TLabel;
        
    Label3TLabel;
        
    lblResolutionTLabel;
        
    lblColorsTLabel;
        
    Timer1TTimer;
        
    procedure cmbConnectClick(SenderTObject);
        
    procedure IdTCPClient1Connected(SenderTObject);
        
    procedure IdTCPClient1Disconnected(SenderTObject);
        
    procedure Timer1Timer(SenderTObject);
      private
        { Private 
    declarations }
      public
        { Public 
    declarations }
      
    end;

    var
      
    Form1TForm1;

    implementation

    {$R *.dfm}

    procedure TForm1.cmbConnectClick(SenderTObject);
    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(SenderTObject);
    begin
      txtServer
    .Enabled := False;
      
    cmbConnect.Caption := 'Отключиться';
      
    //Начинаем периодически запрашивать данные с сервера
      
    Timer1.Enabled := True;
      
    //Выполним первый запрос сами
      
    Timer1Timer (Nil);
    end;

    procedure TForm1.IdTCPClient1Disconnected(SenderTObject);
    begin
      txtServer
    .Enabled := True;
      
    cmbConnect.Caption := 'Подключиться';
      
    Timer1.Enabled := False;
    end;

    procedure TForm1.Timer1Timer(SenderTObject);
    var
      
    streamTMemoryStream;
    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.
     
  11. desTiny

    desTiny Elder - Старейшина

    Joined:
    4 Feb 2007
    Messages:
    1,005
    Likes Received:
    444
    Reputations:
    94
    Ну почему ж: :)
    Code:
    setlength(s, 1024);
    recv(тра-ля-ля, @s[1], 1024, тра-ля-ля);
    s := PChar(s);
    Разврат - это первый шаг на пути к ДАО! :)
     
  12. Hellsp@wn

    Hellsp@wn Elder - Старейшина

    Joined:
    29 Apr 2007
    Messages:
    402
    Likes Received:
    153
    Reputations:
    48
    разврат - это первый шаг на пути к отуплению)
     
  13. desTiny

    desTiny Elder - Старейшина

    Joined:
    4 Feb 2007
    Messages:
    1,005
    Likes Received:
    444
    Reputations:
    94
    Hellsp@wn, это техника для избранных :)
    [C] James Geoffrey
     
Loading...