Ajuda na criação de um Windows Service

11/10/2023

0

Opa! Estou com algunas dificuldades para criar um serviço do Windows no Delphi 10.3.
O Objetivo desse serviço é ficar esperando para um periodo para verificar se um arquivo
está ou não dentro de uma pasta para poder ler esse arquivo.
Vou postar aqui meu codigo completo.

Minhas duvidas:
Como Proceder nos eventos para *Iniciar* e *Parar* o serviço?
Meu Serviço vai ter que execultar um comando em determidas hodas no dia. O que eu vou precisar fazer?
.
Assim está o codigo:

program VerifierService;

uses
  Vcl.SvcMgr,
  UntServico in 'source\UntServico.pas' {VerifierService: TService};

{$R *.RES}

begin
  // O Windows 2003 Server requer que StartServiceCtrlDispatcher seja chamado
  //   antes de CoRegisterClassObject, que pode ser chamado indiretamente por
  //   Application.Initialize. TServiceApplication.DelayInitialize permite
  //   Application.Initialize a ser chamado de TService.Main (após
  //   StartServiceCtrlDispatcher foi chamado).
  //
  // A inicialização atrasada do objeto Aplicativo pode afetar eventos que
  //   ocorrem antes da inicialização, como TService.OnCreate. Só é
  //   recomendado se o ServiceApplication registra um objeto de classe com
  //   OLE e deve ser usado com Servidor Windows 2003.
  // Application.DelayInitialize := True;
  //
  //----------------------------------------------------------------------------

  if not Application.DelayInitialize or Application.Installing then
    Application.Initialize;
  Application.CreateForm(TVerifierService, VerifierService);
  Application.Run;
end.
// Essa parte ⬆️ está tudo bem eu acho...  

Neste outro eu vou mostarndo no código as partes onde tenho duvidas.

uses
  Winapi.Windows, Winapi.Messages,
  System.Classes, System.DateUtils, System.IniFiles, System.StrUtils,
  System.SysUtils, System.Types, System.TypInfo, System.UITypes,
  System.Variants, System.Win.Registry,
  Vcl.Graphics, Vcl.Controls, Vcl.SvcMgr, Vcl.Dialogs, Vcl.Forms,
  Data.DB,
  FireDAC.Comp.Client, FireDAC.Comp.DataSet, FireDAC.Comp.UI, FireDAC.DApt,
  FireDAC.DApt.Intf, FireDAC.DatS, FireDAC.Stan.Async, FireDAC.Stan.Def,
  FireDAC.Stan.Error, FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Pool,
  FireDAC.Stan.Param, FireDAC.Phys, FireDAC.Phys.FB, FireDAC.Phys.FBDef,
  FireDAC.Phys.IBBase, FireDAC.Phys.Intf, FireDAC.UI.Intf, FireDAC.VCLUI.Wait;

type
  THostHotLine = class(TService)
   ...
    procedure ServiceCreate(Sender: TObject);
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure ServiceAfterInstall(Sender: TService);
    procedure ServiceExecute(Sender: TService);
  private
    { Private declarations }
  var
    Database   : string;  // Rota do arquivo do banco de dados
    Servidor   : string;  // IP ou nome da Maquina servidora
    Porta      : integer; // Porta de conexão do firebird - Default 3050
    VendorLib  : string;  // Rota do arquivo fbclient.dll
    Unidade    : string;  // Unidade do Google Drive
    Secao      : string;  // Indicados de Grupo no arquivo .ini
    Path       : string;  // Caminho do sistema no arquico .ini
    Lock       : integer;
  public
    { Public declarations }
    function GetServiceController: TServiceController; override;
    function GetFileverification(var FPath: String): Boolean;
    procedure GetIniFile(Option: Integer);
  end;

var
  HostHotLine: THostHotLine;
...
function THostHotLine.GetFileverification(var FPath: String): Boolean;
begin
  Result := True; // Bloqueia o Bando de dados
  if not DirectoryExists(FPath)then
  begin // Se não Existir
    ShowMessage('Google Drive Não Conectado'); 
  end else
  begin // Se não Existir Procura o arquivo Conf.ini
    if FileExists(FPath+'\Meu Drive\Conf.ini') then
    begin
      Path  := FPath+'\Meu Drive\Conf.ini';
      Secao := 'ShellClassConfi';
      GetIniFile(2); // Parametro 2 para procurar no arquivo Conf.ini 
      // Get confirmation to lock file in database
      if Lock = 1 then Result := True
        else Result := False;
    end else
    begin
    //  ShowMessage('If file does not exist, access allowed.');
    end;
  end;
end;

procedure THostHotLine.GetIniFile(Option: Integer);
var
  ArquivoIni : TIniFile;
