RunAppAsService/SVCMainUn.pas at main · some-code-developer/RunAppAsService · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
unit SVCMainUn;

interface

uses
  Winapi.Windows, SysUtils, Vcl.SvcMgr, ServiceUn,ServiceParameters,Registry;

 type
  TAgentSvc = class(TService)
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure ServiceShutdown(Sender: TService);
    procedure ServiceContinue(Sender: TService; var Continued: Boolean);
    procedure ServicePause(Sender: TService; var Paused: Boolean);
    procedure ServiceAfterInstall(Sender: TService);
    procedure ServiceBeforeInstall(Sender: TService);
  private
    { Private declarations }
    ServiceThread : TServiceThread;
  public
    Description: String;
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

var
  AgentSvc: TAgentSvc;

implementation

{$R *.DFM}

uses DMUn;

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

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

procedure TAgentSvc.ServiceAfterInstall(Sender: TService);
var
  Reg: TRegistry;
begin
  LogMessage(DisplayName+' - Installed', EVENTLOG_SUCCESS, 0, 1);
  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', Description);
      Reg.CloseKey;
    end;
  finally
    Reg.Free;
  end;
end;

procedure TAgentSvc.ServiceBeforeInstall(Sender: TService);
begin
  Sender.ServiceStartName := _User;
  Sender.Password         := _Password;
  Sender.StartType        := stManual;
end;

procedure TAgentSvc.ServiceContinue(Sender: TService; var Continued: Boolean);
begin
  ServiceThread.Resume;
  Continued:=True;
  LogMessage(DisplayName+' - Resumed', EVENTLOG_SUCCESS, 0, 1);
end;

procedure TAgentSvc.ServicePause(Sender: TService; var Paused: Boolean);
begin
  ServiceThread.Suspend;
  Paused:=True;
  LogMessage(DisplayName+' - Suspended', EVENTLOG_SUCCESS, 0, 1);
end;

procedure TAgentSvc.ServiceShutdown(Sender: TService);
var
  Stopped : boolean;
begin
  // is called when windows shuts down
  ServiceStop(Self, Stopped);
end;

procedure TAgentSvc.ServiceStart(Sender: TService; var Started: Boolean);
begin
  ServiceThread := TServiceThread.Create(true);
  ServiceThread.FreeOnTerminate:=False;
  ServiceThread.Name:=Name;
  ServiceThread.DisplayName:=DisplayName;
  ServiceThread.Start;
  LogMessage(DisplayName+' - Started '+IntToStr(ServiceThread.ThreadID), EVENTLOG_SUCCESS, 0, 1);
  Started:=true;
 end;

procedure TAgentSvc.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  stopped:=false;
  if Assigned(ServiceThread) then
  begin
   ServiceThread.Terminate;
   ServiceThread.WaitFor;
   FreeAndNil(ServiceThread);
  end;
  LogMessage(DisplayName+' - Stopped', EVENTLOG_SUCCESS, 0, 1);
  stopped:=true;
end;

end.