[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); 

  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. 


Почему передается только один раз принт скин?
Архив с программой.
1.rar

[angvelem]

А разве так нельзя?

Код:

  ...
  DC := GetDC(0);  

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