Сервис запускающий программу

[sonyk]

Доброго времени суток, уважаемые программисты, подскажите пожалуйста в одной проблеме:
Есть сервис запускающий приложение:

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??

[sonyk]

Товарищи программисты, делфисты и не только. Неужели нет людей сталкивающихся с данной проблемой.

[p51x]

Нужно выбросить получение имени и профиля пользователя, запуск от имени пользователя и для своего сервиса при установки запросить права.

[Serge_Bliznykov]

sonyk, эту тему - http://www.programmersforum.ru/showthread.php?t=143296 видели?

там есть ссылка на http://forum.sources.ru/index.php?showtopic=294130&hl=
пробовали предложенный там способ?

А сам сервис установлен под администратором и работает под учёткой администратора?

Управление правами на службы Windows
вот тут не про это?

[min@y™]

click me

[sonyk]

p51x, Не могли бы Вы подробней рассказать, а по возможности показать что надо изменить.
Serge_Bliznykov, с манифестом тоже проблема, как только сервис запускает программу из под учетной записи пользователя он попросту не работает не знаю, что еще попробовать поэтому к Вам и обратился. Помогите пожалуйста.

Товарищи программисты, делфисты), я конечно могу ошибаться но я вижу два пути решения данной проблемы:
1. Заметил одну особенность, что когда программа запускается из под учетной записи администратора, я делаю сменить пользователя (без выхода из учетной записи), то в учетной записи обычного пользователя программа работает нормально. Может быть можно как то сделать эмуляцию запуска программы из под администратора?
2. Планировщик заданий тоже с этой задачей справляется, запускает с правами администратора и все прекрасно работает. Может кто нибудь из здесь присутствующих гуру программирования знает как эту возможность реализовать в данном проекте.

Как обычно) надеюсь только на ваш профессионализм и отзывчивость, заранее спасибо за любую помощь.

[sonyk]

Многоуважаемые программисты набрел на такой код:

unction CreateProcessWithLogonW(
    lpUsername: LPCWSTR;
    lpDomain: LPCWSTR;
    lpPassword: LPCWSTR;
    dwLogonFlags: DWORD;
    lpApplicationName: LPCWSTR;
    lpCommandLine: LPWSTR;
    dwCreationFlags: DWORD;
    lpEnvironment: Pointer;
    lpCurrentDirectory: LPCWSTR;
    const lpStartupInfo: _STARTUPINFOA;
    var lpProcessInfo: _PROCESS_INFORMATION
  ): Boolean; stdcall; external 'Advapi32.dll';
  
procedure TForm1.Button1Click(Sender: TObject);
var
  startupinfo: _STARTUPINFOA;
  processinformation: _PROCESS_INFORMATION;
begin
  ZeroMemory(@startupinfo, SizeOf(_STARTUPINFOA));
  startupinfo.cb:=SizeOf(_STARTUPINFOA);
  startupinfo.dwFlags:=STARTF_USESHOWWINDOW;
  startupinfo.wShowWindow:=SW_SHOW;
  if OpenDialog1.Execute then
  Edit1.Text:=OpenDialog1.FileName;
  FileName := PWideChar(WideString(Edit1.Text));
 
  if CreateProcessWithLogonW('имя уч записи', nil, 'пароль', 0, nil, FileName, 0, nil, nil, startupinfo, processinformation) then
  begin
    CloseHandle(processinformation.hThread);
    CloseHandle(processinformation.hProcess);
  end else RaiseLastOSError;
end;

который запускает выбранную программу от имени и пароля указанного в коде. Он работает без нареканий. Теперь вопрос:
У меня сервис будет устанавливаться из под учетной записи администратора, возможно ли сделать доработки что-бы не вводить в ручную имя админа и пароль.

[p51x]

Вам уже говорили: выбросьте запуск от имени или профиля пользователя. Устанавливайте и запускайте сервис с админскими правами и от его контекста запускайте прогу.

[sonyk]

Уважаемыйp51x, можете пояснить как это, от его контекста, в моем понимании сервис запускающий программу уже должен унаследовать программе администраторские привилегии.
И что конкретно по тексту нужно поменять?
Моих скромных знаний не хватает самому прийти к этому