Criar uma aplicação que rode como Serviço no WinXP

Delphi

02/06/2004

Como faço p/ criar uma aplicação no delphi q rode como serviço no WinXP?









[color=red:eb34d40f57]Título alterado pelo Moderador oTTo. Removido: ´Serviço´.[/color:eb34d40f57]


Aamorim

Aamorim

Curtidas 0

Respostas

Lbcosta

Lbcosta

02/06/2004

primeiramente vc dever criar um novo projeto usando ´Service Application´. Vou colar abaixo um exemplo simples de serviço.

-------------------------------------------------------------------------------------

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs;

type
TServiceThread = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
end;

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

var
Service1: TService1;

implementation

{$R *.DFM}

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

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

{ TServiceThread }

procedure TServiceThread.Execute;
begin
while not (Terminated) do
begin
// coloque aki o codigo que o serviço deve executar
end;
end;

{ TService1 }

procedure TService1.ServiceContinue(Sender: TService;
var Continued: Boolean);
begin
ServiceThread.Resume;
Continued := True;
end;

procedure TService1.ServicePause(Sender: TService; var Paused: Boolean);
begin
ServiceThread.Suspend;
Paused := True;
end;

procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
begin
ServiceThread := TServiceThread.Create(False);
Started := True;
end;

procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
ServiceThread.Terminate;
Stopped := True;
end;

end.

-------------------------------------------------------------------------------------

Se o seu serviço tiver que obter alguma ação do usuário ou exibir alguma msg na tela a propriedade Interactive deve ser setada para True;

Para instalar o serviço vc deve digitar project1.exe /install
Para deinstalar o serviço vc deve digitar project1.exe /uninstall

Para rodar o serviço: net start ´nome do seu serviço´
Para parar o serviço: net stop ´nome do seu serviço´

O serviço tb pode ser iniciado e parado no ´gerenciador do computador´

O nome do serviço é definido no propriedade DisplayName

Espero que tenha ajudado.


GOSTEI 0
Ariovaldo

Ariovaldo

02/06/2004

Senhores já estou a alguns dias tentando criar uma aplicação como Serviço e não estou conseguindo já encontrei alguns exemplos mas continuo sem solução, acontece o seguinte:

Este Serviço deve conectar-se ao Banco de Dados SQL Server não estou conseguindo conectar com o Banco pois já coloquei a Conexão em varios eventos em todos os casos a CPU da Maquina vai a 100¬ já coloquei o comando Slep más o problema persiste.

o Outro Problema é o seguinte meu serviço funciona atraves do componente Timer conforme o Exemplo Abaixo Meu código deveria ser locado dentro desta procedura porém preciso colocar no evento On timer do Componente Time como poderia fazer isso?

procedure TServiceThread.Execute;
begin
while not (Terminated) do
begin
// coloque aki o codigo que o serviço deve executar
end;
end;


GOSTEI 0
Massuda

Massuda

02/06/2004

Este Serviço deve conectar-se ao Banco de Dados SQL Server não estou conseguindo conectar com o Banco pois já coloquei a Conexão em varios eventos em todos os casos a CPU da Maquina vai a 100¬...
Talvez o serviço esteja tentando mostrar o dialog box pedindo nome de usuário e senha. Se for isso, o serviço está travado, pois por default um serviço não pode ter janelas (no sentido Windows).

Outra coisa que pode estar ocorrendo é que como os serviços são iniciados no boot do Windows, pode ser que sua conexão com o BD dependa de uma conexão de rede que ainda não está pronta para uso logo depois que o Windows boota.

...meu serviço funciona atraves do componente Timer...
O componente TTimer não funciona dentro de um serviço; isso acontece porque todo TTimer precisa criar uma janela (no sentido Windows) e por default um serviço não pode ter janelas. Você precisa usar outra forma, por exemplo fazendo o código esperar por um evento (usando, por exemplo, WaitForSingleObject) que nunca ocorrerá; nesse caso, o timeout de espera deve ser o tempo que você utilizaria no TTimer.


GOSTEI 0
Ariovaldo

Ariovaldo

02/06/2004

Senhores com relação ao Processo da CPU eu aparentemente eu aparentemente solucionar aumentando o Sleep ao invés de colocar 1 eu coloquei 50 ainda não sei qual efeito Colateral que isso pode trazer.

