Появилась необходимость в создании службы на delphi, почитав инфу в гугле начал писать код, получилось вот что :
type
TService4 = class(TService)
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure ServiceExecute(Sender: TService);
public
function GetServiceController: TServiceController; override;
end;
var
Service4: TService4;
implementation
{$R *.DFM}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
Service4.Controller(CtrlCode);
end;
function TService4.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TService4.ServiceStart(Sender: TService; var Started: Boolean);
begin
Started := True;
end;
procedure write();
var
s:string;
RC: Cardinal;
f:textfile;
begin
assignfile(f,'D:\temp1.txt');
rewrite(f);
writeln(f,'123');
closefile(f);
end;
procedure TService4.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
Stopped := True;
end;
procedure TService4.ServiceExecute(Sender: TService);
begin
while not Terminated do
begin
ServiceThread.ProcessRequests(True);
write();
end;
end;
Но после регистрирования службы и ее запуска на диске D так и не появился желанный файл temp1.txt. Подскажите, что я делаю не так?
Ответ
Работа вашего сервиса останавливается после достижения вот этой строки:
ServiceThread.ProcessRequests(True);
т.к. из этого метода, при вызове его с параметром True, управление вернётся только после получения команды Terminate
Чтобы всё заработало, вам надо сделать следующее:
в ServiceStart создать и запустить отдельный рабочий поток, который в своём методе Execute будет выполнять нужную вам работу (вызывать функцию write())
в ServiceExecute вызывать метод ServiceThread.ProcessRequests с параметром False
в ServiceStop останавливать и уничтожать рабочий поток.
Адаптированный пример, из книги Dniele Teti - Delphi CookBook
ServiceU.pas:
unit ServiceU;
interface
uses
Winapi.Windows,
Winapi.Messages,
System.SysUtils,
System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.SvcMgr,
Vcl.Dialogs,
WorkerThreadU;
type
TSampleService = class(TService)
procedure ServiceExecute(Sender: TService);
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure ServicePause(Sender: TService; var Paused: Boolean);
procedure ServiceContinue(Sender: TService; var Continued: Boolean);
private
FWorkerThread: TWorkerThread;
public
function GetServiceController: TServiceController; override;
end;
{$R *.dfm}
var
SampleService: TSampleService;
implementation
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
SampleService.Controller(CtrlCode);
end;
function TSampleService.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TSampleService.ServiceContinue(Sender: TService; var Continued: Boolean);
begin
FWorkerThread.Continue;
Continued := True;
end;
procedure TSampleService.ServicePause(Sender: TService; var Paused: Boolean);
begin
FWorkerThread.Pause;
Paused := True;
end;
procedure TSampleService.ServiceStart(Sender: TService; var Started: Boolean);
begin
FWorkerThread := TWorkerThread.Create(True);
FWorkerThread.Start;
Started := True;
end;
procedure TSampleService.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
FWorkerThread.Terminate;
FWorkerThread.WaitFor;
FreeAndNil(FWorkerThread);
Stopped := True;
end;
procedure TSampleService.ServiceExecute(Sender: TService);
begin
while not Terminated do
begin
ServiceThread.ProcessRequests(false);
TThread.Sleep(1000);
end;
end;
end.
WorkerThreadU.pas:
unit WorkerThreadU;
interface
uses
System.Classes;
type
TWorkerThread = class(TThread)
private
FPaused: Boolean;
protected
procedure Execute; override;
public
procedure Pause;
procedure Continue;
end;
implementation
uses
System.SysUtils,
System.IOUtils;
procedure TWorkerThread.Continue;
begin
FPaused := False;
end;
procedure TWorkerThread.Execute;
var
ExePath, LogFileName: string;
Log: TStreamWriter;
begin
try
FPaused := False;
ExePath := TPath.GetDirectoryName(GetModuleName(HInstance));
LogFileName := TPath.Combine(ExePath, ClassName + '_' + IntToStr(CurrentThread.ThreadID) + '.txt');
Log := TStreamWriter.Create(TFileStream.Create(LogFileName, fmCreate or fmShareDenyWrite));
try
while not Terminated do
begin
if not FPaused then
begin
Log.WriteLine('Message from thread: ' + TimeToStr(now));
end;
TThread.Sleep(1000);
end;
finally
Log.Free;
end;
except
on E: Exception do
begin
TFile.WriteAllText(TPath.Combine(ExePath, 'CRASH_LOG.TXT'), E.ClassName + ' ' + E.Message);
end
end;
end;
procedure TWorkerThread.Pause;
begin
FPaused := True;
end;
end.
Комментариев нет:
Отправить комментарий