捐赠 | 广告 | 注册 | 发布 | 上传 | 关于我们    
  粤ICP备10103342号-1 DELPHI盒子 | 盒子文章 | 盒子问答悬赏 | 最新更新 | 盒子检索 | 下载中心 | 高级搜索    
  精品专区 | 繁體中文 | 奖励公告栏 | 直通车账号登陆 | 关闭GOOGLE广告 | 临时留言    
盒子资源分类
全部展开 - 全部合拢
屏幕传输ScreenSpy.pas单元加光标版(无下载)
关键字：ScreenSpy屏幕传输单元
来　自：转载,只是把某大的文件修改一点点
平　台：Win2k/XP/NT,Win2003 下载所需：0 火柴
深浅度：初级 完成时间：2009/7/20
发布者：zhuruinan 发布时间：2009/7/21
编辑器：DELPHI7 语　　种：简体中文
分　类：网络 下载浏览：821/15349
加入到我的收藏
下载错误报错
登陆以后才能下载
 用户名：
 密　码：
自动登陆(30天有效)
图片如果打不开，说明流量不够了，请稍候下载……
屏幕传输ScreenSpy.pas单元原本传输的屏幕图像中没有看见鼠标，小的只是加多了个可以看见鼠标进去，呵呵。



unit ScreenSpy;

interface

uses
  Windows, Classes, Variants, SysUtils, Graphics, Controls, Math, OverbyteIcsWSocket, Clipbrd, ZLibEx;

const
  DEF_STEP = 23;
  OFF_SET  = 24;

type
  PCapCmd = ^TCapCmd;
  TCapCmd = packed record
    Cmd:    Byte;
    Size:   Integer;
    Width:  Word;
    Height: Word;
  end;

  PCtlCmd = ^TCtlCmd;
  TCtlCmd = packed record
    Cmd:  Byte;
    X, Y: Word;
  end;

  TScreenSpy = class(TThread)
  private
    FScrStream: TMemoryStream;
    FSendStream: TMemoryStream;
    FFullBmp, FLineBmp, FRectBmp: TBitmap;
    FWidth, FHeight, FLine: Integer;
    FRect: TRect;
    FSocket: TWSocket;
    FCmd: TCapCmd;
    vCursor:HCURSOR;
    vDC:HDC;
    //
    function CheckScr: Boolean;
    function GetFirst: Boolean;
    function GetNext:  Boolean;
    function Compress: Boolean;
    function SendInfo: Boolean;
    function SendData: Boolean;
    procedure CopyRect(rt: TRect);
  protected
    procedure Execute; override;
  public
    constructor Create(ASocket: TWSocket); reintroduce;
    destructor Destroy; override;
  end;

implementation

constructor TScreenSpy.Create(ASocket: TWSocket);
begin
  FreeOnTerminate := True;
  FSocket := ASocket;
  FScrStream  := TMemoryStream.Create;
  FSendStream := TMemoryStream.Create;
  FFullBmp := TBitmap.Create;
  FLineBmp := TBitmap.Create;
  FRectBmp := TBitmap.Create;
  FWidth   := 0;
  FHeight  := 0;
  inherited Create(True);
end;

destructor TScreenSpy.Destroy;
begin
  FScrStream.Free;
  FSendStream.Free;
  FRectBmp.Destroy;
  FFullBmp.Destroy;
  FLineBmp.Destroy;
  inherited Destroy;
end;

procedure TScreenSpy.Execute;
begin
  while (not Terminated) and (FSocket.State = wsConnected) do
  begin
    if CheckScr then GetFirst else GetNext;
  end;
end;

function TScreenSpy.CheckScr: Boolean;
var
  nWidth, nHeight: Integer;
begin
  Result  := False;
  nWidth  := GetSystemMetrics(SM_CXSCREEN);
  nHeight := GetSystemMetrics(SM_CYSCREEN);
  if (nWidth <> FWidth) or (nHeight <> FHeight) then
  begin
    FWidth  := nWidth;
    FHeight := nHeight;
    FFullBmp.Width  := FWidth;
    FFullBmp.Height := FHeight;
    FLineBmp.Width  := FWidth;
    FLineBmp.Height := 1;
    FFullBmp.PixelFormat := pf15bit;
    FLineBmp.PixelFormat := pf15bit;
    FRectBmp.PixelFormat := pf15bit;
    FLine  := 0;
    Result := True;
  end;
end;

function TScreenSpy.GetFirst: Boolean;
begin
  SetCursor(LoadCursor(0,IDC_ARROW));
  vCursor:=GetCursor;
  vDC:=GetDC(0);
  FFullBmp.Canvas.Lock;
  BitBlt(FFullBmp.Canvas.Handle, 0, 0, FWidth, FHeight, vDC, 0, 0, SRCCOPY);
  DrawIcon(FFullBmp.Canvas.Handle,Mouse.CursorPos.X,Mouse.CursorPos.Y,vCursor);
  FFullBmp.Canvas.Unlock;
  ReleaseDC(0, vDC);
  SetRect(FRect, 0, 0, FWidth, FHeight);
  FScrStream.Clear;
  FScrStream.WriteBuffer(FRect, SizeOf(TRect));
  FFullBmp.SaveToStream(FScrStream);
  Result := Compress;
  if Result then
  begin
    SendInfo;
    Result := SendData;
  end;
