多线程远程桌面数据发送问题 ( 积分: 51 )

constructor TDesk.Create(R:TRect;SSeat:ScreenSeat);
begin
LRect:=R;
LBmp:=TBitMap.Create ;
LJpg:=TJpegImage.Create;
NowDesk:=TMemoryStream.Create ;
SendDesk:=TMemoryStream.Create ;
T:=TCanvas.Create ;
D:=GetDC(0);
LBmp.Width :=LRect.Right-LRect.Left+1;
LBmp.Height :=LRect.Bottom-LRect.Top+1;
Seat:=SSeat;
inherited Create(False);
FreeOnTerminate:=True;
end;

procedure TDesk.Execute;
begin
inherited;
repeat
T.Handle:=D;
T.Lock;
LBmp.Canvas.CopyRect(Rect(0,0,LBmp.Width,LBmp.Height),T,LRect);
T.Unlock;
LJpg.Assign(LBmp);
Ljpg.JPEGNeeded ;
LJpg.CompressionQuality :=50;
LJpg.Compress;
LJpg.SaveToStream(NowDesk);
NowDesk.Position :=0;
SendDesk.WriteBuffer(Seat,SizeOf(Seat));
SendDesk.CopyFrom(NowDesk,NowDesk.Size);
Form1.TransferCtrl.SendBuffer(CtrlInfo.ReceIp,CtrlInfo.RecePort,SendDesk.Memory^,SendDesk.Size);//Udp发送数据
SendDesk.Clear;
NowDesk.Clear ;
Until terminated;
T.Free ;
ReleaseDc(0,D);
LBmp.Free ;
LJpg.Free ;
SendDesk.Free ;
NowDesk.Free ;
end;

创建线程
ScreenGridProcess(CtrlInfo.ScreenW,CtrlInfo.ScreenH);//将桌面分成４块传送
Desk[0]:=TDesk.Create(SGrid[0],L1);//左一
Desk[1]:=TDesk.Create(SGrid[1],M1);//中一
Desk[2]:=TDesk.Create(SGrid[2],M2);//中二
Desk[3]:=TDesk.Create(SGrid[3],R1);//右一

为何运行一段时间后报错：Out of System Resource

constructor TDesk.Create(R:TRect;SSeat:ScreenSeat);
begin
LRect:=R;
LBmp:=TBitMap.Create ;
LJpg:=TJpegImage.Create;
NowDesk:=TMemoryStream.Create ;
SendDesk:=TMemoryStream.Create ;
T:=TCanvas.Create ;
D:=GetDC(0);
LBmp.Width :=LRect.Right-LRect.Left+1;
LBmp.Height :=LRect.Bottom-LRect.Top+1;
Seat:=SSeat;
inherited Create(False);
FreeOnTerminate:=True;
end;

procedure TDesk.Execute;
begin
inherited;
repeat
T.Handle:=D;
T.Lock;
LBmp.Canvas.CopyRect(Rect(0,0,LBmp.Width,LBmp.Height),T,LRect);
T.Unlock;
LJpg.Assign(LBmp);
Ljpg.JPEGNeeded ;
LJpg.CompressionQuality :=50;
LJpg.Compress;
LJpg.SaveToStream(NowDesk);
NowDesk.Position :=0;
SendDesk.WriteBuffer(Seat,SizeOf(Seat));
SendDesk.CopyFrom(NowDesk,NowDesk.Size);
Form1.TransferCtrl.SendBuffer(CtrlInfo.ReceIp,CtrlInfo.RecePort,SendDesk.Memory^,SendDesk.Size);//Udp发送数据
SendDesk.Clear;
NowDesk.Clear ;
Until terminated;
T.Free ;
ReleaseDc(0,D);
LBmp.Free ;
LJpg.Free ;
SendDesk.Free ;
NowDesk.Free ;
end;

创建线程
ScreenGridProcess(CtrlInfo.ScreenW,CtrlInfo.ScreenH);//将桌面分成４块传送
Desk[0]:=TDesk.Create(SGrid[0],L1);//左一
Desk[1]:=TDesk.Create(SGrid[1],M1);//中一
Desk[2]:=TDesk.Create(SGrid[2],M2);//中二
Desk[3]:=TDesk.Create(SGrid[3],R1);//右一

为何运行一段时间后报错：Out of System Resource

高。。。

厉害！！！

搞定什么了？

强！酷！赞！[8D]
我也不知道他搞定什么了[]

LBmp:=TBitMap.Create ;
LJpg:=TJpegImage.Create
这两个的东西没有释放吧
是不是一直在增加啊

[red] T.Handle:=D;
T.Lock;[/red]
LBmp.Canvas.CopyRect(Rect(0,0,LBmp.Width,LBmp.Height),T,LRect);
[red]T.Unlock;[/red]
把红色部分去掉试试

改用其它获得桌面背景的方法

to 可爱小猪
不会吧?线程创建时初始化变量,以后应该不会重复创建的
在线程里是循环操作,退出循环时都释放了呀

一段时间后报错应该是线程中的问题
-----------------------------------------------
http://www.coderpub.com 技术论坛欢迎原创文章

to dawnsong
将你所说的代码屏蔽掉,问题依旧,如果不进行流操作,就无问题,说明数据太大影响了线程操作,可是没有数据也不行呀?!

是TBitMap的问题，你可以在一个线程中使用循环来TBitMap.Create ,free就会出现Out of System Resource

to ljy_17
procedure TDeskTop.Execute;
var
i :int64;
begin
i:=0;
repeat
DeskBmp:=TBitMap.Create ;
Form1.Caption :=IntToStr(i);
DeskBmp.Free ;
Until terminated ;
end;
没出现Out of System Resource 的问题??????

ScreenGridProcess把这个拿出来看看

TO：tswhq
procedure TDeskTop.Execute;
………………
for I:=1 to 100do
begin
DeskBmp:=TBitMap.Create ;
………这里可以对deskbmp进行操作，比如取屏之类的…！
DeskBmp.Free ;

end;
………

to ljy_17
procedure TDeskTop.Execute;
………………
for I:=1 to 100do
begin
DeskBmp:=TBitMap.Create ;
………这里可以对deskbmp进行操作，比如取屏之类的…！
DeskBmp.Free ;

end;
………
还是报错,只不过能多运行一会

是的，我意思就是说Tbitmap的问题，以前有看过相关文章说DeskBmp.Free 并不会释放所有资源，忘记在哪看的了，你可以搜索一下！

还是没办法

还是求人不如求己呀!!!
自己搞定.............
散分