W
wanggongqin
Unregistered / Unconfirmed
GUEST, unregistred user!
我在服务端明明执行了 AThread.Connection.WriteStream(AStream)
为什么客户端还是停在 IdTCPClient.ReadStream 不动了?
下面是全部源代码,帮忙看看!
另外,听说 Indy 组件发送流时有大小限制,限制多大啊?
服务端代码:----------------------------------------
unit MainSrv;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPServer;
type
TMainSrvfrm = class(TForm)
mmMessage: TMemo;
IdTCPServer: TIdTCPServer;
procedure FormCreate(Sender: TObject);
procedure IdTCPServerConnect(AThread: TIdPeerThread);
procedure IdTCPServerExecute(AThread: TIdPeerThread);
procedure IdTCPServerDisconnect(AThread: TIdPeerThread);
private
{ Private declarations }
public
{ Public declarations }
end;
var
MainSrvfrm: TMainSrvfrm;
implementation
{$R *.dfm}
procedure GetScreen(ScrStream: TMemoryStream; Left, Top, Width, Height: Integer;
Colors: TPixelFormat = pf8bit);
{ 获取屏幕保存为内存流; 不捕捉鼠标; 颜色数默认为 256 色 }
var
Bmp: TBitmap;
DC: HDC;
Canvas: TCanvas;
R: TRect;
begin
Bmp := TBitmap.Create;
Canvas := TCanvas.Create;
DC := GetWindowDC(0);
try
Canvas.Handle := DC;
R := Rect(Left, Top, Left + Width, Top + Height);
Bmp.Width := R.Right;
Bmp.Height := R.Bottom;
Bmp.Canvas.CopyRect(R, Canvas, R);
finally
ReleaseDC(0, DC);
end;
Canvas.Handle := 0;
Canvas.Free;
Bmp.PixelFormat := Colors;
Bmp.SaveToStream(ScrStream);
Bmp.Free;
end;
procedure TMainSrvfrm.FormCreate(Sender: TObject);
begin
IdTCPServer.DefaultPort := 7777;
IdTCPServer.Active := True;
end;
procedure TMainSrvfrm.IdTCPServerConnect(AThread: TIdPeerThread);
begin
mmMessage.Lines.Add('Connected from '+AThread.Connection.LocalName+'('+
AThread.Connection.Socket.Binding.IP+')');
end;
procedure TMainSrvfrm.IdTCPServerExecute(AThread: TIdPeerThread);
var
TmpStr: string;
AStream: TMemoryStream;
begin
if AThread.Terminated or (not AThread.Connection.Connected) then Exit;
TmpStr := AThread.Connection.ReadLn();
if CompareText(Copy(TmpStr,1,6), 'CapScr') = 0 then
begin
AStream := TMemoryStream.Create;
GetScreen(AStream, 0, 0, 50, 50);
AStream.Position := 0;
AThread.Connection.OpenWriteBuffer();
AThread.Connection.WriteStream(AStream);
AThread.Connection.CloseWriteBuffer;
AStream.Free;
end;
end;
procedure TMainSrvfrm.IdTCPServerDisconnect(AThread: TIdPeerThread);
begin
mmMessage.Lines.Add('Disconnected from '+AThread.Connection.LocalName+'('+
AThread.Connection.Socket.Binding.IP+')');
end;
end.
客户端代码:-----------------------------------------------------
unit MainClt;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient;
type
TMainCltfrm = class(TForm)
Label1: TLabel;
edtAdress: TEdit;
btnBegin: TButton;
btnStop: TButton;
Panel1: TPanel;
ImgScreen: TImage;
IdTCPClient: TIdTCPClient;
procedure btnBeginClick(Sender: TObject);
procedure btnStopClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TClientThread = class(TThread)
private
FStream: TMemoryStream;
FScrForm: TMainCltfrm;
procedure ShowScreen;
public
constructor Create(CreateSuspended: Boolean);
destructor Destroy; override;
procedure Execute; override;
property ScreenForm: TMainCltfrm read FScrForm write FScrForm;
end;
var
MainCltfrm: TMainCltfrm;
ClientThread: TClientThread;
implementation
{$R *.dfm}
{ TClientThread }
constructor TClientThread.Create(CreateSuspended: Boolean);
begin
inherited Create(CreateSuspended);
FStream := TMemoryStream.Create;
end;
destructor TClientThread.Destroy;
begin
FStream.Free;
inherited;
end;
procedure TClientThread.Execute;
begin
while not Terminated do
begin
if FScrForm.IdTCPClient.Connected then
begin
FStream.Clear;
FScrForm.IdTCPClient.WriteLn('CapScr');
FScrForm.IdTCPClient.ReadStream(FStream);
Synchronize(ShowScreen);
end else
Terminate;
end;
end;
procedure TClientThread.ShowScreen;
var
Bmp: TBitmap;
begin
Bmp := TBitmap.Create;
Bmp.LoadFromStream(FStream);
FScrForm.ImgScreen.Picture.Bitmap.Assign(Bmp);
Bmp.Free;
end;
procedure TMainCltfrm.btnBeginClick(Sender: TObject);
begin
IdTCPClient.Host := edtAdress.Text;
IdTCPClient.Port := 7777;
IdTCPClient.Connect(10000);
ClientThread := TClientThread.Create(True);
ClientThread.FreeOnTerminate := True;
ClientThread.ScreenForm := Self;
ClientThread.Resume;
end;
procedure TMainCltfrm.btnStopClick(Sender: TObject);
begin
ClientThread.Terminate;
IdTCPClient.Disconnect;
end;
end.
为什么客户端还是停在 IdTCPClient.ReadStream 不动了?
下面是全部源代码,帮忙看看!
另外,听说 Indy 组件发送流时有大小限制,限制多大啊?
服务端代码:----------------------------------------
unit MainSrv;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPServer;
type
TMainSrvfrm = class(TForm)
mmMessage: TMemo;
IdTCPServer: TIdTCPServer;
procedure FormCreate(Sender: TObject);
procedure IdTCPServerConnect(AThread: TIdPeerThread);
procedure IdTCPServerExecute(AThread: TIdPeerThread);
procedure IdTCPServerDisconnect(AThread: TIdPeerThread);
private
{ Private declarations }
public
{ Public declarations }
end;
var
MainSrvfrm: TMainSrvfrm;
implementation
{$R *.dfm}
procedure GetScreen(ScrStream: TMemoryStream; Left, Top, Width, Height: Integer;
Colors: TPixelFormat = pf8bit);
{ 获取屏幕保存为内存流; 不捕捉鼠标; 颜色数默认为 256 色 }
var
Bmp: TBitmap;
DC: HDC;
Canvas: TCanvas;
R: TRect;
begin
Bmp := TBitmap.Create;
Canvas := TCanvas.Create;
DC := GetWindowDC(0);
try
Canvas.Handle := DC;
R := Rect(Left, Top, Left + Width, Top + Height);
Bmp.Width := R.Right;
Bmp.Height := R.Bottom;
Bmp.Canvas.CopyRect(R, Canvas, R);
finally
ReleaseDC(0, DC);
end;
Canvas.Handle := 0;
Canvas.Free;
Bmp.PixelFormat := Colors;
Bmp.SaveToStream(ScrStream);
Bmp.Free;
end;
procedure TMainSrvfrm.FormCreate(Sender: TObject);
begin
IdTCPServer.DefaultPort := 7777;
IdTCPServer.Active := True;
end;
procedure TMainSrvfrm.IdTCPServerConnect(AThread: TIdPeerThread);
begin
mmMessage.Lines.Add('Connected from '+AThread.Connection.LocalName+'('+
AThread.Connection.Socket.Binding.IP+')');
end;
procedure TMainSrvfrm.IdTCPServerExecute(AThread: TIdPeerThread);
var
TmpStr: string;
AStream: TMemoryStream;
begin
if AThread.Terminated or (not AThread.Connection.Connected) then Exit;
TmpStr := AThread.Connection.ReadLn();
if CompareText(Copy(TmpStr,1,6), 'CapScr') = 0 then
begin
AStream := TMemoryStream.Create;
GetScreen(AStream, 0, 0, 50, 50);
AStream.Position := 0;
AThread.Connection.OpenWriteBuffer();
AThread.Connection.WriteStream(AStream);
AThread.Connection.CloseWriteBuffer;
AStream.Free;
end;
end;
procedure TMainSrvfrm.IdTCPServerDisconnect(AThread: TIdPeerThread);
begin
mmMessage.Lines.Add('Disconnected from '+AThread.Connection.LocalName+'('+
AThread.Connection.Socket.Binding.IP+')');
end;
end.
客户端代码:-----------------------------------------------------
unit MainClt;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient;
type
TMainCltfrm = class(TForm)
Label1: TLabel;
edtAdress: TEdit;
btnBegin: TButton;
btnStop: TButton;
Panel1: TPanel;
ImgScreen: TImage;
IdTCPClient: TIdTCPClient;
procedure btnBeginClick(Sender: TObject);
procedure btnStopClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TClientThread = class(TThread)
private
FStream: TMemoryStream;
FScrForm: TMainCltfrm;
procedure ShowScreen;
public
constructor Create(CreateSuspended: Boolean);
destructor Destroy; override;
procedure Execute; override;
property ScreenForm: TMainCltfrm read FScrForm write FScrForm;
end;
var
MainCltfrm: TMainCltfrm;
ClientThread: TClientThread;
implementation
{$R *.dfm}
{ TClientThread }
constructor TClientThread.Create(CreateSuspended: Boolean);
begin
inherited Create(CreateSuspended);
FStream := TMemoryStream.Create;
end;
destructor TClientThread.Destroy;
begin
FStream.Free;
inherited;
end;
procedure TClientThread.Execute;
begin
while not Terminated do
begin
if FScrForm.IdTCPClient.Connected then
begin
FStream.Clear;
FScrForm.IdTCPClient.WriteLn('CapScr');
FScrForm.IdTCPClient.ReadStream(FStream);
Synchronize(ShowScreen);
end else
Terminate;
end;
end;
procedure TClientThread.ShowScreen;
var
Bmp: TBitmap;
begin
Bmp := TBitmap.Create;
Bmp.LoadFromStream(FStream);
FScrForm.ImgScreen.Picture.Bitmap.Assign(Bmp);
Bmp.Free;
end;
procedure TMainCltfrm.btnBeginClick(Sender: TObject);
begin
IdTCPClient.Host := edtAdress.Text;
IdTCPClient.Port := 7777;
IdTCPClient.Connect(10000);
ClientThread := TClientThread.Create(True);
ClientThread.FreeOnTerminate := True;
ClientThread.ScreenForm := Self;
ClientThread.Resume;
end;
procedure TMainCltfrm.btnStopClick(Sender: TObject);
begin
ClientThread.Terminate;
IdTCPClient.Disconnect;
end;
end.