Fórum Construção de Serviços do Windows com Delphi #376574

Meus caros bom dia.

Estou com o seguinte problema.

Baixei um exemplo de construção de serviços para windows da web e alterei de acordo com a minha necessidade já que tentei construir um mas não conseguia instala-lo.

Pois bem, acontece que compilo e ele não apresenta erros e instalo sem problemas só que ele não executa a thread
que processa os dados.

Segue abaixo o código para que os colegas analisem e me ajudem a resolver o problema.

Obrigado a todos.

program FechamentoDoDia;

uses
  SvcMgr,
  NTServiceMain in 'NTServiceMain.pas' {FechamentoDia: TService},
  NTServiceThread in 'NTServiceThread.pas';

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TFechamentoDia, FechamentoDia);
  Application.Run;
end.
================================================================================
unit NTServiceMain;

interface

uses
  Windows, Messages, SysUtils, Classes, SvcMgr,
  NTServiceThread, IBDatabase, DB, IBCustomDataSet, IBStoredProc;

type
  TFechamentoDia = class(TService)
    dbDados: TIBDatabase;
    ibTransa: TIBTransaction;
    spATUALIZA_CHEQUES_RECEBER: TIBStoredProc;
    spATUALIZA_CONTAS_RECEBER: TIBStoredProc;
    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);
    procedure ServiceShutdown(Sender: TService);
  private
    { Private declarations }
    fServicePri            : Integer;
    fThreadPri             : Integer;

    { Internal Start & Stop methods }
    Function _StartThread( ThreadPri:Integer ): Boolean;
    Function _StopThread: Boolean;
  public
    { Public declarations }
    NTServiceThread       : TNTServiceThread;

    function GetServiceController: TServiceController; override;
  end;

var
  FechamentoDia: TFechamentoDia;

implementation

{$R *.DFM}

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

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

procedure TFechamentoDia.ServiceExecute(Sender: TService);
begin
     { Loop while service is active in SCM }
     While NOT Terminated do
     Begin
          { Process Service Requests }
          ServiceThread.ProcessRequests( False );
          { Allow system some time }
          Sleep(1);
     End;
end;

procedure TFechamentoDia.ServiceStart(Sender: TService; var Started: Boolean);
begin
     { Default Values }
     Started     := False;
     fServicePri := NORMAL_PRIORITY_CLASS;
     fThreadPri  := Integer(tpLower);

     { Set the Service Priority }
     Case fServicePri of
      0 : SetPriorityClass( GetCurrentProcess, IDLE_PRIORITY_CLASS );
      1 : SetPriorityClass( GetCurrentProcess, NORMAL_PRIORITY_CLASS );
      2 : SetPriorityClass( GetCurrentProcess, HIGH_PRIORITY_CLASS );
      3 : SetPriorityClass( GetCurrentProcess, REALTIME_PRIORITY_CLASS );
     End;

     { Attempt to start the thread, if it fails free it }
     If _StartThread( fThreadPri ) then
     Begin
          { Signal success back }
          Started := True;
     End Else
     Begin
          { Signal Error back }
          Started := False;
          { Stop all activity }
          _StopThread;
     End;
end;

procedure TFechamentoDia.ServiceStop(Sender: TService;
  var Stopped: Boolean);
begin
     { Try to stop the thread - signal results back }
     Stopped := _StopThread;
end;

procedure TFechamentoDia.ServicePause(Sender: TService; var Paused: Boolean);
begin
     { Attempt to PAUSE the thread }
     If Assigned(NTServiceThread) AND (NOT NTServiceThread.Suspended) then
     Begin
          { Suspend the thread }
          NTServiceThread.Suspend;
          { Return results }
          Paused := (NTServiceThread.Suspended = True);
     End Else Paused := False;
end;

procedure TFechamentoDia.ServiceContinue(Sender: TService;
  var Continued: Boolean);
begin
     { Attempt to RESUME the thread }
     If Assigned(NTServiceThread) AND (NTServiceThread.Suspended) then
     BEGIN
          { Suspend the thread }
          If NTServiceThread.Suspended then NTServiceThread.Resume;
          { Return results }
          Continued := (NTServiceThread.Suspended = False);
     END Else Continued := False;
end;

procedure TFechamentoDia.ServiceShutdown(Sender: TService);
begin
     { Attempt to STOP (Terminate) the thread }
     _StopThread;
end;

function TFechamentoDia._StartThread( ThreadPri: Integer ): Boolean;
begin
     { Default result }
     Result := False;
     { Create Thread and Set Default Values }
     If NOT Assigned(NTServiceThread) then
     Try
        { Create the Thread object }
        NTServiceThread := TNTServiceThread.Create( True );
        { Set the Thread Priority }
        Case ThreadPri of
         0 : NTServiceThread.Priority := tpIdle;
         1 : NTServiceThread.Priority := tpLowest;
         2 : NTServiceThread.Priority := tpLower;
         3 : NTServiceThread.Priority := tpNormal;
         4 : NTServiceThread.Priority := tpHigher;
         5 : NTServiceThread.Priority := tpHighest;
        End;
        { Set the Execution Interval of the Thread }
        NTServiceThread.Interval := 2;
        
        { Start the Thread }
        NTServiceThread.Resume;
        { Return success }
        If NOT NTServiceThread.Suspended then Result := True;
     Except
        On E:Exception do ; // TODO: Exception Logging
     End;
