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:UsersPublicScreenShot' + 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:
(编辑:李大同) 【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容! |