Service Apliccation
 

Saludos a todos!!:
bueno hace unos días puse un hilo que trata de esto mismo, lo dejé y lo he retomado, bueno de momento les digo que el servicio chequea si se ha copiado en determinados folder (los que me interesan) se han copiado un determinados fichero sip (los que me interesan) si se cumplen las condiciones entonces procede a descomprimirlos y a ponerlo en un log todo lo hace bien pero se ejecuta cómo un bucle infinito, y no para de descompactar y escribir en el log, me imagino que es por el while del evento onexecute del service y que el mismo es necesario para que se mantenga ejecutando el proceso, es decir este:

Código Delphi [-]
procedure TService1.ServiceExecute(Sender: TService);
begin
 JvChangeNotify1.Active:=true;
 while not terminated do
 ServiceThread.ProcessRequests(true);
 JvChangeNotify1.Active:=false;
end;

Disculpen si no me hecho explicar bien
Alguien puede decirme cómo solucionar esto????
Muchas Gracias!!!!

Resuelto parcialmente
 

Bueno parece que he resuelto de momento mi problema ,una vez que hay un cambio en el folder la propiedad jvchangenotify.active la pongo false, puse un timer que cxada un segundo pone esta propiedad en true y ahora en el evento onexecute del service puse esto:

Código Delphi [-]
begin
//JvChangeNotify1.Active:=true;
JvTimer1.Enabled:=true;
 while not terminated do
 ServiceThread.ProcessRequests(true);
 JvTimer1.Enabled:=false;
 
 //JvChangeNotify1.Active:=false;

end;

para mi no está bien , pero bueno por el momento me ha funcionado , que creen??

Que pasa con los servicios????
 

Nadie puede darme una mano con esto de los servicios??????? lo tengo funcionando pero tiene algunas dificulatades, si alguien cree que puede ayudarme se lo agradeceré

Es que no hay una condición de parada para el servicio, es decir de seguro tu servicio detecta si hay archivos comprimidos en una carpeta determinada, pero nunca se borran es decir siempre va a encontrar los mismo archivos y los va a descomprimir, quisiera que explicarás más el objetivo de tu proyecto, es decir para que lo descomprimes, y si te sirven los archivos zip ya descomprimidos

saludos:)

Bueno gracias ante todo, deja explicarme mejor , los archivos .zip lo que contienen son tablas dbf , estos son subidos mediante ftp a un servidor donde corre el servicio , los .zip siempre tienen el mismo nombre , la aplicación que accede al ftp lo primero que hace es borrar el archivo .zip (si existe claro está) luego comienza a copiar el nuevo .zip con el mismo nombre+"temp" , cuando termina de subirlo lo renombra quitandole el "temp" pq el servicio realize la acción de descompactar y luego ejecutar un stored procedure a un MS SQL SESERVER que utiliza las tablas dbf importandlas y haciendo una serie de reportes a partir de las mismas .
Hasta ahora ha trabajado bn , ahora me he dado cuenta que cuando coinciden la entrada de 2 .zip se cuelga , he estado pensando si se deben usar hilos para que pueda realizar las tareas sobre 2 o más archivos .zip que lleguen al mismo tiempo .
bueno si no me explcado mejor disculpa, que opinas deba de hacer???
saludos

Bueno no creo que se solucione con hilos, el problema está un poco en la lógica, ya que si llegan dos archivos casi seguidos, entonces al entrar el segundo, el primer archivo será borrado sin saber si ya ha sido descomprimido, además si entran dos al mismo tiempo entonces uno sobreescribe al otro (si es que esta habilitado lo de sobreescribir), y supongo que tienes alguna funcion o algo que verifica en el ftp si hay algun archivo, entonces, supongamos que está en dicho proceso y justo hay otro proceso que ha borrado el archivo anterior que de seguro lo está utilizando creo que te generaría error, quisiera que pusieras tu código para poder ayudarte

