Service Apliccation

[jake]

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:

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!!!!

[jake]

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:


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??

[jake]

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é

[fer21unmsm]

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:)

[jake]

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

[fer21unmsm]

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.

[jake]

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:


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 :)

[fer21unmsm]

ok lo voy a chequear para poder ayudarte

[fer21unmsm]

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

[jake]

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

[fer21unmsm]

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


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.:)

[jake]

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:)