Com relação ao Componente TTimer o Colega Massuda nos informou que não pode ser usado porém só para teste eu havia colocado esta Rotina abaixo para simplesmente a cada 1 Minuto ela escreva a data e a Hora em um arquivo texto para mim e aparentemente esta funcionando, más como o Massuda Informou o TTimer não deve ser Utilizado portanto gostaria de solicitar se alguém tiver uma rotina para escrever este mesmo Arquivo só que usando [b:2b5c494f13]WaitForSingleObject[/b:2b5c494f13] que foi a sugestão do Massuda.

procedure TFormServico.Timer1Timer(Sender: TObject);
Var
ArqTXT : TextFile;
Arq : String;
begin
Arq := extractFilePath(ParamStr(0)) + ´Arq\´ + ´Arq´ + FormatDateTime(´dd-mm-yyyy´,Date) + ´.TXT´;

AssignFile(ArqTXT,Arq);
If not FileExists(Arq) then
Rewrite(ArqTXT,Arq);

Append(ArqTXT);
WriteLn(ArqTXT, ´Data: ´ + FormatDateTime(´dd/mm/yyyy´,Date) + ´ Hora:´ + FormatDateTime(´hh:nn:ss´,Time));
CloseFile(ArqTXT);
end;


GOSTEI 0
Ariovaldo

Ariovaldo

02/06/2004

Sobe .........


GOSTEI 0
Massuda

Massuda

02/06/2004

...TTimer ... não pode ser usado porém só para teste ... aparentemente esta funcionando...
Qual a versào do seu Delphi? Você alterou alguma configuração do serviço em Painel de Controle|Ferramentas Administrativas|Serviços?


GOSTEI 0
Ariovaldo

Ariovaldo

02/06/2004

Não Massuda, apenas startei o serviço nem aquela opção interação com o usuario esta marcada. Estou com tres TTimer no serviço escrevendo em um arquivo só para teste e esta funcionando.


GOSTEI 0
Ariovaldo

Ariovaldo

02/06/2004

Desculpa Massuda a Versão do Delphi é 7.0


GOSTEI 0
Ariovaldo

Ariovaldo

02/06/2004

.Sobe


GOSTEI 0
Massuda

Massuda

02/06/2004

...tiver uma rotina para escrever este mesmo Arquivo só que usando [b:e58e97b525]WaitForSingleObject[/b:e58e97b525]...
Um jeito menos API e mais VCL de fazer isso seria (não testei)...
type 
  TServiceThread = class(TThread) 
  protected 
    procedure Execute; override; 
  end; 
....
uses
  SyncObjs,
...
procedure TServiceThread.Execute; 
var
  E: TEvent;
  ArqTXT: TextFile;
  Arq: String;