Yo tengo uno similiar al tuyo por lo que te recomiendo que manejes archivos con diferentes nombres, para que no se sobreescriban, yo por eso a los archivos les agrego la fecha y hora (con segundos) y un numero correlativo al nombre del archivo y no tengo problemas

Pon una parte de tu codigo o si puedes todo para chequearlo

PD: estoy suponiendo que la libreria para descomprimir que usas está ok

saludos.

bueno los archivos tienen el mismo nombre pero se ubican en carpetas diferentes de ahí que su path no es el mismo , me entiendes???
bueno aquí va el código:

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
  ExtCtrls, RxNotify, ShellNotify, JvComponentBase, JvChangeNotify, ZipMstr,
  TimerLst, JvTimer, DB, ADODB,Registry,IniFiles, JvLogFile;

type
  TServicioServerFTPTransfer = class(TService)
    JvChangeNotify1: TJvChangeNotify;
    ZipMaster1: TZipMaster;
    JvTimer1: TJvTimer;
    ADOStoredProc1: TADOStoredProc;
    ADOConnection1: TADOConnection;
    ADODataSet1: TADODataSet;
    ADOStoredProc2: TADOStoredProc;
    procedure ServiceExecute(Sender: TService);
    procedure RxFolderMonitor1Change(Sender: TObject);
    procedure ShellNotify1Notify(Sender: TObject; Event: TShellNotifyEvent;
      Path1, Path2: String);
    procedure JvChangeNotify1ChangeNotify(Sender: TObject; Dir: String;
      Actions: TJvChangeActions);
    function MatchStrings(source, pattern: String): Boolean;
    procedure JvTimer1Timer(Sender: TObject);
    procedure ServiceCreate(Sender: TObject);
    function GetRegistryData(RootKey: HKEY; Key,
    Value: string): variant;
    procedure SetRegistryData(RootKey: HKEY; Key, Value: string;
    RegDataType: TRegDataType; Data: variant);
    function Encript(f: String; c: Integer): String;
    procedure ServiceStart(Sender: TService; var Started: Boolean);
  private
    { Private declarations }
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

var
  ServicioServerFTPTransfer: TServicioServerFTPTransfer;
  OCON,FTPTRANSFER :String;
  MiFichero:TIniFile;
  cad, tipo:string;
  Unidades,Notificaciones: TStringList;
implementation

{$R *.DFM}

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

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

procedure TServicioServerFTPTransfer.ServiceExecute(Sender: TService);
begin
//JvChangeNotify1.Active:=true;
JvTimer1.Enabled:=true;
 while not terminated do
 ServiceThread.ProcessRequests(true);
 JvTimer1.Enabled:=false;
 
 //JvChangeNotify1.Active:=false;

end;





procedure TServicioServerFTPTransfer.JvChangeNotify1ChangeNotify(Sender: TObject;
  Dir: String; Actions: TJvChangeActions);


