Ver Mensaje Individual
  #7  
Antiguo 24-07-2007
Avatar de jake
jake jake is offline
Miembro
 
Registrado: may 2007
Posts: 22
Reputación: 0
jake Va por buen camino
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
Responder Con Cita