unit AMailerServiceUnit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, Registry;
type
TSparkyThread = class(TThread)
public
procedure Execute; override;
end;
TAviaABSwedenAMailer = class(TService)
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceAfterInstall(Sender: TService);
procedure ServiceContinue(Sender: TService; var Continued: Boolean);
procedure ServicePause(Sender: TService; var Paused: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure ServiceExecute(Sender: TService);
private
{ Private declarations }
public
function GetServiceController: TServiceController; override;
{ Public declarations }
//procedure ServiceAfterInstall(Sender: TService);
//procedure ServiceExecute(Sender: TService);
end;
var
SparkyThread:TSparkyThread;
AviaABSwedenAMailer: TAviaABSwedenAMailer;
implementation
{$R *.DFM}
procedure LG(ss:string);
var sl:TStringList;
begin
sl:=TStringList.Create;sl.Clear;
sl.LoadFromFile('c:\tmp\log.txt');
sl.add(ss);
sl.SaveToFile('c:\tmp\log.txt');
sl.free;
end;
procedure TSparkyThread.Execute;
begin
while not Terminated do
begin
Beep;
Sleep(500);
LG('Amailer is running');
end;
end;
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
AviaABSwedenAMailer.Controller(CtrlCode);
end;
function TAviaABSwedenAMailer.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TAviaABSwedenAMailer.ServiceStart(Sender: TService;
var Started: Boolean);
begin
SparkyThread := TSparkyThread.Create(False);
Started := True;
end;
procedure TAviaABSwedenAMailer.ServiceAfterInstall(Sender: TService);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create(KEY_READ or KEY_WRITE);
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKey('\SYSTEM\CurrentControlSet\Services\' + Name, false) then
begin
Reg.WriteString('Description', '2Eposttjänst som sparar mail och bilagor till nätverket som filer.');
Reg.CloseKey;
end;
finally
Reg.Free;
end;
end;
procedure TAviaABSwedenAMailer.ServiceContinue(Sender: TService;
var Continued: Boolean);
begin
SparkyThread.Resume;
Continued := True;
end;
procedure TAviaABSwedenAMailer.ServicePause(Sender: TService;
var Paused: Boolean);
begin
SparkyThread.Suspend;
Paused := True;
end;
procedure TAviaABSwedenAMailer.ServiceStop(Sender: TService;
var Stopped: Boolean);
begin
SparkyThread.Terminate;
Stopped := True;
end;
procedure TAviaABSwedenAMailer.ServiceExecute(Sender: TService);
begin
while not Terminated do
begin
Beep;
Sleep(500);
LG('Amailer is running');
ServiceThread.ProcessRequests(False);
end;
end;
end.