Ver Mensaje Individual
  #3  
Antiguo 12-11-2004
Avatar de Enan0
Enan0 Enan0 is offline
Miembro
 
Registrado: may 2004
Ubicación: Argentina
Posts: 565
Reputación: 20
Enan0 Va por buen camino
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?
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.
Responder Con Cita