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
|
请发表评论