捐赠 | 广告 | 注册 | 发布 | 上传 | 关于我们    
  沪ICP备05001939号 DELPHI盒子 | 盒子论坛 | 盒子文章 | 盒子问答悬赏 | 最新更新 | 论坛检索 | 下载中心 | 高级搜索    
  精品专区 | 繁體中文 | 奖励公告栏 | 直通车账号登陆 | 关闭GOOGLE广告 | 临时留言    
 
广告
评论:屏幕傳輸程序改進版一
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
局域网确实是黑屏
第一页 上一页 下一页 最后页 有 40 条纪录 共2页 1 - 20
 用户名:
 密 码:
自动登陆(30天有效)
 
  DELPHI盒子版权所有 1999-2012 V3.01 沪ICP备05001939号 更新RSS列表