• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    公众号

Delphi的TService的輸入桌面切換(服务程序)(windows登录界面如何截图)(使用了Ope ...

原作者: [db:作者] 来自: [db:来源] 收藏 邀请

dfm:

object CopyDeskService: TCopyDeskService
  OldCreateOrder = False
  OnCreate = ServiceCreate
  OnDestroy = ServiceDestroy
  AllowPause = False
  DisplayName = 'Copy Desk Service'
  Interactive = True
  Left = 192
  Top = 107
  Height = 150
  Width = 215
end

pas:

unit Main;

interface

uses
  Windows, SysUtils, Classes, Graphics, SvcMgr;

type
  TCopyThread = class(TThread)
  private
    FIndex: DWORD;
    FScrBmp: TBitmap;
  protected
    procedure Execute; override;
  public
    constructor Create; reintroduce;
    destructor Destroy; override;
  end;

  TCopyDeskService = class(TService)
    procedure ServiceCreate(Sender: TObject);
    procedure ServiceDestroy(Sender: TObject);
  private
    FCopyThread: TCopyThread;
  public
    function GetServiceController: TServiceController; override;
  end;

var
  CopyDeskService: TCopyDeskService;

implementation

{$R *.DFM}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  CopyDeskService.Controller(CtrlCode);
end;

function TCopyDeskService.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TCopyDeskService.ServiceCreate(Sender: TObject);
begin
  FCopyThread := TCopyThread.Create;
end;

procedure TCopyDeskService.ServiceDestroy(Sender: TObject);
begin
  FCopyThread.Terminate;
end;

function SelectHDESK(HNewDesk: HDESK): Boolean; stdcall;
var
  HOldDesk: HDESK;
  dwDummy:  DWORD;
  sName:    array[0..255] of Char;
begin
 Result := False;
  HOldDesk := GetThreadDesktop(GetCurrentThreadId);
  if (not GetUserObjectInformation(HNewDesk, UOI_NAME, @sName[0], 256, dwDummy)) then
  begin
    OutputDebugString('GetUserObjectInformation Failed.');
    Exit;
  end;
  if (not SetThreadDesktop(HNewDesk)) then
  begin
    OutputDebugString('SetThreadDesktop Failed.');
    Exit;
  end;
  if (not CloseDesktop(HOldDesk)) then
  begin
    OutputDebugString('CloseDesktop Failed.');
    Exit;
  end;
  Result := True;
end;

function SelectDesktop(pName: PChar): Boolean; stdcall;
var
  HDesktop: HDESK;
begin
  Result := False;
  if Assigned(pName) then
    HDesktop := OpenDesktop(pName, 0, False,
                          DESKTOP_CREATEMENU or DESKTOP_CREATEWINDOW or
                          DESKTOP_ENUMERATE or DESKTOP_HOOKCONTROL or
                          DESKTOP_WRITEOBJECTS or DESKTOP_READOBJECTS or
                          DESKTOP_SWITCHDESKTOP or GENERIC_WRITE)
  else
    HDesktop := OpenInputDesktop(0, False,
                          DESKTOP_CREATEMENU or DESKTOP_CREATEWINDOW or
                          DESKTOP_ENUMERATE or DESKTOP_HOOKCONTROL or
                          DESKTOP_WRITEOBJECTS or DESKTOP_READOBJECTS or
                          DESKTOP_SWITCHDESKTOP or GENERIC_WRITE);
  if (HDesktop = 0) then
  begin
    OutputDebugString(PChar('Get Desktop Failed: ' + IntToStr(GetLastError)));
    Exit;
  end;
  Result := SelectHDESK(HDesktop);
end;

function InputDesktopSelected: Boolean; stdcall;
var
  HThdDesk: HDESK;
  HInpDesk: HDESK;
  dwError:  DWORD;
  dwDummy:  DWORD;
  sThdName: array[0..255] of Char;
  sInpName: array[0..255] of Char;
begin
  Result := False;
  HThdDesk := GetThreadDesktop(GetCurrentThreadId);
  HInpDesk := OpenInputDesktop(0, False,
                          DESKTOP_CREATEMENU or DESKTOP_CREATEWINDOW or
                          DESKTOP_ENUMERATE or DESKTOP_HOOKCONTROL or
                          DESKTOP_WRITEOBJECTS or DESKTOP_READOBJECTS or
                          DESKTOP_SWITCHDESKTOP);
  if (HInpDesk = 0) then
  begin
    OutputDebugString('OpenInputDesktop Failed.');
    dwError := GetLastError;
    Result := (dwError = 170);
    Exit;
  end;
  if (not GetUserObjectInformation(HThdDesk, UOI_NAME, @sThdName[0], 256, dwDummy)) then
  begin
    OutputDebugString('GetUserObjectInformation HThdDesk Failed.');
    CloseDesktop(HInpDesk);
    Exit;
  end;
  if (not GetUserObjectInformation(HInpDesk, UOI_NAME, @sInpName[0], 256, dwDummy)) then
  begin
    OutputDebugString('GetUserObjectInformation HInpDesk Failed.');
    CloseDesktop(HInpDesk);
    Exit;
  end;
  CloseDesktop(HInpDesk);
  Result := (lstrcmp(sThdName, sInpName) = 0);
end;

procedure CopyScreen(Bmp: TBitmap; out Index: DWORD);
var
  DC: HDC;
begin
  DC := GetDC(0);
  Bmp.Width  := GetSystemMetrics(SM_CXSCREEN);
  Bmp.Height := GetSystemMetrics(SM_CYSCREEN);
  Bmp.Canvas.Lock;
  try
    BitBlt(Bmp.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, DC, 0, 0, SRCCOPY);
    Bmp.SaveToFile('j:/p' + IntToStr(Index) + '.bmp');
    Inc(Index);
  finally
    Bmp.Canvas.Unlock;
    ReleaseDC(0, DC);
  end;
end;

constructor TCopyThread.Create;
begin
  FreeOnTerminate := True;
  FScrBmp := TBitmap.Create;
  FScrBmp.PixelFormat := pf8bit;
  FIndex := 0;
  inherited Create(False);
end;

destructor TCopyThread.Destroy;
begin
  FScrBmp.Free;
  FScrBmp := nil;
  inherited;
end;

procedure TCopyThread.Execute;
begin
  while (not Terminated) do
  begin
    if InputDesktopSelected then CopyScreen(FScrBmp, FIndex)
    else if SelectDesktop(nil) then CopyScreen(FScrBmp, FIndex);
    Sleep(3000);
  end;
end;

end.

http://blog.csdn.net/cdlff/article/details/3489941

因为锁定界面后Windows切换到Session0去了,而你的程序运行在当前用户Session.

WTS系API可以帮你,去Sesson0重新运行一个进程截好图后通过IPC返回当前进程就好了.

对了,Session0隔离从Windows Vista开始引入. 另外 2ccc 应该有一个 WSDT 的 单元,可惜 2ccc 不支持内容搜索

http://bbs.2ccc.com/topic.asp?topicid=506628


鲜花

握手

雷人

路过

鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
上一篇:
Delphi如何遍历目录中的各个子目录发布时间:2022-07-18
下一篇:
Delphi面向对象学习随笔一:类与对象的关系(转)发布时间:2022-07-18
热门推荐
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服(服务时间 9:00~18:00)

在线QQ客服
地址:深圳市南山区西丽大学城创智工业园
电邮:jeky_zhao#qq.com
移动电话:139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap