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.