end;

function TFechamentoDia._StopThread: Boolean;
begin
     { Default result }
     Result := False;
     { Stop and Free Thread }
     If Assigned(NTServiceThread) then
     Try
        { Terminate thread }
        NTServiceThread.Terminate;
        { If it is suspended - Restart it }
        If NTServiceThread.Suspended then NTServiceThread.Resume;
        { Wait for it to finish }
        NTServiceThread.WaitFor;
        { Free & NIL it }
        NTServiceThread.Free;
        NTServiceThread := NIL;
        { Return results }
        Result := True;
     Except
        On E:Exception do ; // TODO: Exception Logging
     End Else
     Begin
          { Return success - Nothing was ever started ! }
          Result := True;
     End;
end;

end.
================================================================================
unit NTServiceThread;

interface

uses
  Windows, Messages, SysUtils, Classes;

type
  TNTServiceThread = Class(TThread)
  private
    { Private declarations }
  Public
    { Public declarations }
    Interval              : Integer;

    Procedure Execute; Override;
  Published
    { Published declarations }
  End;

implementation

uses NTServiceMain;

{ TNTServiceThread }

procedure TNTServiceThread.Execute;
var
  vHora     : String;
  vLimite   : integer;
  vExecute  : Boolean;

begin
  vHora := FormatDateTime('hh:mm:ss', Time);
  vLimite := StrToInt(Copy(vHora, 1, 2) + Copy(vHora, 4, 2) + Copy(vHora, 7, 2));
  vExecute  :=  False;

  while not vExecute do
  begin
    if vLimite >= 170000 then
    begin
      try
        NTServiceMain.FechamentoDia.dbDados.Connected :=  True;
      except
        MessageBox(Handle, 'Falha ao tentar conexão com o servidor de banco de dados!', 'Aviso', MB_OK+MB_ICONWARNING);
        Exit;
      end;

      try
        NTServiceMain.FechamentoDia.spATUALIZA_CONTAS_RECEBER.Close;
        NTServiceMain.FechamentoDia.spATUALIZA_CONTAS_RECEBER.ParamByName('PEMPRESA').AsString  :=  '44.777.951/0001-47';
        NTServiceMain.FechamentoDia.spATUALIZA_CONTAS_RECEBER.ParamByName('PFILIAL').AsString   :=  '44.777.951/0001-47';
        NTServiceMain.FechamentoDia.spATUALIZA_CONTAS_RECEBER.ParamByName('PDATA').AsDate       :=  Date;
        NTServiceMain.FechamentoDia.spATUALIZA_CONTAS_RECEBER.ExecProc;
        NTServiceMain.FechamentoDia.spATUALIZA_CONTAS_RECEBER.Transaction.CommitRetaining;
      except
        NTServiceMain.FechamentoDia.spATUALIZA_CONTAS_RECEBER.Transaction.RollbackRetaining;
        MessageBox(Handle, 'Houve uma falha no procedimento de atualização do contas a receber!', 'Aviso', MB_OK+MB_ICONWARNING);
        Exit;
      end;

      try
        NTServiceMain.FechamentoDia.spATUALIZA_CHEQUES_RECEBER.Close;
        NTServiceMain.FechamentoDia.spATUALIZA_CHEQUES_RECEBER.ParamByName('PEMPRESA').AsString  :=  '44.777.951/0001-47';
        NTServiceMain.FechamentoDia.spATUALIZA_CHEQUES_RECEBER.ParamByName('PFILIAL').AsString   :=  '44.777.951/0001-47';
        NTServiceMain.FechamentoDia.spATUALIZA_CHEQUES_RECEBER.ExecProc;
        NTServiceMain.FechamentoDia.spATUALIZA_CHEQUES_RECEBER.Transaction.CommitRetaining;
      except
        NTServiceMain.FechamentoDia.spATUALIZA_CHEQUES_RECEBER.Transaction.RollbackRetaining;
        MessageBox(Handle, 'Houve uma falha no procedimento de atualização no movimento de cheques a receber!', 'Aviso', MB_OK+MB_ICONWARNING);
        Exit;
      end;

      try
        NTServiceMain.FechamentoDia.dbDados.Connected :=  False;
      except
        MessageBox(Handle, 'Falha ao tentar desconexão com o servidor de banco de dados!', 'Aviso', MB_OK+MB_ICONWARNING);
        Exit;
      end;
      vExecute  :=  True;
    end;
  end;
end;

end.