Передача Print Screen'а от клиента к серверу (через сокеты)

[valdys]

Помогите пожалуйста исправить код, передаю принт скрин от клиента к серверу(передается только один раз).

Клиент

PHP код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ScktComp, ExtCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Button1: TButton;
    ClientSocket1: TClientSocket;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
    Stop:boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin

 ClientSocket1.Port := strtoint(edit2.text);        //устанавливаем порт
 ClientSocket1.Address := edit1.text;                 //IP адресс сервера  если на одном компе можно просто 192.168.1.2
 ClientSocket1.Active :=True;
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
begin
edit3.Text:= Socket.ReceiveText;
end;



procedure TForm1.Button2Click(Sender: TObject);
begin
ClientSocket1.Active :=false;
Stop:=True;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  BMP:TBitmap;
  SBMP:TMemoryStream;
  DC:HDC;
  Len: Int64;
begin
  BMP:=TBitmap.Create;
  SBMP:=TMemoryStream.Create;

  DC:=GetDC(0);

    bmp.Width := Screen.Width;
    bmp.Height := Screen.Height;
    BitBlt(bmp.Canvas.Handle, 0,0, Screen.Width, Screen.Height,GetDC(0), 0,0,SRCCOPY);

        StretchBlt(bmp.Canvas.Handle,0,0,(Screen.Width-400),(Screen.Height-400),bmp.Canvas.Handle,0,0,Screen.Width,Screen.Height,SRCCOPY);
        bmp.Width:=Screen.Width-400;
        bmp.Height:=Screen.Height-400;

  BMP.SaveToStream(SBMP);
  Len := SBMP.Size;
  ClientSocket1.Socket.SendBuf(Len,SizeOf(Int64));
  SBMP.Position:=0;
  ClientSocket1.Socket.SendStream(SBMP);

  sbmp:=nil;
  sbmp.Free;

  BMP.Free;
  
end;

end. 


Сервер

PHP код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ScktComp, Spin, ExtCtrls, jpeg, Menus;

type

  TForm1 = class(TForm)

    ServerSocket1: TServerSocket;
    Edit1: TEdit;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    Desktop1: TMenuItem;
    Send1: TMenuItem;
    N2: TMenuItem;
    Help1: TMenuItem;
    Save1: TMenuItem;
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure FormCreate(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure Desktop1Click(Sender: TObject);
    procedure Send1Click(Sender: TObject);
    procedure Help1Click(Sender: TObject);
  private
    { Private declarations }
    SBMP:TMemoryStream;
  public
    { Public declarations }
  end;
 type
     TState=(stNone,stData);
var
    Form1: TForm1;
    State: TState=stNone;
    Msg:string;
    Len: Int64;
    CountReceived: Int64;

implementation

uses Unit2, Unit3;

{$R *.dfm}

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
Msg:= Msg+Socket.ReceiveText;

while Msg<>'' do
  begin
    case State of
      stNone:
        begin
          if Length(Msg)<SizeOf(Int64) then Exit;
          State := stData;
          Move(Msg[1],Len,SizeOf(int64));
          Delete(Msg,1,SizeOf(int64));
        end;
      stData:
        begin
          CountReceived := CountReceived+SBMP.Write(Msg[1],Length(Msg));
          Msg := '';
          if CountReceived=Len then
          begin
            State := stNone;
            SBMP.Position:=0;
            form2.Image1.Picture.Bitmap.Height:=100;
            form2.Image1.Picture.Bitmap.Width:=100;
            form2.Image1.Picture.Bitmap.LoadFromStream(SBMP);
          end;
        end;
    end;
  end;
  end;




procedure TForm1.FormCreate(Sender: TObject);
begin
   SBMP:=TMemoryStream.Create;
  SBMP.Position:=0;
end;

procedure TForm1.N1Click(Sender: TObject);
begin
 ServerSocket1.Port := strtoint(form3.edit1.text);    //Устанавливаем порт
 ServerSocket1.Active :=True;
 form1.Caption:='Сервер запущен';
end;

procedure TForm1.Desktop1Click(Sender: TObject);
begin
form2.visible:=true;
end;

procedure TForm1.Send1Click(Sender: TObject);
begin
ServerSocket1.Socket.Connections[0].SendText(edit1.text);
end;

procedure TForm1.Help1Click(Sender: TObject);
begin
Showmessage('F5 - Передать текст клиенту');
end;



end. 


[mss]

  sbmp:=nil;
  sbmp.Free;

Это порадовало.

[valdys]

Я так понял что очищаю TMemoryStream раньше чем успело передатся изображение?

[Пепел Феникса]

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

[mss]

итог утечка памяти

Никакой утечки здесь нет. Просто полная несуразица.
Притом что в справке, которая как известно для Пушкина, написано:

Note: The Stream passed as a parameter to SendStream becomes “owned” by the windows socket object. The Windows socket object frees the stream when it is finished with it. Do not attempt to free the stream after it has been passed as a parameter.

[Пепел Феникса]

Притом что в справке, которая как известно для Пушкина, написано:

а вот нормально не выразится?
забыл, ибо не пишу на Делфи(серьезно) уже год как минимум.