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
public
function GetServiceController: TServiceController; override;
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
JvTimer1.Enabled:=true;
while not terminated do
ServiceThread.ProcessRequests(true);
JvTimer1.Enabled:=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
begin
ADOStoredProc2.ProcedureName:='insertdatoshistoria';
ADOStoredProc2.Parameters.Refresh;
ADOStoredProc2.Parameters.ParamByName('@codunidad').Value:=codunidad;
ADOStoredProc2.ExecProc;
end;
if not (codunidad='') and (zipfile='mes.zip') then
begin
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);
CloseFile(f);
end
else
begin
Rewrite(f);
Writeln(f,DateToStr(Date)+'---'+TimeToStr(Time)+'---Se ha copiado el archivo '+dir+'\'+zipfile);
CloseFile(f);
end;
JvChangeNotify1.Active:=false;
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);
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
AssignFile(f,filename);
if FileExists(filename) then
begin
Append(f);
Writeln(f,'No se pudo con el registro');
CloseFile(f);
end
else
begin
Rewrite(f);
Writeln(f,'No se pudo con el registro');
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
AssignFile(f,filename);
if FileExists(filename) then
begin
Append(f);
Writeln(f,'No se pudo con el registro');
CloseFile(f);
end
else
begin
Rewrite(f);
Writeln(f,'No se pudo con el registro');
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;
except
AssignFile(f,filename);
if FileExists(filename) then
begin
Append(f);
Writeln(f,'No se pudo con el registro');
CloseFile(f);
end
else
begin
Rewrite(f);
Writeln(f,'No se pudo con el registro');
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 := ''; 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
end;
end.
ese es el código del servicio ver si puedes pillar mejor la idea.
Saludos