为什么屏幕截图不起作用(黑屏)?

And*_*rew 6 delphi windows-7

服务是"允许服务与桌面交互".

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs;

type
  TCopyDesk = class(TService)
  procedure ServiceContinue(Sender: TService; var Continued: Boolean);
  procedure ServiceExecute(Sender: TService);
  procedure ServicePause(Sender: TService; var Paused: Boolean);
  procedure ServiceShutdown(Sender: TService);
  procedure ServiceStart(Sender: TService; var Started: Boolean);
  procedure ServiceStop(Sender: TService; var Stopped: Boolean);
  private
    procedure CopyScreen(const Index: Integer);
  public
    function GetServiceController: TServiceController; override;
  end;

var
  CopyDesk: TCopyDesk;

implementation

{$R *.DFM}

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

procedure TCopyDesk.CopyScreen(const Index: Integer);
const
  DefaultWindowStation = 'WinSta0';
  DefaultDesktop = 'Default';
  CAPTUREBLT = $40000000;
  WINSTA_ALL_ACCESS = $0000037f;
var
  Bmp: TBitmap;
  hwinstaSave: HWINSTA;
  hdeskSave: HDESK;
  hwinstaUser: HWINSTA;
  hdeskUser: HDESK;
  dwThreadId: DWORD;
  hdcScreen : HDC;
  hdcCompatible : HDC;
  hbmScreen : HBITMAP;
begin
  hwinstaUser:= OpenWindowStation(DefaultWindowStation, FALSE, WINSTA_ALL_ACCESS);

  hwinstaSave:= GetProcessWindowStation;
  if hwinstaUser = 0 then
  begin
    OutputDebugString(PChar('OpenWindowStation failed' + SysErrorMessage       (GetLastError)));
    exit;
  end;

  if not SetProcessWindowStation(hwinstaUser) then
  begin
    OutputDebugString('SetProcessWindowStation failed');
    exit;
  end;

//  hdeskUser:= OpenDesktop(DefaultDesktop, 0, FALSE, MAXIMUM_ALLOWED);
  hdeskUser:= OpenInputDesktop(0, False, MAXIMUM_ALLOWED);
  if hdeskUser = 0 then
  begin
    OutputDebugString('OpenDesktop failed');
    SetProcessWindowStation (hwinstaSave);
    CloseWindowStation (hwinstaUser);
    exit;
  end;
  dwThreadId:= GetCurrentThreadID;

  hdeskSave:= GetThreadDesktop(dwThreadId);

  if not SetThreadDesktop(hdeskUser) then
  begin
    OutputDebugString(PChar('SetThreadDesktop' + SysErrorMessage(GetLastError)));
    Exit;
  end;

  try
    hdcScreen := GetDC(0);//GetDC(GetDesktopWindow);//CreateDC('DISPLAY', nil, nil, nil);
    hdcCompatible := CreateCompatibleDC(hdcScreen);
    hbmScreen := CreateCompatibleBitmap(hdcScreen,
                     GetDeviceCaps(hdcScreen, HORZRES),
                     GetDeviceCaps(hdcScreen, VERTRES));
    SelectObject(hdcCompatible, hbmScreen);
    bmp:= TBitmap.Create;
    bmp.Handle:= hbmScreen;
    BitBlt(hdcCompatible, 0,0, bmp.Width, bmp.Height, hdcScreen, 0,0, SRCCOPY OR CAPTUREBLT);
    Bmp.SaveToFile('C:\Users\Public\ScreenShot\' + IntToStr(Index) + '.bmp');
  finally
    DeleteDC(hdcScreen);
    DeleteDC(hdcCompatible);
    Bmp.Free;
    Bmp:= nil;
  end;
  SetThreadDesktop(hdeskSave);
  SetProcessWindowStation(hwinstaSave);
  if hwinstaUser <> 0 then
    CloseWindowStation(hwinstaUser);
  if hdeskUser <> 0 then
    CloseDesktop(hdeskUser);
end;

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

procedure TCopyDesk.ServiceContinue(Sender: TService;
  var Continued: Boolean);
begin
  while not Terminated do
  begin
    Sleep(10);
    ServiceThread.ProcessRequests(False);
  end;
end;

procedure TCopyDesk.ServiceExecute(Sender: TService);
var
  Index: Integer;
begin
  Index:= 0;
  while not Terminated do
  begin
    CopyScreen(Index);
    Inc(Index);
    ServiceThread.ProcessRequests(False);
//    Sleep(1000);
//    if Index = 4 then
      DoStop;
  end;
end;

procedure TCopyDesk.ServicePause(Sender: TService; var Paused: Boolean);
begin
  Paused:= True;
end;

procedure TCopyDesk.ServiceShutdown(Sender: TService);
begin
  Status:= csStopped;
  ReportStatus();
end;

procedure TCopyDesk.ServiceStart(Sender: TService; var Started: Boolean);
begin
  Started:= True;
end;

procedure TCopyDesk.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  Stopped:= True;
end;
end.
Run Code Online (Sandbox Code Playgroud)

Joe*_*ite 15

在Vista及更高版本中,服务将无法截取屏幕截图,或以其他方式与桌面交互 - 不再支持"允许服务与桌面交互".服务在无法与桌面交互的隔离会话中运行.有关更多详细信息,请阅读" 会话0隔离 ".

有关原因的更多背景,此主题解释:

由于终端服务或远程桌面连接正在运行多个会话,因此服务与具有一个桌面的交互式窗口站之间没有一对一的关系.每个交互式会话可以有一个.服务应该与哪个人交谈?如果没有人看到你的服务运行的机器的任何桌面怎么办 - 没有人注意到消息框或任何UI的东西.

依靠这个"功能"已经不再适用了.摆脱它,将没有其他选择.


Jer*_*ers 5

作为Joe White回答的补充:

如今同时具有服务和UI的大多数应用程序分为多个进程:至少一个服务和至少一个(自动启动)UI进程.

这些进程通过IPC同步对象(如(命名)管道,(内存映射)文件,邮件插槽,队列,事件,互斥锁,信号量等)相互通信.请注意,这些对象有一些重叠(有些被视为IPC ,其他更像是同步).Windows的一个良好开端是在MSDN Inteprocess Communications页面上.

这就是Input Director的工作原理.它由以下过程组成:

  1. C:\ Program Files(x86)\ Input Director\IDWinService.exe
  2. C:\ Program Files(x86)\ Input Director\InputDirectorSessionHelper.exe
  3. C:\ Program Files(x86)\ Input Director\InputDirector.exe
  4. C:\ Program Files(x86)\ Input Director\InputDirectorClipboardHelper.exe

数字1.作为服务进程运行并加载2.
数字3.作为UI进程运行并加载4.

观察这些如何相互作用是通过一个伟大的方式进程资源管理器进程监视器Sysinternals的.

  • @David,我不明白你为什么不喜欢Jeroen的回答; 我赞成它是有帮助的.我的回答集中在"为什么不起作用?"; Jeroen回答了明显的后续问题,"如何使其工作?",即将代码拆分为服务和单独的UI流程.我没有看到对这个答案有什么不清楚或无益的答案 - 如果有的话,它可能对OP的最终目标比我的更有帮助,并且这种答案通常会在SO上得到提升. (4认同)
  • 为什么这会被贬低?(由于服务不是我的专业领域,我很好奇.) (3认同)