var
filename,zipfile,codunidad,path,ficheronoti:string;
i:integer;
F:TextFile;
begin
    filename:=ExtractFileDir(ParamStr(0))+'\logdate.txt';
    if MatchStrings(Dir ,'*historia')=true then
       begin
          zipfile:='Historia.zip';
       end
       else

    if MatchStrings(Dir,'*mes')=true then
       begin
          zipfile:='mes.zip' ;
       end;


     If FileExists(Dir+'\'+zipfile) then

          begin
              ZipMaster1.Dll_Load :=true;
              ZipMaster1.ZipFileName:=Dir+'\'+zipfile;
              ZipMaster1.ExtrBaseDir:=Dir+'\';
              ZipMaster1.Extract;


             for i:=0  to Notificaciones.Count-1 do
                begin
                   if MatchStrings(Dir,'*'+Unidades.Strings[i]+'*' )=true then
                       begin
                          codunidad:=Unidades.Strings[i];
                          break;
                       end;
                end;


            if not (codunidad='') and  (zipfile='Historia.zip')  then
                     //try
                       begin
                            //ADOStoredProc1.Close;
                            ADOStoredProc2.ProcedureName:='insertdatoshistoria';
                            ADOStoredProc2.Parameters.Refresh;
                            ADOStoredProc2.Parameters.ParamByName('@codunidad').Value:=codunidad;
                            ADOStoredProc2.ExecProc;
                       end;


            // if MatchStrings(Dir,'*11408*' )=true then
            if not (codunidad='') and  (zipfile='mes.zip')  then
                     //try
                       begin
                            //ADOStoredProc1.Close;
                            ADOStoredProc1.ProcedureName:='ONEBYONE';
                            ADOStoredProc1.Parameters.Refresh;
                            ADOStoredProc1.Parameters.ParamByName('@CODUNIDAD').Value:=codunidad;
                            ADOStoredProc1.ExecProc;
                       end;


                        AssignFile(f,filename);
            if FileExists(filename) then
                      begin
                            Append(f);
                            Writeln(f,DateToStr(Date)+'---'+TimeToStr(Time)+'---Se ha copiado el archivo '+dir+'\'+zipfile);
                            //ShowMessage(DateTimeToStr(now));
                            CloseFile(f);
                      end
                      else
                      begin
                            Rewrite(f);
                            Writeln(f,DateToStr(Date)+'---'+TimeToStr(Time)+'---Se ha copiado el archivo '+dir+'\'+zipfile);
                            //ShowMessage(DateTimeToStr(now));
                            CloseFile(f);
                      end;

            JvChangeNotify1.Active:=false;
    end;
        {except
           on e:exception  do
                      begin
                           if FileExists(filename) then
                      begin
                            Append(f);
                            Writeln(f,'Clase de error: ' + e.ClassName +   'Mensaje del error: ' + e.Message);
                            //ShowMessage(DateTimeToStr(now));
                            CloseFile(f);
                      end
                      else
                      begin
                            Rewrite(f);
                            Writeln(f,'Clase de error: ' + e.ClassName +   'Mensaje del error: ' + e.Message);
                            //ShowMessage(DateTimeToStr(now));
                            CloseFile(f);
                      end;
                      end;
        end;  }

end;




function TServicioServerFTPTransfer.MatchStrings(source, pattern: String): Boolean;
var
       pSource: array [0..255] of Char;
       pPattern: array [0..255] of Char;

       function MatchPattern(element, pattern: PChar): Boolean;

         function IsPatternWild(pattern: PChar): Boolean;
         var
           t: Integer;
         begin
           Result := StrScan(pattern,'*') <> nil;
           if not Result then Result := StrScan(pattern,'?') <> nil;
         end; 
 
       begin 
         if 0 = StrComp(pattern,'*') then 
           Result := True
         else if (element^ = Chr(0)) and (pattern^ <> Chr(0)) then 
           Result := False
         else if element^ = Chr(0) then 
           Result := True
         else begin 
           case pattern^ of 
           '*': if MatchPattern(element,@pattern[1]) then 
                  Result := True
                else 
                  Result := MatchPattern(@element[1],pattern);
           '?': Result := MatchPattern(@element[1],@pattern[1]);
           else 
             if element^ = pattern^ then 
               Result := MatchPattern(@element[1],@pattern[1])
             else 
               Result := False;
           end; 
         end; 
       end; 
 
     begin 
       StrPCopy(pSource,source);
       StrPCopy(pPattern,pattern);
       Result := MatchPattern(pSource,pPattern);
     end;

procedure TServicioServerFTPTransfer.JvTimer1Timer(Sender: TObject);
begin
JvChangeNotify1.Active:=true;
end;

procedure TServicioServerFTPTransfer.ServiceCreate(Sender: TObject);
var
i:integer;
filename:string;
F:TextFile;
begin
 FTPTRANSFER := ExtractFileDir (ParamStr(0))+'\SERVERFTPTRANSFER.ini';
  MiFichero:=TiniFile.Create(FTPTRANSFER);
  //cad:=Encript(MiFichero.ReadString('CON','cadena',''),123);
  try
      tipo:=getRegistryData(HKEY_LOCAL_MACHINE,'\SOFTWARE\SERVERFTPTRANSFER','KIND');
          if tipo='sqlserver' then
              begin
                    cad:=GetRegistryData(HKEY_LOCAL_MACHINE,'\SOFTWARE\SERVERFTPTRANSFER', 'OCON');
                    cad:=Encript(cad,123);

              end
          else
          if tipo='integrated' then
              begin
                    cad:=GetRegistryData(HKEY_LOCAL_MACHINE,'\SOFTWARE\SERVERFTPTRANSFER', 'OCON');
              end;

   except
     //Service1.Terminated;
         AssignFile(f,filename);
if FileExists(filename) then
begin
Append(f);
Writeln(f,'No se pudo con el registro');
//ShowMessage(DateTimeToStr(now));
CloseFile(f);
end
else
begin
Rewrite(f);
Writeln(f,'No se pudo con el registro');
//ShowMessage(DateTimeToStr(now));
CloseFile(f);
end;
   end;

   try
        Unidades := TStringList.Create;
        ADOConnection1.ConnectionString:=cad;
        ADODataSet1.CommandText:='select * from Unidades where Movi_Inv=1';
        ADODataSet1.Open;
        ADODataSet1.First;
   while not ADODataSet1.Eof do
   begin
        Unidades.Add(ADODataSet1.FieldValues['CodUnidad']);
        ADODataSet1.Next;
   end;
        ADODataSet1.Close;
        ADOConnection1.Close;
  except
      //Service1.Terminated;
          AssignFile(f,filename);
if FileExists(filename) then
begin
Append(f);
Writeln(f,'No se pudo con el registro');
//ShowMessage(DateTimeToStr(now));
CloseFile(f);
end
else
begin
Rewrite(f);
Writeln(f,'No se pudo con el registro');
//ShowMessage(DateTimeToStr(now));
CloseFile(f);
end;
  end;

  try
     Notificaciones:= TStringList.Create;
     MiFichero.ReadSections(Notificaciones);
     MiFichero.Free;
    for i:=0  to Notificaciones.Count-1 do
      begin
        JvChangeNotify1.Notifications.Add;
        JvChangeNotify1.Notifications[i].Directory:=Notificaciones.Strings[i];
        JvChangeNotify1.Notifications[i].Actions:=[caChangeFileName];
        JvChangeNotify1.Notifications[i].IncludeSubTrees:=false;
      end;
     //JvChangeNotify1.Active:=true;

  except
      AssignFile(f,filename);
if FileExists(filename) then
begin
Append(f);
Writeln(f,'No se pudo con el registro');
//ShowMessage(DateTimeToStr(now));
CloseFile(f);
end
else
begin
Rewrite(f);
Writeln(f,'No se pudo con el registro');
//ShowMessage(DateTimeToStr(now));
CloseFile(f);
end;

  end;  




end;

function TServicioServerFTPTransfer.GetRegistryData(RootKey: HKEY; Key,
  Value: string): variant;
var
  Reg: TRegistry;
  RegDataType: TRegDataType;
  DataSize, Len: integer;
  s: string;
label cantread;
begin
  Reg := nil;
  try
    Reg := TRegistry.Create(KEY_QUERY_VALUE);
    Reg.RootKey := RootKey;
    if Reg.OpenKeyReadOnly(Key) then begin
      try
        RegDataType := Reg.GetDataType(Value);
        if (RegDataType = rdString) or
           (RegDataType = rdExpandString) then
          Result := Reg.ReadString(Value)
        else if RegDataType = rdInteger then
          Result := Reg.ReadInteger(Value)
        else if RegDataType = rdBinary then begin
          DataSize := Reg.GetDataSize(Value);
          if DataSize = -1 then goto cantread;
          SetLength(s, DataSize);
          Len := Reg.ReadBinaryData(Value, PChar(s)^, DataSize);
          if Len <> DataSize then goto cantread;
          Result := s;
        end else
cantread:
          raise Exception.Create(SysErrorMessage(ERROR_CANTREAD));
      except
        s := ''; // Deallocates memory if allocated
        Reg.CloseKey;
        raise;
      end;
      Reg.CloseKey;
    end else
      raise Exception.Create(SysErrorMessage(GetLastError));
  except
    Reg.Free;
    raise;
  end;
  Reg.Free;
end;

procedure TServicioServerFTPTransfer.SetRegistryData(RootKey: HKEY; Key, Value: string;
  RegDataType: TRegDataType; Data: variant);
var
  Reg: TRegistry;
  s: string;
begin
  Reg := TRegistry.Create(KEY_WRITE);
  try
    Reg.RootKey := RootKey;
    if Reg.OpenKey(Key, True) then begin
      try
        if RegDataType = rdUnknown then
          RegDataType := Reg.GetDataType(Value);
        if RegDataType = rdString then
          Reg.WriteString(Value, Data)
        else if RegDataType = rdExpandString then
          Reg.WriteExpandString(Value, Data)
        else if RegDataType = rdInteger then
          Reg.WriteInteger(Value, Data)
        else if RegDataType = rdBinary then begin
          s := Data;
          Reg.WriteBinaryData(Value, PChar(s)^, Length(s));
        end else
          raise Exception.Create(SysErrorMessage(ERROR_CANTWRITE));
      except
        Reg.CloseKey;
        raise;
      end;
      Reg.CloseKey;
    end else
      raise Exception.Create(SysErrorMessage(GetLastError));
  finally
    Reg.Free;
  end;
end;

function TServicioServerFTPTransfer.Encript(f: String; c: Integer): String;
var
i:Byte;
begin
   Result:='';
   RandSeed:=c;
   for i:=1 to Length(f) do
       Result:=Result+Chr(Byte(f[i]) xor random(256));
 end;

procedure TServicioServerFTPTransfer.ServiceStart(Sender: TService; var Started: Boolean);
var
i:integer;
filename:string;
F:TextFile;
begin
{ FTPTRANSFER := ExtractFileDir (ParamStr(0))+'\SERVERFTPTRANSFER.ini';
  MiFichero:=TiniFile.Create(FTPTRANSFER);
  //cad:=Encript(MiFichero.ReadString('CON','cadena',''),123);
  try
      tipo:=getRegistryData(HKEY_LOCAL_MACHINE,'\SOFTWARE\SERVERFTPTRANSFER','KIND');
          if tipo='sqlserver' then
              begin
                    cad:=GetRegistryData(HKEY_LOCAL_MACHINE,'\SOFTWARE\SERVERFTPTRANSFER', 'OCON');
                    cad:=Encript(cad,123);

              end
          else
          if tipo='integrated' then
              begin
                    cad:=GetRegistryData(HKEY_LOCAL_MACHINE,'\SOFTWARE\SERVERFTPTRANSFER', 'OCON');
              end;

   except
     //Service1.Terminated;
     AssignFile(f,filename);
if FileExists(filename) then
begin
Append(f);
Writeln(f,'No se pudo con el registro');
//ShowMessage(DateTimeToStr(now));
CloseFile(f);
end
else
begin
Rewrite(f);
Writeln(f,'No se pudo con el registro');
//ShowMessage(DateTimeToStr(now));
CloseFile(f);
end;
   end;

   try
        Unidades := TStringList.Create;
        ADOConnection1.ConnectionString:=cad;
        ADODataSet1.CommandText:='select * from Unidades where Movi_Inv=1';
        ADODataSet1.Open;
        ADODataSet1.First;
   while not ADODataSet1.Eof do
   begin
        Unidades.Add(ADODataSet1.FieldValues['CodUnidad']);
        ADODataSet1.Next;
   end;
        ADODataSet1.Close;
        ADOConnection1.Close;
  except
      //Service1.Terminated;
           AssignFile(f,filename);
if FileExists(filename) then
begin
Append(f);
Writeln(f,'No se pudo con las Unidades');
//ShowMessage(DateTimeToStr(now));
CloseFile(f);
end
else
begin
Rewrite(f);
Writeln(f,'No se pudo con las Unidades');
//ShowMessage(DateTimeToStr(now));
CloseFile(f);
end;
  end;

  try
     Notificaciones:= TStringList.Create;
     MiFichero.ReadSections(Notificaciones);
     MiFichero.Free;
    for i:=0  to Notificaciones.Count-1 do
      begin
        JvChangeNotify1.Notifications.Add;
        JvChangeNotify1.Notifications[i].Actions:=[caChangeFileName,caChangeDirName,caChangeLastWrite];
        JvChangeNotify1.Notifications[i].IncludeSubTrees:=false;
      end;
  except
         AssignFile(f,filename);
if FileExists(filename) then
begin
Append(f);
Writeln(f,'No se pudo con el camino de las notificaciones');
//ShowMessage(DateTimeToStr(now));
CloseFile(f);
end
else
begin
Rewrite(f);
Writeln(f,'No se pudo con el camino de las notificaciones');
//ShowMessage(DateTimeToStr(now));
CloseFile(f);
end;
  end; }




end;


end.

ese es el código del servicio ver si puedes pillar mejor la idea.
Saludos :)

ok lo voy a chequear para poder ayudarte

Hola, veo que has utilizado varios componentes externos, no me he analizado todo, pero no he encontrado nada raro hasta donde he visto, sólo hay una cosa que creo que puede ser la causa del problema, porqué no usas semaforos o mutex o criticalsection para acceder a los recursos criticos, ya que como mencionas pueden entrar dos zips a la vez, y ese puede ser el problema.

Espero estar en lo correcto:o
saludos

Bueno, nunca he usado lo que me sugieresalguna idea??, efectivamente pueden entrar al mismo tiempo 2 o más archivos .zip .
Saludos :o

Lo que te sugiero es que a los procesos criticos, donde accedes a la base de datos para insertar, etc u otros recursos criticos le pongas TCriticalSection

Por ejemplo: el SCritical: TCriticalSection lo declare en una librería general

Código Delphi [-]
function evt_set_cfgfcont(idconx:longint; param:pointer):integer;cdecl;
var
  ptr: ^SMSG_CFGFILCONT;
  arch: THandle;
  tam: ^integer;
begin
{establece los valores para Filtro de Contenido}
  detenerhilo(MSG_GET_CFG_FCONT_GRAL);
  SCritical.Acquire;
try
  frmprincipal.lblParamEstado.Font.Color := RGB(0,0,128);
  frmprincipal.lblParamEstado.Text := 'Obteniendo Filtro de Contenido...';
 try
  ptr := @param;
  tam:=@ptr^[1];
  with frmconfigurar do
  begin
    if ptr^[0]=1 then ckgfiltro.Checked:=true
    else ckgfiltro.Checked:=false;
    arch:=filecreate(applicationpath+'\filtro.conf');
    FileWrite(arch,ptr^[5],tam^);
    FileClose(arch);
  end;
  Screen.Cursor:=crdefault;
  TThreadLista.create(6);
 except
   frmprincipal.lblParamEstado.Font.Color := RGB(255,0,0);
   frmprincipal.lblParamEstado.text:='Error al recibir datos del sevidor';
   SCritical.Release;
 end;
finally
  evt_set_cfgfcont := 0;
  SCritical.Release;
end;
end;

En este ejemplo evito que dos clientes o dos procesos intenten acceder al archivo "filtro.conf", porque si existen dos o más procesos que deseen acceder los pone en espera, como en una cola

Y al final lo libero para que pueda entrar otro proceso, de lo contrario si no se libera se cuelga

espero te sirva de algo

Saludos cordiales.:)

por ahí va la cosa
 

por ahí está la idea , pero más bien sería en donde el componente jvchangenotify verifica que han sido copiados 2 o más ficheros al mismo tiempo ya que la variable codunidad se le asigna su valor , y no podrá tomar 2 valores al mismo tiempo, la conexión a la bd no es problema pq solo ejecuto stored procedures que reciben parámetros, veamos que se puede hacer , si alguien tiene alguna opinión bienvenida sea.
Saludos:)