Foros Club Delphi - Ayuda !!!! Service Application

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)

- API de Windows (https://www.clubdelphi.com/foros/forumdisplay.php?f=7)

- - Ayuda !!!! Service Application (https://www.clubdelphi.com/foros/showthread.php?t=15988)

Ayuda !!!! Service Application

Estoy intentando hace un servicio (sobre Windows 2000), el cual solo tiene un timer y lo que hace es a determinado dio compacta una base de datos, Pero por algun motivo este al cabo de unos 15 seg. Aprox, se detiene.. alguien sabe que es lo que puede pasar.. probe el codigo y funciona bien, le hice depurandolo y anda bien... solo que tambien se cierra a los 15 seg.

Tambien he probado con una aplicacion de sercivio que solo tengo un timer y que cada 10 seg haga beep. y bueno lo hace una sola vez y luego se cierra alguna idea de a que le estoy errando???

Puedes postear algo del codigo? Es muy vago lo que mencionas.

Ademas, chequea que POR NADA del mundo se muestre ventanas del usuario, y que los errores no ejecuten Messageboxs ni nada por el estilo....

nooo nada de ventanas ni nada es un servicio!
ahora voy intentar postear el codigo yso delphi 6, ha otra cosa como se hace para instalarlo? :confused:
Bueno todo el codigo completo!!!! yo creo que no tiene ningun error. porque lo probe bajandole el tiempo al timer y funciona todo ok!! pero a ese tiempo se cierra!!!
una PERSONA DEL FORO me hizo unas modificaciones y el de el funciona.. todabia no lo he visto.. pero quiero saber mi error.. y despues como hago apara instalarlo!! saludos

Código:

 

 

 unit CompactRep;

 

 interface

 

 uses

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

   ExtCtrls,zip, registry, JRO_TLB;

 

 type

   TCompactarYreparar = class(TService)

         TimerSql: TTimer;

         procedure TimerSqlTimer(Sender: TObject);

         procedure ServiceBeforeInstall(Sender: TService);

         procedure ServiceStart(Sender: TService; var Started: Boolean);

         procedure ServiceStop(Sender: TService; var Stopped: Boolean);

 

   private

         { Private declarations }

   public

         function GetServiceController: TServiceController; override;

         function LeerPath:String;

         function Zipear:boolean;

         procedure reparar(ruta:string);

         { Public declarations }

   end;

 

 var

   CompactarYreparar: TCompactarYreparar;

 

 implementation

 

 {$R *.DFM}

 

 procedure ServiceController(CtrlCode: DWord); stdcall;

 begin

   CompactarYreparar.Controller(CtrlCode);

 end;

 

 function TCompactarYreparar.GetServiceController: TServiceController;

 begin

   Result := ServiceController;

 end;

 

 procedure TCompactarYReparar.TimerSqlTimer(Sender: TObject);

 begin

  zipear; //esto va adentro del if!!!!

    if (formatdatetime('dddd',now)='Domingo')and(formatdatetime('hh:mm AM/PM',now)='02:00 AM') then

           begin

 

           end;

 end;

 

 

 

 function TCompactarYreparar.LeerPath:string;

 Var

    Registry:TRegistry;

 

 begin

         Registry:=TRegistry.Create;

         Registry.RootKey:=HKEY_LOCAL_MACHINE;

         if Registry.OpenKey('Software\Radio Frecuencia',False) then

            Result:=Registry.ReadString('Path');

         Registry.Free;

 end;

 

 function TCompactarYreparar.Zipear: boolean;

 var Zip:TZip;

    ruta:String;

 begin

 TRY

    ruta:=LeerPath;

    reparar(ruta);

    if Not DirectoryExists(ruta + 'BackUp\') then

           CreateDir(ruta + 'BackUp\');

    Zip:=TZip.create(nil);

    zip.FileSpecList.Add(ruta + 'Base.mdb');

    zip.Filename:=ruta + 'BackUp\' + FormatDateTime('DDMM_hhmm',now)+'.ZIP';

    zip.Add;

    if FileExists(ruta + 'Base.mdb') then

           DeleteFile(ruta + 'Base.mdb');

    CopyFile(pchar(ruta + 'basenueva.mdb'),Pchar(ruta+'Base.mdb'),false);

    if FileExists(ruta+'basenueva.mdb') then

           DeleteFile(ruta+'basenueva.mdb');

    result:=TRUE;

 EXCEPT

    REsult:=FALSE

 END;

 end;

 

 procedure TCompactarYreparar.reparar(ruta:string);

 

  var

  engine: IJetEngine;

  src, dst, path: WideString;

 begin

    // Directio donde se encuentra

    path :=ruta;

    //src: Base de Datos existente con assword antiguo

    src := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + path + 'base.mdb' +

    ';Jet OLEDB:Database Password=basepdt6146';

    //dst: Base de Datos nueva con password cambiado

    dst := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + path + 'basenueva.mdb' +

    ';Jet OLEDB:Database Password=basepdt6146';

  engine := CoJetEngine.Create();

  engine.CompactDatabase(src, dst);

 end;

 

 

 

 

 procedure TCompactarYreparar.ServiceBeforeInstall(Sender: TService);

 begin

  application.Run;

 end;

 

 

 

 procedure TCompactarYreparar.ServiceStart(Sender: TService;

   var Started: Boolean);

 begin

 application.Run;

 end;

 

 procedure TCompactarYreparar.ServiceStop(Sender: TService;

   var Stopped: Boolean);

 begin

    stopped:=true;

 end;

 

 end.

Mi niño. Si el servicio no esta registrado, es logico que se ejecute una sola vez, como si de una aplicacion trivial se tratase. Creo que para instalarlo basta con especificar el parametro /INSTALL luego del nombre del servicio.

Puedes siempre confirmar que el mismo aparezca entre los servicios en el control panel, o escribiendo net start en el command prompt

Hector, Gracias por la info, pero el /INSTALL ya lo habia probado y no me los registra, solo lo ejecuta una vez, no se si tendria que especificar ese parametro dentro de la aplicación y que haga algo mas!!! pero bueno lo desconozco .. Gracias igual!!

Vamos a ver, mis conocimietos de servicios son prácticamente nulos pero la ayuda de Delphi dice:

Cita:

Empezado por ayuda de Delphi

OnExecute event (TService)

If you are not spawning a new thread to handle individual service requests in an OnStart event handler, this is where you implement the service. When the OnExecute event handler finishes, the service thread terminates. Most OnExecute event handlers contain a loop that calls the service thread’s ProcessRequests method so that other service requests are not locked out.

¿Dónde está el evento OnExecute? Sin un loop como el que indica la ayuda y el ejemplo que ahí mismo viene, pues parece lógico que el servicio se detenga.

// Saludos

Mas problemas Con el Servicio!

Cuando pongo (nombre de archivo) /INSTALL me da el siguiente error y no me lo instala ni me lo registra? tienen alguna idea??

Service "Compactar y Reparar" failed to install with error: System Error. Code -1073741571

se me dio por probar con /REGISTER y me lo creo! :p:D y me lo agrego en los servicios.. despues lo inicie y me dio un error que decia "el servicio Compactar y Reparar" (asi se llama) no a respondido a las peticiones de... y se me quedo con el control total del CPU, jijijii bueno seguire probando!!! haa no lo pude detener.. tube que reiniciar la pc! :(

Hola, eh leido el problema que te sale de compactar y reparar,
Lo que pasa que al instalarlo como servicio la ruta donde levanta el servicio es la de documents and settings y como tu base de datos no esta en esa dirección ocurre el error que mencionas, lo que te recomiendo es que utilices el registro de windows para guardar la ruta de tu base de datos y antes de compartar captures la ruta y coloca tu aplicacion en el directorio donde se encuentra la base de datos con el setcurretdir() o algo por el estilo
Suerte