end;

procedure TScreenSpy.CopyRect(rt: TRect);
begin
  FFullBmp.Canvas.Lock;
  FRectBmp.Canvas.Lock;
  try
    SetCursor(LoadCursor(0,IDC_ARROW));
    vCursor:=GetCursor;
    vDC:=GetDC(0);
    FRectBmp.Width  := rt.Right  - rt.Left;
    FRectBmp.Height := rt.Bottom - rt.Top;
    BitBlt(FFullBmp.Canvas.Handle, rt.Left, rt.Top, FRectBmp.Width, FRectBmp.Height, vDC, rt.Left, rt.Top, SRCCOPY);
    DrawIcon(FFullBmp.Canvas.Handle,Mouse.CursorPos.X,Mouse.CursorPos.Y,vCursor);
    BitBlt(FRectBmp.Canvas.Handle, 0, 0, FRectBmp.Width, FRectBmp.Height, FFullBmp.Canvas.Handle, rt.Left, rt.Top, SRCCOPY);
    FScrStream.WriteBuffer(FRect, SizeOf(TRect));
    FRectBmp.SaveToStream(FScrStream);
  finally
    FFullBmp.Canvas.Unlock;
    FRectBmp.Canvas.Unlock;
  end;
end;

function TScreenSpy.GetNext: Boolean;
var
  p1, p2: PDWORD;
  i, j: Integer;
begin
  Result := False;
  FScrStream.Clear;
  vCursor:=GetCursor;
  vDC:=GetDC(0);
  i := FLine;
  FLineBmp.Canvas.Lock;
  while i < FHeight do
  begin
    BitBlt(FLineBmp.Canvas.Handle, 0, 0, FWidth, 1, vDC, 0, i, SRCCOPY);
    DrawIcon(FLineBmp.Canvas.Handle,Mouse.CursorPos.X,Mouse.CursorPos.Y,vCursor);
    p1 := FFullBmp.ScanLine[i];
    p2 := FLineBmp.ScanLine[0];
    SetRect(FRect, -1, Max(i - DEF_STEP, 0), -1, Min(i + DEF_STEP * 2, FHeight));
    j := 0;
    while j < FWidth do
    begin
      if (p1^ <> p2^) then
      begin
        if (FRect.Right < 0) then FRect.Left := Max(j - OFF_SET, 0);
        FRect.Right := Min(j + OFF_SET, FWidth);
      end;
      Inc(p1);
      Inc(p2);
      Inc(j, 2);
    end;
    if (FRect.Right > -1) then 
    begin
      CopyRect(FRect);
      SetRect(FRect, -1, -1, -1, -1);
      Inc(i, DEF_STEP);
    end;
    Inc(i, DEF_STEP);
  end;
  FLineBmp.Canvas.Unlock;
  FLine := (FLine + 3) mod DEF_STEP;
  if FScrStream.Position > 0 then
  begin
    Result := Compress;
    if Result then Result := SendData;
  end;
  ReleaseDC(0, vDC);
  Sleep(30);
end;

function TScreenSpy.Compress: Boolean;
begin
  Result := False;
  try
    FSendStream.Clear;
    FScrStream.Position := 0;
    ZCompressStream(FScrStream, FSendStream);
    FSendStream.Position := 0;
    Result := True;
  except
  end;
end;

function TScreenSpy.SendInfo: Boolean;
begin
  try
    FCmd.Cmd  := 1;
    FCmd.Size := 0;
    FCmd.Width  := FWidth;
    FCmd.Height := FHeight;
    FSocket.Send(@FCmd, SizeOf(TCapCmd));
    Result := True;
  except
    Result := False;
  end;
end;

function TScreenSpy.SendData: Boolean;
begin
  try
    FCmd.Cmd := 2;
    FCmd.Size := FSendStream.Size;
    FSocket.Send(@FCmd, SizeOf(TCapCmd));
    FSocket.Send(FSendStream.Memory, FSendStream.Size);
    Result := True;
  except
    Result := False;
  end;
end;

end.
Google
 
本站原创作品，未经作者许可，严禁任何方式转载；转载作品，如果侵犯了您的权益，请联系我们！
龙脉加密锁 15元起 Grid++Report 报表 申请支付@网
　相关文章
没有相关文章
相关评论
共有评论9条
我要发表评论 查看全部评论
 
  DELPHI盒子版权所有 技术支持:深圳市麟瑞科技有限公司 1999-2024 V4.01 粤ICP备10103342号-1 更新RSS列表