Delphi TService Input Desktop Swap (service program) (Windows login interface how to screenshot)

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], dwdummy) and 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], dwdummy) and then
Begin
OutputDebugString (' getuserobjectinformation hthddesk Failed. ');
Closedesktop (Hinpdesk);
Exit;
End
if (not Getuserobjectinformation (Hinpdesk, Uoi_name, @sInpName [0], dwdummy) and 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) does
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

Because the lock interface after Windows switches to Session0, and your program runs at the current user session.

WTS API can help you, go to Sesson0 re-run a process to intercept the diagram and return to the current process through the IPC is good.

Yes, Session0 isolation is introduced from Windows Vista. Another 2CCC should have a WSDT unit, unfortunately 2CCC does not support content search

http://bbs.2ccc.com/topic.asp?topicid=506628

Delphi TService Input Desktop Swap (service program) (Windows login Interface)