Fórum Exemplo de service application com o codigo fonte ? #320505

unit uService;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
  IdBaseComponent, IdComponent, IdTCPServer, Forms;


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

type
  TmsServices = class(TService)
    tcpServer: TIdTCPServer;
    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);
    procedure tcpServerExecute(AThread: TIdPeerThread);
  private
    { Private declarations }
    ServiceThread: TServiceThread;
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

var
  msServices: TmsServices;

implementation

{$R *.DFM}

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

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

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

procedure TmsServices.ServicePause(Sender: TService; var Paused: Boolean);
begin
  ShowMessage(´Serviço Pausado´);
  ServiceThread.Suspend;
  Paused := True;
  tcpServer.Active := False;
end;

procedure TmsServices.ServiceStart(Sender: TService; var Started: Boolean);
begin
  ShowMessage(´Serviço Iniciado´);
  ServiceThread := TServiceThread.Create(False);
  Started := True;
  tcpServer.Active := True;
end;

procedure TmsServices.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  ShowMessage(´Serviço Parado´);
  ServiceThread.Terminate;
  Stopped := True;
  tcpServer.Active := False;
end;

{ TServiceThread }

function TServiceThread.CapturaTela: TBitmap;
var
  dc: hdc;
  cv: TCanvas;
begin
  result := TBitmap.Create;
  result.Width := Screen.Width;
  result.Height := Screen.Height;
  dc := GetDc(0);
  cv := TCanvas.Create;
  cv.Handle := dc;
  result.Canvas.CopyRect(Rect(0, 0, Screen.Width, screen.Height), cv, Rect(0, 0,
    Screen.Width, Screen.Height));
  cv.Free;
  ReleaseDC(0, DC);
end;

procedure TServiceThread.Execute;
var
  Stm : TStream;
  Tela : TBitmap;
  cmd : String;
  fn : String;
  R : integer;
begin
  inherited;
  while not (Terminated) do
  begin
    // coloque aki o codigo que o serviço deve executar
  end;
end;

procedure TmsServices.tcpServerExecute(AThread: TIdPeerThread);
var
  Stm : TStream;
  Tela : TBitmap;
  cmd : String;
  fn : String;
  R : Integer;
  I : Integer;
  Words : Integer;
  Janela : String;
begin
    Randomize;
    R := Random(Maxint);
    Fn := Format(´tela¬d.bmp´, [r]);
    Cmd := AThread.Connection.ReadLn;

    if Pos(´TELA´, cmd) > 0 then
    begin
      Tela := ServiceThread.CapturaTela;
      Tela.SaveToFile(fn);
      Tela.Free;
      Stm := TFileStream.Create(fn, fmOpenRead + fmShareDenyNone);
      Athread.Connection.OpenWriteBuffer;
      Athread.Connection.WriteStream(Stm);
      Athread.Connection.CloseWriteBuffer;
      FreeAndNil(Stm);
    end;

    if Pos(´FECHAR´, Cmd) > 0 then
    begin
      Words := 0;
      for I := Length(Cmd) downto 1 do
      begin
        if Cmd[I] = ´[´ then
        begin
          Janela := Copy(Cmd, Pos(´[´, Cmd) + 1 , Words - 1);
          Break;
        end
        else
          Inc(Words);
      end;
      PostMessage(FindWindow(Nil, PChar(Janela)), WM_QUIT, 0, 0);
    end;
    Athread.Connection.Disconnect;
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.

*)