Wie erstelle ich einen Dienst für WinNT / Win2000 / Win XP

[Andru]

Hi,
erstmal vielen Dank für dieses TUT. Hat mir auf jeden Fall super weitergeholfen.
Mein Problem jedoch ist, wenn ich den Service installiert habe und starte,
startet er meine Anwendung (ShellExecute in der ServiceStart-Prozedur), aber der Status
in der Dienste verwaltung ändert sich nicht.
Es steht zwar, dass der Dienst gestartet ist, aber ich habe nicht die Möglichkeit ihn wieder
zu beenden.
Was mache ich denn noch falsch? Wird der Status nicht über 'started := true' übergeben?

Hoffe, Ihr könnt mir weiterhelfen!

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
  shellAPI, tlhelp32;

type
  TTestService = class(TService)
    procedure ServiceAfterInstall(Sender: TService);
    procedure ServiceAfterUninstall(Sender: TService);
    procedure ServiceBeforeInstall(Sender: TService);
    procedure ServiceBeforeUninstall(Sender: TService);
    procedure ServiceContinue(Sender: TService; var Continued: Boolean);
    procedure ServiceCreate(Sender: TObject);
    procedure ServiceDestroy(Sender: TObject);
    procedure ServiceExecute(Sender: TService);
    procedure ServicePause(Sender: TService; var Paused: Boolean);
    procedure ServiceShutdown(Sender: TService);
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);

  private
    { Private-Deklarationen }
  public
    function GetServiceController: TServiceController; override;
    { Public-Deklarationen }
  end;

var
  TestService: TTestService;
  ProgHandle, RemoteHandle: THandle;

implementation

{$R *.DFM}

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

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

procedure TTestService.ServiceAfterInstall(Sender: TService);
begin
  showMessage('AfterInstall');
end;

procedure TTestService.ServiceAfterUninstall(Sender: TService);
begin
  showMessage('AfterUninstall');
end;

procedure TTestService.ServiceBeforeInstall(Sender: TService);
begin
  showMessage('BeforeInstall');
end;

procedure TTestService.ServiceBeforeUninstall(Sender: TService);
begin
  showMessage('BeforeUninstall');
end;

procedure TTestService.ServiceContinue(Sender: TService;
  var Continued: Boolean);
begin
  showMessage('OnContinue');
  Continued := True;
end;

procedure TTestService.ServiceCreate(Sender: TObject);
begin
  showMessage('OnCreate');
   ServiceExecute(self);
end;

procedure TTestService.ServiceDestroy(Sender: TObject);
begin
  showMessage('OnDestroy');
end;

procedure TTestService.ServiceExecute(Sender: TService);
begin
  showMessage('OnExecute - begin');
{  while not Terminated do
  begin
    ServiceThread.ProcessRequests(False);
  end;
}


  showMessage('OnExecute - end');


end;

procedure TTestService.ServicePause(Sender: TService; var Paused: Boolean);
begin
  showMessage('OnPause');
  Paused := True;
end;

procedure TTestService.ServiceShutdown(Sender: TService);
begin
  showMessage('OnShutdown');
end;

procedure TTestService.ServiceStart(Sender: TService; var Started: Boolean);
begin
  ShellExecute(ProgHandle, 'open', PChar('notepad.exe'),
  Nil, Nil, SW_NORMAL);
 // showMessage('OnStart');
  Started := True;
end;

procedure TTestService.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  RemoteHandle := FindWindow(NIL,'unbenannt - Editor');
  if RemoteHandle<>0 then PostMessage(RemoteHandle, wm_close, 1, 1);
 // showMessage('OnStop');
  Stopped := True;
end;




end.