begin
  E := TEvent.Create(nil, False, False, ´´);

  while not (Terminated) do begin 
    
    E.WaitFor(1000);

    Arq  := ExtractFilePath(...
    AssignFile(ArqTXT, Arq);
    ....
    CloseFile(ArqTXT);
  end; 

  E.Free;
end;



GOSTEI 0
Ariovaldo

Ariovaldo

02/06/2004

Senhores no caso que eu tenho 3 TTimer como eu faria isso, tentei criar mais uma Trhead mas não funcionaou.

Abraços


GOSTEI 0
Marioguedes

Marioguedes

02/06/2004

Olá! Gostaria de saber se continuam com problemas pois eu já tenho alguma experiência com serviços do windows, mas como o tópico é antigo não sei se eu vou chover no molhado...


GOSTEI 0
Ariovaldo

Ariovaldo

02/06/2004

[quote:fd72a882b3=´Ariovaldo´]...tiver uma rotina para escrever este mesmo Arquivo só que usando [b:fd72a882b3]WaitForSingleObject[/b:fd72a882b3]...
Um jeito menos API e mais VCL de fazer isso seria (não testei)...
type 
  TServiceThread = class(TThread) 
  protected 
    procedure Execute; override; 
  end; 
....
uses
  SyncObjs,
...
procedure TServiceThread.Execute; 
var
  E: TEvent;
  ArqTXT: TextFile;
  Arq: String;
begin
  E := TEvent.Create(nil, False, False, ´´);

  while not (Terminated) do begin 
    
    E.WaitFor(1000);

    Arq  := ExtractFilePath(...
    AssignFile(ArqTXT, Arq);
    ....
    CloseFile(ArqTXT);
  end; 

  E.Free;
end;
[/quote:fd72a882b3]


Pessoal conforme o Exemplo acima escrito pelo Massuda eu consegui fazer funcionar as rotinas que precisam aguardar 1 Hora ou seja a cada 60 minutos a rotina é executada. agora eu tenho outra rotina que é executada a cada 10 Minuros neste caso como poderia ser feito? tenho que criar outro serviço ou existe como adicionar outra Thread e escrever o código nesta nova Thread?

Obrigado a todos


GOSTEI 0
Ariovaldo

Ariovaldo

02/06/2004

Sobe


GOSTEI 0
Massuda

Massuda

02/06/2004

Você pode criar uma segunda thread que é executada a cada 10 minutos, basta usar a thread que você já tem como modelo.


GOSTEI 0
Ariovaldo

Ariovaldo

02/06/2004

Ok então é só eu adicionar uma nova Thread e no bloco de códigos desta nova thread eu coloco o código novo correto?

Aproveitando a outra pergunta seria o seguinte eu gostaria que este serviço tivesse um Log na Tela para que eu puidesse vizualizar as ocorrencias com mais facilidade, como faria para adicionar um campo memo neste serviço para que quando eu marcasse a propriedade do serviço para ter interação com o Desktop este memo fosse vizualizado e caso eu desmarcasse ele ficaria oculto?

Um Abraço a todos


GOSTEI 0
Massuda

Massuda

02/06/2004

Ok então é só eu adicionar uma nova Thread e no bloco de códigos desta nova thread eu coloco o código novo correto?
Sim. Crie essa nova thread junto com a outra que já existe.

...como faria para adicionar um campo memo neste serviço para que quando eu marcasse a propriedade do serviço para ter interação com o Desktop este memo fosse vizualizado e caso eu desmarcasse ele ficaria oculto?
Nunca fiz isso... não sei se tem como saber se a opção está marcada ou não. Mas eu acho que se o form onde estiver o memo não for modal (ou seja, não for exibido usando ShowModal), o que vai acontecer é que quando a opção estiver habilitada você vai ver o form e quando não estiver o form ficará invisível. Se você experimentar, posta aqui o resultado, pois realmente não sei o que aconteceria.


GOSTEI 0
Ariovaldo

Ariovaldo

02/06/2004

Massuda conforme sua Orientação criei um Form com um Campo Memo Dentro,
no evento start do serviço eu dei um Form.Show e funciona perfeitamente, se eu for no serviço e desmarcar a interação com o DeskTop o Form não aparece, se eu deixar marcado o form aparece portanto funcionou redondinho, agora o que não estou conseguindo fazer é adicionar uma nova Thread eu vou lá em File New Others Seleciono Objeto Thread pede o nome eu coloco e no evento on execute eu coloco um código para escrever em um arquivo más não funciona. existe como debugar serviço?


GOSTEI 0
Massuda

Massuda

02/06/2004

A princípio, bastaria você por essa unit com a thread que você criou no uses da unit que tem o serviço e iniciar sua thread de dentro do serviço, junto com a thread que já existe...
procedure TService1.ServiceStart(Sender: TService; var Started: Boolean); 
begin 
  ServiceThread := TServiceThread.Create(False); 

  OutraServiceThread := TOutraServiceThread.Create(False); 

  Started := True; 
end;



GOSTEI 0
Massuda

Massuda

02/06/2004

...no evento on execute eu coloco um código para escrever em um arquivo más não funciona.
Talvez fosse interessante você postar esse código aqui.

...existe como debugar serviço?
Não conheço nenhuma forma simples de fazer isso.


GOSTEI 0
Ariovaldo

Ariovaldo

02/06/2004

Pessoal segue abaixo o código da Unit que esta funcionando da seguinte forma, o Serviço é iniciado e após 1 minuto ele executa a primeira vez e depois é executada a mesma rotina a cada 5 minutos, Pois bem agora preciso criar uma nova Thread que seja executada a cada 60 minutos, já tentei inserir uma Thread nova, mas vou ser Honesto não estou nem conseguindo inserir, gostaria de mais uma vez a ajuda de vcs

Valeu.

unit FrmPrincipal;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, SyncObjs;

type
TServiceThread = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
end;

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

var
Service1: TService1;
Seg : Integer;

implementation

uses EnviaEmail;


{$R *.DFM}

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

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

{ TServiceThread }

[b:0005074719]procedure TServiceThread.Execute;
var
E: TEvent;
Log: TextFile;
Arq: String;
begin
Arq := extractFilePath(ParamStr(0)) + ´Arquivo.txt´;
E := TEvent.Create(nil, False, False, ´´);
while not (Terminated) do Begin
E.WaitFor(Seg);
try
AssignFile(log,Arq);
if not FileExists(Arq) then
Rewrite(log,Arq);
Append(log);
WriteLn(log, ´Data: ´ + FormatDateTime(´dd/mm/yyy´,Date) + ´ Hora: ´ + FormatDateTime(´hh:nn:ss´,Time));
finally
CloseFile(log);
end;
Seg := [color=red:0005074719]300000;[/color:0005074719]
end;

E.Free;
end; [/b:0005074719]
{ TService1 }

procedure TService1.ServiceContinue(Sender: TService;
var Continued: Boolean);
begin
ServiceThread.Resume;
Continued := True;
end;

procedure TService1.ServicePause(Sender: TService; var Paused: Boolean);
begin
ServiceThread.Suspend;
Paused := True;
end;

procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
begin
[color=red:0005074719] Seg := 60000;[/color:0005074719]
ServiceThread := TServiceThread.Create(False);

Started := True;
end;

procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
ServiceThread.Terminate;
Stopped := True;
end;

end.


GOSTEI 0
Massuda

Massuda

02/06/2004

Vamos lá....
unit FrmPrincipal;

interface

...

type
  TServiceThread = class(TThread)
    ...
  end;

  TServiceThread2 = class(TThread)
  private
   { Private declarations }
  protected
    procedure Execute; override;
  end;

  TService1 = class(TService)
    ...
  private
    { Private declarations }
    ServiceThread: TServiceThread;
    ServiceThread2: TServiceThread2;
    ...
  end;

...

implementation

...

{ TServiceThread2 }

procedure TServiceThread2.Execute;
var
  E: TEvent;
  T: Integer; // contador de segundos
begin
  E := TEvent.Create(nil, False, False, ´´);

  T := 3600; // 1 hora = 3600 segundos

  while not (Terminated) do Begin

    E.WaitFor(1000); // 1 segundo

    Dec(T);
    if T = 0 then begin
      // faz o que tem que fazer a cada hora
      ...
      T := 3600;
    end;
  end;

  E.Free;
end;

{ TService1 } 

procedure TService1.ServiceContinue(Sender: TService; 
var Continued: Boolean);
begin
  ServiceThread.Resume;
  ServiceThread2.Resume;
  Continued := True;
end; 

procedure TService1.ServicePause(Sender: TService; var Paused: Boolean); 
begin 
  ServiceThread.Suspend;
  ServiceThread2.Suspend;
  Paused := True;
end;

procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
begin
  Seg := 60000;
  ServiceThread  := TServiceThread.Create(False);
  ServiceThread2  := TServiceThread2.Create(False);

  Started := True;
end;

procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  ServiceThread.Terminate;
  ServiceThread2.Terminate;
  Stopped := True;
end;

end.



GOSTEI 0
Ariovaldo

Ariovaldo

02/06/2004

Massuda desculpa a Imsistencia, mas eu não preciso ir em File ==> New ==> Others ==> Guia New Objecto Thread para criar uma Nova? Caso eu tenha que ir quando clico em Objecto Thread abre uma Janela Classe Name, o que eu coloco lá?

Até mais


GOSTEI 0
Ariovaldo

Ariovaldo

02/06/2004

Senhores aparentemente isso tá chegando ao final, porém ainda tenho um sério problema as vezes a Thread é executada e as vezes não é já debuguei escrevendo em arquivo texto mas as vezes a thread nen é executada, Alguma Sugestão?


GOSTEI 0
Ariovaldo

Ariovaldo

02/06/2004

Senhores primeiramente queria agradecer a ajuda de todos vocês que se empenharam em me ajudar a resolver este problema, o serviço ja esta no Ar e Funcionando corretamente más para isso tive que fazer uma alteração neste exemplo abaixo onde esta a Linha de comando [b:452f1e3a30]E.Free[/b:452f1e3a30], ou seja na Unit logo abaixo onde esta [b:452f1e3a30]E.FREE[/b:452f1e3a30] eu coloquei isso na procedure que paro o serviço pois se ela ficar no Final da Thread o sistema se perde e não executa nos horários previsto, será que tem algum problema?, estou monitorando a CPU da maquina e continua baixa da mesma forma que iniciou o serviço, estou preocupado em dar Estouro de memória.

Vamos lá....
unit FrmPrincipal;

interface

...

type
  TServiceThread = class(TThread)
    ...
  end;

  TServiceThread2 = class(TThread)
  private
   { Private declarations }
  protected
    procedure Execute; override;
  end;

  TService1 = class(TService)
    ...
  private
    { Private declarations }
    ServiceThread: TServiceThread;
    ServiceThread2: TServiceThread2;
    ...
  end;

...

implementation

...

{ TServiceThread2 }

procedure TServiceThread2.Execute;
var
  E: TEvent;
  T: Integer; // contador de segundos
begin
  E := TEvent.Create(nil, False, False, ´´);

  T := 3600; // 1 hora = 3600 segundos

  while not (Terminated) do Begin

    E.WaitFor(1000); // 1 segundo

    Dec(T);
    if T = 0 then begin
      // faz o que tem que fazer a cada hora
      ...
      T := 3600;
    end;
  end;

  [b]E.Free;[/b]
{ TService1 } 

procedure TService1.ServiceContinue(Sender: TService; 
var Continued: Boolean);
begin
  ServiceThread.Resume;
  ServiceThread2.Resume;
  Continued := True;
end; 

procedure TService1.ServicePause(Sender: TService; var Paused: Boolean); 
begin 
  ServiceThread.Suspend;
  ServiceThread2.Suspend;
  Paused := True;
end;

procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
begin
  Seg := 60000;
  ServiceThread  := TServiceThread.Create(False);
  ServiceThread2  := TServiceThread2.Create(False);

  Started := True;
end;

procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  ServiceThread.Terminate;
  ServiceThread2.Terminate;
  Stopped := True;
end;

end.



GOSTEI 0
Massuda

Massuda

02/06/2004

Talvez seja veiera minha, mas não consegui ver o que você modificou no código.


GOSTEI 0
Ariovaldo

Ariovaldo

02/06/2004

Talvez seja veiera minha, mas não consegui ver o que você modificou no código.


Massuda só tirei o E.free que estava no Final da Thread e coloquei dentro da procedure que da Stop no serviço, Ficando Assim


procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
[b:06e0007abc] A.Free;
B.Free;
C.Free;[/b:06e0007abc]

Envia_Email.Terminate;
Recebe_Email.Terminate;
Download_CIP.Terminate;

FormHistorico.Close;

Stopped := True;
end;


GOSTEI 0
Massuda

Massuda

02/06/2004

Desculpe... Relendo percebi um erro. Cada TEvent precisa ser criado com um nome distinto; antes não precisava porque só tinha um TEvent. faça algo assim...
...
{ TServiceThread } 

procedure TServiceThread.Execute; 
var 
  E: TEvent; 
...
  E := TEvent.Create(nil, False, False, ´TServiceThread´); 
...

{ TServiceThread2 } 

procedure TServiceThread2.Execute; 
var 
  E: TEvent; 
...
  E := TEvent.Create(nil, False, False, ´TServiceThread2´); 
...
  E.Free; 
end;
...assim será criado dois TEvent distintos e não um único como estava acontecendo antes.


GOSTEI 0
Ariovaldo

Ariovaldo

02/06/2004

Pessoal eu aqui novamente, estou tentando criar um serviço composto por três Threads e cada Thread deverá Aguardar um determinado tempo entre as execuções, o problema é que tem hora que a Thread é executada e tem hora que não é, já tentei criar os TEvents de todos os jeitos e não dá certo, estive analisando no Help do Delphi e pelo que pude entender ele cita que os Tevents devem ser criados em uma área Global e usar o mesmo TEvents para todas as Threads, mesmo assim sem sucesso. Caso alguém tenha um tempinho e quiser posso disponibilizar o código e quem sabe com a ajuda de voçês eu consiga resolver mais este problema.

Obrigado a todos.


GOSTEI 0
Ariovaldo

Ariovaldo

02/06/2004

Sobe


GOSTEI 0
POSTAR