Итак, вот что у меня получилось... Тестирование пока провел лишь на Windows 7 32bit. Остальные варианты позже тоже проверю (меня интересует еще по большому счету лишь Windows XP и 64-битные вариации обеих ОС). Помогите с оптимизацией алгоритма и кодов, плиз.
| Код |
uses
..., JwaWinBase, JwaWtsApi32;//Jedi я использовал для реализации запуска процесса в контексте активного пользователя; надо бы избавиться от этих библиотек, не успел еще разобраться, как...
type
PWTS_PROCESS_INFO = ^WTS_PROCESS_INFO;
WTS_PROCESS_INFO = packed record
SessionId: DWORD;
ProcessId: DWORD;
pProcessName: PChar;
pUserSid: PSID;
end;
type
procedure ConvertSidToStringSid(SID: PSID; var StringSid: LPSTR); stdcall;
external advapi32 name 'ConvertSidToStringSidA';
function WTSEnumerateProcesses(hServer: THandle; Reserved,Version: DWORD;
var ppProcessInfo: PWTS_PROCESS_INFO;var Count: DWORD): BOOL; stdcall;
external 'wtsapi32.dll' name 'WTSEnumerateProcessesA';
procedure WTSFreeMemory(pMemory: Pointer); stdcall;
external 'wtsapi32.dll' name 'WTSFreeMemory';
...
//получаем SID активного пользователя (того, кто монитором "владеет" на момент запуска)
function GetCurrentUserSID:string;
var
hToken:THandle;
ReturnLength:DWORD;
UserToken:PSIDAndAttributes;
res:LPSTR;
begin
if WTSQueryUserToken(WtsGetActiveConsoleSessionID,hToken) then
begin
Windows.GetTokenInformation(hToken,TokenUser,UserToken,0,ReturnLength);//здесь и далее "Windows." указываю во избежание конфликтов с переопределенными в Jedi процедурами
GetMem(UserToken,ReturnLength);
try
if Windows.GetTokenInformation(hToken,TokenUser,UserToken,ReturnLength,ReturnLength) then
begin
ConvertSidToStringSid(UserToken.Sid,res);
Result:=res;
end;
finally
FreeMem(UserToken);
end;
end;
end;
//запуск приложения от имени активного пользователя
procedure RunApp(FilePath:string);
var
hToken:THandle;
si:STARTUPINFOA;
pi:PROCESS_INFORMATION;
begin
if WTSQueryUserToken(WtsGetActiveConsoleSessionID,hToken) then
begin
ZeroMemory(@si,SizeOf(si));
si.cb:=SizeOf(si);
si.lpDesktop:=nil;
CreateProcessAsUser(hToken,nil,PANSIChar(FilePath),nil,nil,False,0,nil,nil,si,pi);
end;
end;
//поиск запущенного процесса по имени файла и SID пользователя; я проверяю наличие процесса по имени файла, но по-хорошему надо бы как-то иначе реализовать...
function CheckTask(ExeFileName,CurUserSID:string):Boolean;
var
Count,i:DWORD;
pProcessInfo,pCur:PWTS_PROCESS_INFO;
UserSID:LPSTR;
begin
Result:=false;
if not WTSEnumerateProcesses(0,0,1,pProcessInfo,Count)then
Exit;
for i:=0 to Count-1 do
begin
pCur:=Ptr(DWORD(pProcessInfo)+(i*SizeOf(WTS_PROCESS_INFO)));
if pCur.pProcessName=ExeFileName then
begin
ConvertSidToStringSid(pCur.pUserSid,UserSID);
if UserSID=CurUserSID then
Result:=true;
end;
end;
WTSFreeMemory(pProcessInfo);
end;
|
В основной рабочей процедуре службы в цикле через заданный интервал проверяю наличие процесса и, если нужно, выполняю запуск:
| Код |
if not CheckTask('program.exe',GetCurrentUserSID) then
RunApp('path/program.exe');
|
|
)
