| xx2088
38685
|
2009/9/24 16:38:28 |
| 非常感谢楼主共享。我来看看。 |
| cspcool
37599
|
2009/5/28 13:47:14 |
| 白屏的原因估计是连接对比数据没清0 |
| onecool
34426
|
2008/6/3 21:16:50 |
| 经测试，同一网段还不错，速度也好。不同网段的就是黑屏。还有个问题就是，如果连接上，对方什么也不动就是白屏。对方要动才显示屏幕。 |
| zcj085
34017
|
2008/5/6 14:18:22 |
| 很好很强大，帮助良多 |
| zh2000
33301
|
2008/3/16 13:03:28 |
没有话说,就一个字"谢"....
对作者简直是 滔滔江水.......省去周星星的一段长文字..........
希望日后作者能有更多.......... |
| guanyueguan
32714
|
2008/1/15 11:28:17 |
a版的還有點問題，b版的基本上沒有了。
如果是你自己編譯的，請注意ICS和D的環境差異。
以後的更新可能只會發布在我的Blog裡。 |
| pengshaowei
32712
|
2008/1/15 11:13:17 |
首先非常感谢楼主
delphi的我看了用的是2003,发现比较占用资源（酷睿2的机器），还有不够稳定，有时不能传输，如果穿输了就特别占用资源（客户端进程无响应，不知道是哪里的原因，我是菜鸟） |
| hfhappy
32700
|
2008/1/14 14:17:52 |
| 哎,都开源了,再给改应该算是定制了,出点钱算什么啊,总不能让人白劳动吧,再怎麽说也比连代码片段都没有就直接要钱强吧 |
| guanyueguan
32696
|
2008/1/14 11:13:05 |
ayxhys，
做人要厚道！
我在郵件中已經告訴了你的程序問題在哪裡！
只是修改花了我一個晚上，因為你程序的問題很多，所以說：要完全修改好的代碼就收點夜宵費。
如果你真的要認為我是為錢，請你不要在程序中用我的代碼！典型的忘恩負義！ |
| ayxhys
32693
|
2008/1/14 10:37:26 |
| 楼主给我修改了下，可以却跟我要起了money |
| hfhappy
32687
|
2008/1/13 16:35:24 |
to ayxhys :典型的线程同步错误,indy是工作在线程下,任何时候要更新界面都要考虑同步问题,我看你贴的代码里面一个考虑到同步的地方都没有,不出错才怪呢
guanyueguan 的屏幕部分算法没问题,问题都在传输和显示上,估计提出问题的都是没仔细研究过.... |
| qwe2004
32685
|
2008/1/12 17:23:49 |
| ayxhys兄弟，把你改的Indy版上传看看啊。 |
| ayxhys
32652
|
2008/1/10 10:28:28 |
| 我不知道你的邮箱是什么,看到了你的QQ号,权且发到你的QQ邮箱里了 |
| guanyueguan
32643
|
2008/1/9 23:07:25 |
把完整代码发到我邮箱里吧，我调试一下看是不是想到的问题。
个人不喜欢INDY，它的问题比较多，而且不适合写大型点的服务。
另：你的代码方式挺眼熟的。 |
| ayxhys
32641
|
2008/1/9 22:39:18 |
我给你发上来indy的代码,你给我改改
接收端:
procedure TFScreen.ScreenData(AThread: TIdPeerThread);
var
nLen: Integer;
reclen:integer;
jpg:TJpegimage;
begin
FRecBmp := TBitmap.Create;
FFullBmp := TBitmap.Create;
FRecStream := TMemoryStream.Create;
FScrStream := TMemoryStream.Create;
while AThread.Connection.Connected do
begin
try
AThread.Connection.ReadBuffer(FSCmd, SizeOf(TScrCmd));
if FSCmd.Cmd = 1 then
begin
SetSize(FSCmd.Width, FSCmd.Height);
AThread.Connection.ReadBuffer(FSCmd, SizeOf(TScrCmd));
end;
if FSCmd.Cmd = 2 then //2表示桌面数据到了
begin
FRecStream.Clear; //接收流清空,准备接收
FRecStream.SetSize(FSCmd.Size); //设置接收
AThread.Connection.ReadStream(FRecStream,FSCmd.Size,false);
fmain.bsSkinMemo1.Lines.Add('应接收大小:'+inttostr(FSCmd.Size)+' 实际接收大小:'+inttostr(FRecStream.Size));
FScrStream.Clear;
FRecStream.Position := 0;
ZDecompressStream(FRecStream, FScrStream);
FScrStream.Position := 0;
try
while FScrStream.Position < FScrStream.Size do
begin
FScrStream.Read(FRect, SizeOf(TRect));
with FRecBmp do
begin
Width := FRect.Right - FRect.Left;
Height := FRect.Bottom - FRect.Top;
LoadFromStream(FScrStream);
end;
//imgA.Picture.Bitmap.Assign(FRecBmp);
FFullBmp.Canvas.Draw(FRect.Left, FRect.Top, FRecBmp);
//imgA.Canvas.Draw(FRect.Left, FRect.Top, FRecBmp);
end;
BitBlt(pba.Canvas.Handle, 0, 0, FFullBmp.Width, FFullBmp.Height, FFullBmp.Canvas.Handle, 0, 0, SRCCOPY);
except
on e: Exception do
lblA.Caption := e.Message;
end;
end;
except
on e: Exception do
lblA.Caption := e.Message;
end;
end;
FRecBmp.Free;
FFullBmp.Free;
FRecStream.Free;
FScrStream.Free;
end;
发送端,也就是你的服务端
改了几个地方,其它的和你的一样:
procedure TScreenSpy.Execute;
begin
Form1.Memo1.Lines.Add('开始执行线程!');
if Form1.ConRpcport(AThread) then
begin
Form1.Memo1.Lines.Add('连接成功!');
AThread.WriteLn('002');
try
while (not Terminated) and (AThread.Connected) do
if CheckScr then GetFirst else GetNext;
except
Form1.Memo1.Lines.Add('屏幕传输终止!');
end;
end;
end;
function TScreenSpy.SendInfo: Boolean;
begin
try
FCmd.Cmd := 1;
FCmd.Size := 0;
FCmd.Width := FWidth;
FCmd.Height := FHeight;
athread.WriteBuffer(FCmd,sizeof(TCapCmd));
Result := True;
except
Result := False;
end;
end;
function TScreenSpy.SendData: Boolean;
begin
try
FCmd.Cmd := 2;
FCmd.Size := FSendStream.Size;
Athread.WriteBuffer(FCmd,sizeof(TCapCmd));
Athread.WriteStream(FSendStream);
Result := True;
except
Result := False;
end;
end;
你帮我看看吧,先谢谢楼主啦 |
| guanyueguan
32639
|
2008/1/9 18:37:02 |
| 估計是子線程的問題，沒有代碼不好說。 |
| ayxhys
32638
|
2008/1/9 17:44:23 |
我把它改成indy的了,不过接收图像一会儿后就黑屏,并出现存储空间不足的错误,请楼主解释下
//imgA.Picture.Bitmap.Assign(FRecBmp);//这样可以显示图像,并且可以连续接收,不会黑屏
imgA.Canvas.Draw(FRect.Left, FRect.Top, FRecBmp);//但是这廼的话,一会儿就黑屏了,估计是imgA.Canvas.Draw的问题,请楼主解释一下 |
| guanyueguan
32637
|
2008/1/9 16:28:42 |
| 閃爍、黑屏已解決：v0.1.1b，在我Blog裡有下載地址。 |
| guanyueguan
32635
|
2008/1/9 13:38:40 |
| 我在局域网測試沒有發現黑屏，在互聯網測試有，估計是ICS出錯了，回頭修改下，更新在Blog裡。 |
| nxfbccu
32632
|
2008/1/9 13:20:59 |
| 局域网确实是黑屏 |
|
