Delphi的TService的輸入桌面切換（服务程序）（windows登录界面如何截图）

Posted 2020-06-19 朝闻道

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