NT-Dienst belastet den Prozessor zu stark

[Gerd Pluschke]

Hallo,

nach einigem Ausprobieren habe ich es nun geschafft, einen Systemdienst für WinNT/W2k zu programmieren. Allerdings habe ich jetzt folgendes Problem:
Sobald der Dienst gestartet ist, geht die Prozessorbelastung auf 100% und bleibt auch dort, bis der Dienst wieder beendet wurde.
Das Programm hat aber intern nur einen Timer laufen, der alle drei Stunden etwas ausführt. Ich habe den Verdacht, dass das am Timer liegt.
Liegt es am Timer?
Wenn nicht, woran dann ?
Wenn ja, welche alternative habe ich, um etwas regelmäßig ausführen zu lassen?

Gerd

[Andreas Kosch]

Hallo,

wenn die Prozessorauslastung auf 100% geht, arbeitet im Dienst eine <i>Message Loop</i> (Botschaftsbearbeitungs-Schleife), die noch im alten Win16-Stil ständig nach neuen Botschaften sucht. Da ein NT-Dienst sowieso einen eigenen Thread abspalten sollte, würde ich dort den Thread über <b>Sleep</b>-Aufrufe für diese Zeitspanne "schlafen legen" und auf den Timer verzichten (der in einem Dienst sowie ein Fremdkörper ist, solange nicht die Win32-API-Funktion <B>SetTimer</b> ohne Hilfsfenster augerufen wird).

Das könnte zum Beispiel so aussehen:
<pre>
{ ************************************************** *******************
Autor : Andreas Kosch
Compiler : Delphi 5 UpdatePack#1
Betriebssystem : Windows 2000
Datum : 20.12.2000
Beschreibung : Minimalbeispiel für einen Service (Dienst)
************************************************** ******************** }

unit OSSrvTest_Impl;

interface

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

type
TService1 = class(TService)
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceContinue(Sender: TService; var Continued: Boolean);
procedure ServicePause(Sender: TService; var Paused: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
private
{ Private-Deklarationen }
public
function GetServiceController: TServiceController; override;
{ Public-Deklarationen }
end;

TTestThread = class(TThread)
public
procedure Execute; override;
end;

var
Service1: TService1;

implementation

{$R *.DFM}

var
TestThread: TTestThread; // Service-Thread erledigt die Arbeit
sLastAction : String;

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

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

{ -----------------------------------------------------------}
{ Service soll die Arbeit in einem eigenen Thread verrichten }
{ -----------------------------------------------------------}

procedure TTestThread.Execute;
const
FILENAME = 'C:\SRVTEST.LOG';
var
aFile : TextFile;
begin
while not Terminated do
begin
AssignFile(aFile, FILENAME);
if FileExists(FILENAME) then
Append(aFile)
else
ReWrite(aFile);
WriteLn(aFile, FormatDateTime('dd.mm.yyyy hh:nn:ss', Now) + sLastAction);
CloseFile(aFile);
Sleep(5000);
end;
end;

procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
begin
sLastAction := ' (ServiceStart)';
TestThread := TTestThread.Create(False);
Started := True;
end;

procedure TService1.ServiceContinue(Sender: TService;
var Continued: Boolean);
begin
sLastAction := ' (ServiceContinue)';
TestThread.Resume;
Continued := TRUE;
end;

procedure TService1.ServicePause(Sender: TService; var Paused: Boolean);
begin
TestThread.Suspend;
Paused := TRUE;
end;

procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
TestThread.Terminate;
Stopped := TRUE;
end;

end.
</pre&gt