微信公众号搜"智元新知"关注
微信扫一扫可直接关注哦!

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

服务是“允许服务与桌面交互”.
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,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);
    hdcCompatible := CreateCompatibleDC(hdcScreen);
    hbmScreen := CreateCompatibleBitmap(hdcScreen,GetDeviceCaps(hdcScreen,HORZRES),VERTRES));
    SelectObject(hdcCompatible,hbmScreen);
    bmp:= TBitmap.Create;
    bmp.Handle:= hbmScreen;
    BitBlt(hdcCompatible,bmp.Width,bmp.Height,hdcScreen,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.

解决方法

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

有关原因的更多背景,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.

原文地址:https://www.jb51.cc/delphi/101639.html

版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。

相关推荐