All pastes #2048972 Raw Edit

Anonymous

public text v1 · immutable
#2048972 ·published 2011-04-21 12:52 UTC
rendered paste body
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.