Delphi-PRAXiS
Seite 1 von 3  1 23      

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Seltsames Verhalten NT-Service Komponente (https://www.delphipraxis.net/167348-seltsames-verhalten-nt-service-komponente.html)

kuba 25. Mär 2012 17:34

Seltsames Verhalten NT-Service Komponente
 
Hallo,

ich habe mit Delphi XE2 eine Service Anwendung angelegt. Dann einen Timer auf das Formular und folgenden Code hinterlegt:

Delphi-Quellcode:
unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.SvcMgr, Vcl.Dialogs,
  Vcl.ExtCtrls;

type
  TService2 = class(TService)
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    function GetServiceController: TServiceController; override;
    { Public-Deklarationen }
  end;

var
  Service2: TService2;

implementation

{$R *.DFM}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  Service2.Controller(CtrlCode);
end;

function TService2.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;


function CreateProcessWithLogon(lpUsername: PWideChar;
                                lpDomain: PWideChar;
                                lpPassword: PWideChar;
                                dwLogonFlags: DWORD;
                                lpApplicationName: PWideChar;
                                lpCommandLine: PWideChar;
                                dwCreationFlags: DWORD;
                                lpEnvironment: Pointer;
                                lpCurrentDirectory: PWideChar;
                                var lpStartupInfo: TStartupInfo;
                                var lpProcessInfo: TProcessInformation): BOOL; stdcall;
                                external 'advapi32' name 'CreateProcessWithLogonW';

function CreateEnvironmentBlock(var lpEnvironment: Pointer;
                                hToken: THandle;
                                bInherit: BOOL): BOOL; stdcall; external 'userenv';

function DestroyEnvironmentBlock(pEnvironment: Pointer): BOOL; stdcall;
external 'userenv';

const
  LOGON_WITH_PROFILE = $00000001;

{------------
Emulate the RunAs function
--------------}

function RunAs(User, Password, Command: String): Integer;
var dwSize:       DWORD;
    hToken:       THandle;
    lpvEnv:       Pointer;
    pi:           TProcessInformation;
    si:           TStartupInfo;
    szPath:       Array [0..MAX_PATH] of WideChar;
begin

  ZeroMemory(@szPath, SizeOf(szPath));
  ZeroMemory(@pi, SizeOf(pi));
  ZeroMemory(@si, SizeOf(si));
  si.cb:=SizeOf(TStartupInfo);

  if LogonUser(PChar(User), nil, PChar(Password), LOGON32_LOGON_INTERACTIVE,
  LOGON32_PROVIDER_DEFAULT, hToken) then
  begin
    if CreateEnvironmentBlock(lpvEnv, hToken, True) then
    begin
        dwSize:=SizeOf(szPath) div SizeOf(WCHAR);
        if (GetCurrentDirectoryW(dwSize, @szPath) > 0) then
        begin
          if (CreateProcessWithLogon(PWideChar(WideString(User)), nil,
          PWideChar(WideString(Password)),
              LOGON_WITH_PROFILE, nil, PWideChar(WideString(Command)),
              CREATE_UNICODE_ENVIRONMENT,
              lpvEnv, szPath, si, pi)) then
          begin
              result:=ERROR_SUCCESS;
              CloseHandle(pi.hProcess);
              CloseHandle(pi.hThread);
          end
          else
              result:=GetLastError;
        end
        else
          result:=GetLastError;
        DestroyEnvironmentBlock(lpvEnv);
    end
    else
        result:=GetLastError;
    CloseHandle(hToken);
  end
  else
    result:=GetLastError;
end;


procedure TService2.Timer1Timer(Sender: TObject);
begin
  RunAs('user','password','notepad.exe');
  Timer1.Enabled:=false;
end;

end.
Wenn ich den NT-Service mit run.exe /install installiere, dann startet notepad.exe. Starte ich den NT-Service mit "net start Service"2 passiert nichts. Starte ich run.exe in der Eingabeaufforderung, dann startet auch notepad.exe. Warum wird notepad.exe nicht gestartet wenn ich "net start Service2" eingebe ?? Beim Deinstallieren mit run.exe /uninstall startet notepad.exe übrigens auch.

kuba

Sir Rufo 25. Mär 2012 17:56

AW: Seltsames Verhalten NT-Service Komponente
 
Wenn der Service als Service läuft, dann gelten andere Spielregeln.

Kontrollier mal die Prozessliste (Prozesse aller Benutzer) und schau, ob dort Notepad auftaucht.

himitsu 25. Mär 2012 18:15

AW: Seltsames Verhalten NT-Service Komponente
 
Und dazu noch, RunAs gibt zwar den Fehlercode zurück ( wieso eigentlich als vorzeichenbehafteter Integer und nicht als vorzeichenloses HRESULT? ),
aber du wertest diesen nicht aus.

Nja, du wirst auch noch den Ziel-Desktop irgendwie zuweisen müssen, ansonsten wird der des Services verwendet und wenn der als "nicht interaktiv" eingestellt ist, dann gibt es Keinen.

kuba 25. Mär 2012 19:24

AW: Seltsames Verhalten NT-Service Komponente
 
Im Taskmanager taucht notepad.exe nur auf wenn ich den Service installiere/deinstalliere oder per Eingabeaufforderung run.exe eingebe.

Ich wollte ein Programm starten bevor ein Benutzer am Desktop angemeldet ist, natürlich nicht notepad.exe, sondern ein DOS Programm. Geht das überhaupt ??

KUBA

Luckie 25. Mär 2012 20:29

AW: Seltsames Verhalten NT-Service Komponente
 
Das Programm wird auf dem Desktop des Service laufen. Du wirst es also nicht sehen.

Dalai 25. Mär 2012 20:37

AW: Seltsames Verhalten NT-Service Komponente
 
Darf ich fragen, warum du dir den Aufwand des RunAs machst, wenn du eh schon einen Dienst hast und damit genug Rechte (sei es nun SYSTEM, LocalService oder NetworkService)? Oder geht's um ein längerlaufendes Programm, das mit dem Desktop interagieren können soll/muss?

MfG Dalai

kuba 25. Mär 2012 20:53

AW: Seltsames Verhalten NT-Service Komponente
 
Ich möchte ein Programm im Benutzerkontext starten bevor der Benutzer am Desktop angemeldet ist. Es geht mir konkret um die Benutzeranmeldung, während der Benutzeranmeldung erscheint der Start ORB. Wenn man darauf klickt geht das Startmenü auf. Ich möchte schon vor der Benutzeranmeldung ein Programm aktiv im Hintergrund haben, welches den Start ORB "unbrauchbar" macht sodaß kein Startmenü mehr erscheint.

Bisher habe ich noch keine Möglichkeit (z.B. Registry Tweak) gefunden um das Startmenü auszublenden.

Da hab ich einfach mal ein bischen experementiert und bin auf dieses seltsame Verhalten mit RunAs gestoßen. Ist doch schon seltsam dass notepad.exe beim Installieren des Service gestartet wird, oder ?

KUBA

Sir Rufo 25. Mär 2012 21:33

AW: Seltsames Verhalten NT-Service Komponente
 
Nein, ist es nicht, es hätte mich gewundert, wenn es da nicht starten würde

himitsu 25. Mär 2012 21:42

AW: Seltsames Verhalten NT-Service Komponente
 
Zitat:

Zitat von kuba (Beitrag 1158509)
Ist doch schon seltsam dass notepad.exe beim Installieren des Service gestartet wird, oder ?

Ich dachte nicht?

Zitat:

Und dazu noch, RunAs gibt zwar den Fehlercode zurück ( wieso eigentlich als vorzeichenbehafteter Integer und nicht als vorzeichenloses HRESULT? ),
aber du wertest diesen nicht aus.
Und was sagt es?

Bummi 25. Mär 2012 22:09

AW: Seltsames Verhalten NT-Service Komponente
 
@kuba
Du hattest doch schon mal eine funktionierende Version gepostet

http://www.delphipraxis.net/109191-p...ich-mal-4.html
28. Nov 2011, 22:16

oder was habe ich übersehen?


Alle Zeitangaben in WEZ +1. Es ist jetzt 03:34 Uhr.
Seite 1 von 3  1 23      

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz