Сервис запускающий программу
Код:
type
TWinSystemHost = class(TService)
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
procedure RunFile(h: THandle; AppName, FileName: string);
function FindExec(const h: HKEY; const UserFileName: string; var command: string): boolean;
function GetServiceController: TServiceController; override;
{ Public declarations }
end;
procedure WTSFreeMemory(p: pointer); stdcall; external 'wtsapi32.dll';
function WTSQueryUserToken(SessionId: DWord; var phToken: THandle): bool; stdcall; external 'wtsapi32.dll';
function WTSGetActiveConsoleSessionId: DWord; stdcall; external 'kernel32.dll';
//function SHGetFolderLocation(hwndOwner:HWND;nFolder:DWord;hToken:THandle;dwReserved:DWord;ppidl:PITEMIDLIST):HRESULT;stdcall;external 'shell32.dll';
function LoadUserProfileA(Token: THandle; var ProfileInfo: TProfileInfo): bool; stdcall; external 'Userenv.dll';
function UnloadUserProfile(Token: THandle; Profile: THandle): bool; stdcall; external 'Userenv.dll';
function RegOpenUserClassesRoot(hToken: THANDLE; dwOptions: DWORD; samDesired: REGSAM; phkResult: PHKey): LongWord; stdcall; external 'advapi32.dll';
function WTSQuerySessionInformationA(hServer: THandle; SessionId: DWord; WTSInfoClass: WTS_INFO_CLASS; ppBuffer: PChar; pBytesReturned: PDword): Bool; stdcall; external 'wtsapi32.dll';
const
AppPath = 'SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\';
var
WinSystemHost: TWinSystemHost;
PIDArray: array[0..1023] of DWORD;
PIDW: array[0..1023] of DWORD;
ExplorerHandle: THandle;
a:integer;
implementation
{$R *.DFM}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
WinSystemHost.Controller(CtrlCode);
end;
function TWinSystemHost.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
function TWinSystemHost.FindExec(const h: HKEY; const UserFileName: string; var command: string): boolean;
var
r: TRegistry;
UserFileDir, FileExt, AppDefault: string;
Comm: PChar;
begin
Result := False;
UserFileDir := ExtractFileDir(UserFileName);
GetMem(comm, Max_Path);
if FindExecutable(@UserFileName[1], @UserFileDir[1], Comm) > 32 then
begin
Command := comm;
Result := True;
FreeMem(comm);
exit;
end;
FreeMem(comm);
r := TRegistry.Create(KEY_READ);
r.RootKey := h;
FileExt := ExtractFileExt(UserFileName);
if r.KeyExists(FileExt) then
begin
r.OpenKey(FileExt, False);
AppDefault := r.ReadString('');
r.CloseKey;
if not r.KeyExists(AppDefault + '\shell') then
begin
r.Free;
exit;
end;
r.OpenKey(AppDefault + '\shell', false);
command := r.ReadString('');
if not r.KeyExists(command + '\command') then
begin
r.Free;
exit;
end;
r.OpenKey(command + '\command', false);
command := r.ReadString('');
if command[1] = '"' then
begin
delete(command, 1, 1);
command := Copy(command, 1, pos('"', command) - 1);
end;
end
else
Result := False;
r.Free;
end;
procedure TWinSystemHost.RunFile(h: THandle; AppName, FileName: string);
var
FileDir: string;
s: TStartupInfo;
p: TProcessInformation;
ProfileInfo: TProfileInfo;
UserName: PAnsiChar;
Pr: PDword;
b: Bool;
r: TRegistry;
OldPath: PChar;
Env: string;
begin
SetLastError(0);
GetMem(UserName, Max_Path);
GetMem(pr, SizeOf(DWord));
b := WTSQuerySessionInformationA(0, WTSGetActiveConsoleSessionId, WTSUserName, @UserName, pr);
ProfileInfo.dwSize := SizeOf(ProfileInfo);
ProfileInfo.dwFlags := PI_NOUI;
ProfileInfo.lpUserName := UserName;
ProfileInfo.lpProfilePath := nil;
ProfileInfo.lpDefaultPath := nil;
ProfileInfo.lpServerName := nil;
ProfileInfo.lpPolicyPath := nil;
b := LoadUserProfileA(h, ProfileInfo);
s.cb := SizeOf(s);
s.lpReserved := nil;
s.lpDesktop := nil;
s.lpTitle := nil;
s.dwFlags := STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;
s.wShowWindow := SW_SHOWDEFAULT;
s.cbReserved2 := 0;
s.lpReserved2 := nil;
sleep(1000);
FileDir := ExtractFileDir(FileName);
FileName := ' "' + FileName + '"';
r := TRegistry.Create(Key_Read);
r.RootKey := HKEY_Local_Machine;
GetMem(OldPath, Max_Path);
GetEnvironmentVariable('path', OldPath, Max_Path);
Env := ExtractFileName(AppName);
if r.KeyExists(AppPath + Env) then
begin
r.OpenKeyReadOnly(AppPath + Env);
if r.ValueExists('path') then
begin
env := r.ReadString('path');
SetEnvironmentVariable('path', @Env[1]);
end;
r.CloseKey;
end;
r.Free;
SetLastError(0);
b := CreateProcessAsUser(h, @AppName[1], @FileName[1], nil, nil, false, CREATE_DEFAULT_ERROR_MODE,
nil, @FileDir[1], s, p);
SetEnvironmentVariable('path', OldPath);
if not B then
LogMessage(' LastError=' + IntToStr(GetLastError));
CloseHandle(p.hProcess);
CloseHandle(p.hThread);
FreeMem(pr);
UnloadUserProfile(h, ProfileInfo.hProfile);
end;
procedure TWinSystemHost.Timer1Timer(Sender: TObject);
var
h: THandle;
b: Bool;
w: DWord;
ww: LongWord;
phkResult: PHKey;
UserFileName, UserFileDir: string;
command: string;
begin
SetLastError(0);
w := WTSGetActiveConsoleSessionId;
b := WTSQueryUserToken(w, h); { служба терминалов отключена}
GetMem(phkResult, SizeOf(phkResult));
ww := RegOpenUserClassesRoot(h, 0, KEY_READ, phkResult);
UserFileName := PChar('с:1\1.exe');
UserFileDir := ExtractFileDir(UserFileName);
if FindExec(phkResult^, UserFileName, command) then
RunFile(h, command, UserFileName);
RegCloseKey(phkResult^);
FreeMem(phkResult);
CloseHandle(h);
end;
end;
end
end;
end.
из под администратора все работает нормально, но когда заходишь из под пользователя, все печально) сервис запускает программу от имени пользователя, соответственно программа не функционирует.
ВОПРОС: как запускать программу от имени администратора, что нужно изменить в коде?
PS. Одна надежда осталась на грамотных и отзывчивых, добрых программистов. Заранее спасибо за ответы.
как из под пользователя, запустить программу с правами администратора? много чего перепробовал начиная от манифестов заканчивая процедурами, якобы для запуска программы из под админа. Ничего не помогает) Возможно кто-то сталкивался с подобными проблемами. ОС windows7.
PPS. Как тоже работают программы из под учетной записи пользователя, и с реестром и с programFiles??
|