IdTCPClient.ReadStream 为什么停在那,不动了!(100分)

  • 主题发起人 主题发起人 wanggongqin
  • 开始时间 开始时间
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.
 
其实你可以采用分批发送的方式,不要一次性发送过大的文件流,这样的话可以导致整个程序死机或假死机的现象,如要相关的代码给个邮箱地址
 
谢谢 chizeng 了:
这个只是测试,为了不超过最大限制,我截屏时截很小的区域:
GetScreen(AStream, 0, 0, 50, 50);
我的邮箱是:wgqsoft@126.com 谢谢了。
 
已发给你啦,查收啦,有什么不明的发邮件给我吧
 
后退
顶部