Why the screenshot doesn't work (black screen)?

Question

Service is "Allow Service to Interact with Desktop".

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.

Answer 1

In Vista and later, a service won't be able to take a screenshot, or otherwise interact with the desktop -- "Allow Service to Interact with Desktop" is no longer supported. Services run in an isolated session that can't interact with the desktop. For more details, read up on "session 0 isolation".

For more background about why, this thread explains:

As multiples sessions are running because of terminal services or remote desktop connections there is no one to one relationship between a service and an interactive window station with one desktop. You can have one per interactive session. Which one should the service talk to? What if nobody looks at any desktop of the machine your service runs on - nobody notices that messagebox or whatever UI stuff.

Relying on that "feature" is just not adequate anymore. Get rid of it, there will be no alternative.

Answer 2

As an addition to Joe White's answer:

Most apps that have both a service and a UI nowadays are split in multiple processes: at least one service, and at least one (autostarting) UI process.

These processes communicate with each others through IPC and Synchronization objects like (Named) Pipes, (Memory Mapped) files, Mail slots, Queues, Events, Mutexes, Semaphores, etc. Note there is some overlap in those objects (some regarded more as IPC, others more like synchronization). A good start for Windows is at the MSDN Inteprocess Communications page.

This is for instance how Input Director works. It consists of these processes:

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

Number 1. runs as a service process and loads 2.
Number 3. runs as a UI process and loads 4.

A great way of observing how these interact is through Process Explorer and Process Monitor from SysInternals.