Problem z uruchomieniem aplikacji z usługi pod Vistą

Cześć, muszę uruchomić aplikację z usługi(service application) - kod, który to wykonuje znajduje się poniżej i został znaleziony gdzieś w necie.
I na XP ładnie działa, natomiast na Viście nic się nie dzieje. Zupełnie nic. Czy ktoś wie o co chodzi?

(wywołuję procedurę ExecuteProcessAsLoggedOnUser)

unit CreateProcessIntr;

interface

uses
  Windows, SysUtils, Registry, TlHelp32;

procedure ExecuteProcessAsLoggedOnUser(FileName: string);

implementation

function GetShellProcessName: string;
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create(KEY_READ);
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    Reg.OpenKeyReadOnly('Software\Microsoft\Windows NT\CurrentVersion\WinLogon');
    Result := Reg.ReadString('Shell');
  finally
    Reg.Free;
  end;
end;

function GetShellProcessPid(const Name: string): Longword;
var
  Snapshot: THandle;
  Process: TProcessEntry32;
  B: Boolean;
begin
  Result := 0;
  Snapshot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if Snapshot <> INVALID_HANDLE_VALUE then
  try
    FillChar(Process, SizeOf(Process), 0);
    Process.dwSize := SizeOf(Process);
    B := Process32First(Snapshot, Process);
    while B do
    begin
      if CompareText(Process.szExeFile, Name) = 0 then
      begin
        Result := Process.th32ProcessID;
        Break;
      end;
      B := Process32Next(Snapshot, Process);
    end;
  finally
    CloseHandle(Snapshot);
  end;
end;

function GetShellHandle: THandle;
var
  Pid: Longword;
begin
  Pid := GetShellProcessPid(GetShellProcessName);
  Result := OpenProcess(PROCESS_ALL_ACCESS, False, Pid);
end;

procedure ExecuteProcessAsLoggedOnUser(FileName: string);
var
  ph: THandle;
  hToken, nToken: THandle;
  ProcInfo: TProcessInformation;
  StartInfo: TStartupInfo;
begin
  ph := GetShellHandle;
  if ph > 0 then
  begin
    if OpenProcessToken(ph, TOKEN_DUPLICATE or TOKEN_QUERY, hToken) then
    begin
      if DuplicateTokenEx(hToken, TOKEN_ASSIGN_PRIMARY or TOKEN_DUPLICATE or TOKEN_QUERY,
        nil, SecurityImpersonation, TokenPrimary, nToken) then
      begin
        if ImpersonateLoggedOnUser(nToken) then
        begin
          // Initialize then STARTUPINFO structure
          FillChar(StartInfo, SizeOf(TStartupInfo), 0);
          StartInfo.cb := SizeOf(TStartupInfo);
          // Specify that the process runs in the interactive desktop
          StartInfo.lpDesktop := PChar('WinSta0\Default');

          // Launch the process in the client's logon session
          CreateProcessAsUser(nToken, nil, PChar(FileName), nil, nil, False,
            CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil, StartInfo, ProcInfo);

          // End impersonation of client
          RevertToSelf();
        end;
        CloseHandle(nToken);
      end;
      CloseHandle(hToken);
    end;
  end;
end;

end.

A jak odpalisz z uprawnieniami admina tez nie dziala? (prawym na exe'ca i run as administrator)

marcinsmolar napisał(a)

A jak odpalisz z uprawnieniami admina tez nie dziala? (prawym na exe'ca i run as administrator)

Też nie działa. W trybie zgodności z XP też nie działa.

Męczę się z tym już kilka ładnych dni i nic. Ktoś na coś może wpadł?

W związku z tym, ze nie bardzo możesz debuggowac aplikacje dzialajaca jako usluga - ja jak pisze tego typu rzeczy loguje wszystkie operacje do pliku.

Wez zrob sobie malutka procedurkę, ktora bedzie dzialala jak assert, tyle ze do pliku. W sensie - przed i po wykonaniu kolejnych kroków - program będzie zapisywał do pliku komunikaty (np. linijka 1 przed, linijka 1 po).

Zobaczysz w ten sposob czy program przechodzi wszystkie warunki poprawnie i wchodzi dokladnie w te miejsca programu, ktore spodziewasz sie, ze odwiedzi.

Kiedy ustalisz miejsce nieprawidlowego dzialania - zacznij do pliku zrzucac zawartosci zmiennych.

No i przede wszystkim opakuj to klauzula try ... except ... end i zobasz, czy przypadkiem nie generuje sie jakis blad, a jezeli tak - E.Message zrzuc do pliku logu.

Wyśledziłem, że program zatrzymuje się na instrukcji ImpersonateLoggedOnUser(nToken).
Po prostu się zatrzymuje. Instrukcja nie zwraca nic, try..except też się nie wykonuje.

Wiesz co ... zapytalem googla o: ImpersonateLoggedOnUser vista

Jest sporo wynikow z takim samym probleme jak Twoj. Poczytaj.

W jednym z wątków jest odpowiedź. Może ci pomoże:

http://www.eggheadcafe.com/software/aspnet/30165920/strange-problem-with-wtsq.aspx

Też czytałem na google, ale wszędzie(i w tym linku, co podałeś) ta instrukcja się wykonuje. U mnie nie. Po prostu się jakby zawiesza.

Przepraszam. Za cienki w uszach jestem, zeby ci bardziej pomoc :(

[diabel] Też mam z tym problem może ktoś potrafi pomóc ;)

Może ktoś ma pomysł jak rozwiązac ten problem ;) ????