Новичок
Профиль
Группа: Участник
Сообщений: 3
Регистрация: 25.11.2017
Репутация: нет Всего: нет
|
Доброго времени суток, уважаемые программисты, подскажите пожалуйста в одной проблеме: Есть сервис запускающий приложение: Код | unit Unit2; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, Psapi, ExtCtrls, ShlObj, ComObj, ActiveX, Registry, ShellAPI, Tlhelp32,WinSvc; const PI_NOUI = 1; type WTS_INFO_CLASS = (WTSInitialProgram, WTSApplicationName, WTSWorkingDirectory, WTSOEMId, WTSSessionId, WTSUserName, WTSWinStationName, WTSDomainName, WTSConnectState, WTSClientBuildNumber, WTSClientName, WTSClientDirectory, WTSClientProduct, WTSClientHardwareId, WTSClientAddress, WTSClientDisplay, WTSClientProtocolType); _WTS_CONNECTSTATE_CLASS = (WTSActiveWTSActive, WTSConnected, WTSConnectQuery, WTSShadow, WTSDisconnected, WTSIdle, WTSListen, WTSReset, WTSDown, WTSInit); SessionInfo = ^_WTS_SESSION_INFO; _WTS_SESSION_INFO = record SessionId: DWord; pWinStationName: PChar; State: _WTS_CONNECTSTATE_CLASS; end; pDWord = ^DWord; MySessionInfo = array of SessionInfo; ppSessionInfo = ^MySessionInfo; //pHandle=^THandle; PProfileInfo = ^TProfileInfo; TProfileInfo = packed record dwSize: DWORD; dwFlags: DWORD; lpUserName: PAnsiChar; lpProfilePath: PAnsiChar; lpDefaultPath: PAnsiChar; lpServerName: PAnsiChar; lpPolicyPath: PAnsiChar; hProfile: THandle; end; PProfileInfoW = ^TProfileInfoW; TProfileInfoW = packed record dwSize: DWORD; dwFlags: DWORD; lpUserName: PWideChar; lpProfilePath: PWideChar; lpDefaultPath: PWideChar; lpServerName: PWideChar; lpPolicyPath: PWideChar; hProfile: THandle; end; 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??
|