begin
  {$REGION '  Lê os parâmetros do arquivo INI e atribui para os atributos '}
  ArquivoIni := TIniFile.Create(Path);
  try
    case Option of
      1:
      begin
        Database := ArquivoIni.ReadString ('CONEXAO', 'RETAGUARDA', '');
        Servidor := ArquivoIni.ReadString ('CONEXAO', 'IP_SERVIDOR', '');
        Porta := ArquivoIni.ReadInteger('CONEXAO', 'PORTA', 0);
        Unidade  := ArquivoIni.ReadString ('CONEXAO', 'UNIDADE', '');
        if Unidade = '' then
          Unidade  := 'G:';
      end;
      2:
      begin
        Lock := ArquivoIni.ReadInteger ('ShellClassConfi', 'ConfirmAppLok', 0);
      end;
    end;
  finally
    ArquivoIni.Free;
  end;
end;
...
procedure THostHotLine.ServiceAfterInstall(Sender: TService);
var
  regEdit : TRegistry;
begin
  regEdit := TRegistry.Create(KEY_READ or KEY_WRITE);
  try
    regEdit.RootKey := HKEY_LOCAL_MACHINE;
    if regEdit.OpenKey('\SYSTEM\CurrentControlSet\Services' + Name, False) then
    begin
      regEdit.WriteString('Description','Hotline Serviço - Host Database Configuration Service');
      regEdit.CloseKey;
    end;
  finally
    FreeAndNil(regEdit);
  end;
end;

procedure THostHotLine.ServiceCreate(Sender: TObject);
begin
  Path := ExtractFilePath(Application.ExeName)+'Conexao.ini';
  VendorLib := ExtractFilePath(Application.ExeName)+'fbclient.dll';
end;

// Não sei se esse  ServiceExecute está correto
procedure THostHotLine.ServiceExecute(Sender: TService);
var
  Hora : TTime;
  SQL  : string;
begin
  SQL  := 'UPDATE PARAMETROS SET VERSAO_BANCO = 9102';
  Atualizar.Close;
  Atualizar.SQL.Clear;
  Atualizar.SQL.Add(SQL);
  while not self.Terminated do
  begin
    if StrToInt(Parametros_VERSAO_BANCO.AsString) > StrToInt('9102') then
    begin
      Hora := Now;
      if (TimeToStr(Hora) >= '08:30:00') and (TimeToStr(Hora) <= '08:31:10') then
      begin
        if GetFileverification(Unidade)= True then
        begin
          Atualizar.ExecSQL;
          //ShowMessage('Atualizou!!!');
        end;
      end;
      if (TimeToStr(hora) >= '10:00:00') and (TimeToStr(hora) <= '10:00:10') then
      begin
        if GetFileverification(Unidade)= True then
        begin
          Atualizar.ExecSQL;
        end;
      end;
      if (TimeToStr(hora) >= '14:00:00') and (TimeToStr(hora) <= '14:00:10') then
      begin
        if GetFileverification(Unidade)= True then
        begin
          Atualizar.ExecSQL;
        end;
      end;
      if (TimeToStr(hora) >= '17:55:00') and (TimeToStr(hora) <= '18:30:10') then
      begin
        if GetFileverification(Unidade)= True then
        begin
          Atualizar.ExecSQL;
        end;
      end;
    end;
    ServiceThread.ProcessRequests(true);
  end;
end;

procedure THostHotLine.ServiceStart(Sender: TService; var Started: Boolean);
begin
  if FileExists(Path) then
  begin
    GetIniFile(1); // Procura arquivo de Coneção 
    //Passa os parâmetros para o objeto Conexão
    ...
  end else
  begin
    ShowMessage('Arquivo INI para configuração não encontrado.'+#13#10+'Aplicação será finalizada.');
//        ServiceStop(THostHotLine, True);
  end;
  try
    try
      Connection.Connected       := True;
    except
      on E:Exception do
      begin
        ShowMessage('Erro ao carregar parâmetros de conexão!'#13#10 + E.Message);
//        ServiceStop(THostHotLine, True);
      end;
    end;
  finally
    Parametros_.Open;
    Started := Connection.Connected;
  end;
  end;

procedure THostHotLine.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  Connection.Connected := False;
  Stopped := True;
end;
end.
Eduardo Silva

Eduardo Silva

Responder

Post mais votado

11/10/2023

Eu não tenho muita experiência implementando serviços, mas existem duas coisas a considerar.

1 - Aplicações que abrem janelas não funcionam direito como serviço. O serviço é executado de forma "anônima", já que o usuário não precisa estar logado, e geralmente é para processos em background.

2 - Podem haver limitações na capacidade de executar processos. Serviços podem ser limitados em alguns tipos de atividade, tanto pelo fato de executarem de forma anônima, que não dá acesso a recursos de usuários, como pelo fato de terem algum limite de segurança.

Arthur Heinrich

Arthur Heinrich
Responder

Utilizamos cookies para fornecer uma melhor experiência para nossos usuários, consulte nossa política de privacidade.

Aceitar