Einzelnen Beitrag anzeigen

Benutzerbild von kuba
kuba

Registriert seit: 26. Mai 2006
Ort: Arnsberg
588 Beiträge
 
Delphi 11 Alexandria
 
#1

Seltsames Verhalten NT-Service Komponente

  Alt 25. Mär 2012, 17:34
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 'advapi32name '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
Stefan Kubatzki
E=mc2
  Mit Zitat antworten Zitat