windows - pro - El servicio OnExecute falla, el hilo generado no se ejecuta

windows 10 pro iso file

Question

Primero vaya a comenzar mi propio servicio en Delphi 7. Seguí los documentos e hice que el servicio engendrara un hilo personalizado que emite un pitido y registra. Solo que no. El último intento fue poner el mismo código de pitido y registro en el procedimiento de evento OnExecute, pero cuando inicio el servicio aparece un diálogo de Windows que dice que se inició y luego se detuvo nuevamente.

Debería haber algo obvio que he pasado por alto en este código .

¿Podrías echar un vistazo? También aceptaré enlaces a proyectos de ejemplo de servicio descargables, sencillos y operativos ... para obtener algo que se llame cada 10 segundos y lo tomaré desde allí.

Answer 1

Eliminar el evento de método a continuación

procedure TAviaABSwedenAMailer.ServiceExecute(Sender: TService);
begin
  while not Terminated do
  begin
        Beep;
        Sleep(500);
        LG(''Amailer is running'');
                ServiceThread.ProcessRequests(False);
  end;
end;

Answer 2

Por favor, eche un vistazo a http://www.delphi3000.com/articles/article_3379.asp para obtener detalles sobre cómo crear un servicio. Hice esa publicación hace años, pero aún debería funcionar.

Answer 3

A continuación se presenta una aplicación de servicio básico.

Tenga en cuenta que si desea instalar el servicio en Windows Vista y superior con ServiceApp.exe / install, deberá asegurarse de ejecutar la aplicación con derechos de administrador.

También tenga en cuenta que, a pesar de fmShareDenyWrite, es posible que el contenido del archivo de registro no se pueda ver mientras se está ejecutando el servicio. Al menos no pude abrir el archivo con Notepad ++ hasta que paré el servicio. Esto puede tener que ver con el hecho de que tenía el servicio ejecutándose bajo la cuenta del sistema (a diferencia de mi propia cuenta de usuario).

Otra observación: si desea permitir que su servicio se pause y continúe, no use suspender ni reanudar. No son seguros para subprocesos y han quedado obsoletos en D2010 +. Usando el Evento T (Simple) o algo similar para controlar la ejecución del hilo del trabajador principal. Si no desea permitir que su servicio se pause y continúe, simplemente puede configurar AllowPause en False.

unit ServiceApp_fm;

interface

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

type
  TService1 = class(TService)
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
  private
    FWorker: TThread;
  public
    function GetServiceController: TServiceController; override;
  end;

var
  Service1: TService1;

implementation

{$R *.DFM}

type
  TMainWorkThread = class(TThread)
  private
    {$IFDEF UNICODE}
    FLog: TStreamWriter;
    {$ELSE}
    FLog: TFileStream;
    {$ENDIF}
    FRepetition: Cardinal;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Execute; override;
  end;

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

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

procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
begin
  FWorker := TMainWorkThread.Create;
  Started := True;
end;

procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  // Thread should be freed as well as terminated so we don''t have a memory
  // leak. Use FreeAndNil so we can also recognize when the thread isn''t
  // available. (When the service has been stopped but the process hasn''t ended
  // yet or may not even end when the service is restarted instead of "just" stopped.
  if FWorker <> nil then
  begin
    FWorker.Terminate;
    while WaitForSingleObject(FWorker.Handle, WaitHint-100) = WAIT_TIMEOUT do
      ReportStatus;
    FreeAndNil(FWorker);
  end;
  Stopped := True;
end;

{ TMainWorkThread }

constructor TMainWorkThread.Create;
var
  FileName: String;
begin
  inherited Create({CreateSuspended=}False);

  FileName := ExtractFilePath(ParamStr(0)) + ''/WorkerLog.txt'';
  {$IFDEF UNICODE}
  FLog := TStreamWriter.Create(FileName, False, TEncoding.Unicode);
  {$ELSE}
  FLog := TFileStream.Create(FileName, fmCreate);
  {$ENDIF}
end;

destructor TMainWorkThread.Destroy;
begin
  FLog.Free;
  inherited;
end;

procedure TMainWorkThread.Execute;
var
  Text: string;
begin
  inherited;

  while not Terminated do begin
    Inc(FRepetition);
    Text := Format(''Logging repetition %d''#13#10, [FRepetition]);

    {$IFDEF UNICODE}
    FLog.Write(Text);
    {$ELSE}
    FLog.Write(Text[1], Length(Text));
    {$ENDIF}
    Sleep(1000);
  end;
end;

end.

Answer 4

El pitido no funcionará, mira esta publicación .

Su procedimiento LG no es muy robusto, puede fallar si el archivo de registro no existe. Además, el usuario del servicio debe tener derecho a acceder al archivo. En un primer paso, puede ejecutar el servicio con su cuenta de usuario para realizar pruebas.