Recull Components Delphi

SecurityCopy

Permet automatitzar còpies de seguretat de fitxers.

unit SecurityCopy;

interface

uses Windows, Classes, SysUtils, Forms, IniFiles, FileCtrl,
DsgnIntf, ShellAPI, ExtCtrls, Consts, TtLogFile, TtDBFilePathEd;

type
  TDebugOptions = class(TPersistent)
    private
      FActive: boolean;
      FFileName: string;
      FSaveDate: boolean;
      FSaveHour: boolean;
    public
      constructor Create;
    published
      property Active: boolean read FActive write FActive;
      property FileName: string read FFileName write FFileName;
      property SaveDate: boolean read FSaveDate write FSaveDate;
      property SaveHour: boolean read FSaveHour write FSaveHour;
  end;

type
  TSecurityCopy = class(TComponent)
    private
      FTimer: TTimer;
      FActive: boolean;
      FOverwrite: boolean;
      FOnlyModified: boolean;
      FSourcePath: string;
      FTargetPath: string;
      FExtension: string;
      FInterval: integer; //in seconds
      FLogFile: TTtLogFile;
      FDebugOptions: TDebugOptions;
      FIncludeSubfolders: boolean;
      procedure SetActive(AActive: boolean);
      procedure SetInterval(AInterval: integer);
      procedure SetDebugOptions(ADebugOptions: TDebugOptions);
      procedure OnTimer(Sender: TObject); virtual;
      procedure DoSecurityCopy(Source: string; Target: string);
    public
      constructor Create(AOwner:TComponent); override;
      destructor Destroy; override;
      procedure Loaded; override;
      procedure ExecuteSecurityCopy;
    published
      property Active: boolean read FActive write SetActive;
      property Overwrite: boolean read FOverwrite write FOverwrite;
      property OnlyModified: boolean read FOnlyModified write FOnlyModified;
      property Interval: integer read FInterval write SetInterval;
      property SourcePath: string read FSourcePath write FSourcePath;
      property TargetPath: string read FTargetPath write FTargetPath;
      property Extension: string read FExtension write FExtension;
      property DebugOptions: TDebugOptions read FDebugOptions write SetDebugOptions;
      property IncludeSubfolders: boolean read FIncludeSubfolders write FIncludeSubfolders;
  end;
type
  TSecurityCopy = class(TSecurityCopy);

procedure Register;

implementation

constructor TDebugOptions.Create;
begin
  FActive := False;
  FSaveDate := False;
  FSaveHour := False;
  FFileName := 'noname.log';
end;

constructor TSecurityCopy.Create(AOwner:TComponent);
begin
  FTimer := TTimer.Create(Self);
  FTimer.Enabled := False;
  FInterval := 60000;
  FActive := False;
  FOverwrite := True;
  FExtension := '*.*';
  FOnlyModified := True;
  FIncludeSubfolders := False;
  FTimer.OnTimer := OnTimer;
  FDebugOptions := TDebugOptions.Create;
  FLogFile := TTtLogFile.Create(Self);
  inherited Create(AOwner);
end;

procedure TSecurityCopy.Loaded;
begin
  SetDebugOptions(FDebugOptions);
  inherited Loaded;
end;

procedure TSecurityCopy.SetActive(AActive: boolean);
begin
  FActive := AActive;
  FTimer.Enabled := AActive;
  FTimer.Interval := FInterval;
end;

procedure TSecurityCopy.SetInterval(AInterval: integer);
begin
  FInterval := AInterval;
  FTimer.Interval := AInterval;
end;

procedure TSecurityCopy.SetDebugOptions(ADebugOptions: TDebugOptions);
begin
  FDebugOptions.Active := ADebugOptions.Active;
  FDebugOptions.SaveDate := ADebugOptions.SaveDate;
  FDebugOptions.SaveHour := ADebugOptions.SaveHour;
  FDebugOptions.FileName := ADebugOptions.FileName;
  FLogFile.SaveDate := FDebugOptions.SaveDate;
  FLogFile.SaveHour := FDebugOptions.SaveHour;
  FLogFile.FileName := FDebugOptions.FileName;
  FLogFile.Active := FDebugOptions.Active;
end;

function FileTimeToDateTime(FileTime: TFileTime): TDateTime;
var
  SysTime: TSystemTime;
begin
  if not FileTimeToSystemTime(FileTime,SysTime) then
    raise EConvertError.CreateFmt('FileTime to SystemTime failed. Error code %d',[GetLastError]);
  with SysTime do
  begin
    Result := EncodeDate(wYear,wMonth,wDay) + EncodeTime(wHour,wMinute,wSecond,wMilliseconds);
  end;
end;

procedure TSecurityCopy.DoSecurityCopy(Source: string; Target: string);
var
  SearchRec,SRDest: TSearchRec;
  flDate,lastCopyDate: TDateTime;
begin
  //if target directory no exists creates it
  if not DirectoryExists(Target) then
    ForceDirectories(Target);

  if (FindFirst(Source+'\'+FExtension,faAnyFile,SearchRec)=0) then
  begin
    flDate := FileTimeToDateTime(SearchRec.FindData.ftLastWriteTime);
    try
      if (FindFirst(Target+'\'+SearchRec.Name,faArchive,SRDest)=0) then
      begin
        lastCopyDate := FileTimeToDateTime(SRDest.FindData.ftLastWriteTime);
        if (lastCopyDate<flDate) or (FOnlyModified=False) then
        begin
          CopyFile(PChar(Source+'\'+SearchRec.Name),PChar(Target+'\'+SearchRec.Name),not FOverwrite);
          FLogFile.SaveToFile(SearchRec.Name+' copied');
        end;
      end
      else
      begin
        CopyFile(PChar(Source+'\'+SearchRec.Name),PChar(Target+'\'+SearchRec.Name),not FOverwrite);
        FLogFile.SaveToFile(SearchRec.Name+' copied');
      end;
      if FIncludeSubFolders then
      begin
        if (shortint(SearchRec.Attr)=faDirectory) and (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then
        begin
          DoSecurityCopy(Source+'\'+SearchRec.Name,Target+'\'+SearchRec.Name);
        end;
      end;
    except
      FLogFile.SaveToFile(SearchRec.Name+' failed to copy');
    end;
  while (FindNext(SearchRec)=0) do
  begin
    flDate := FileTimeToDateTime(SearchRec.FindData.ftLastWriteTime);
    try
      if (FindFirst(Target+'\'+SearchRec.Name,faArchive,SRDest)=0) then
      begin
        lastCopyDate := FileTimeToDateTime(SRDest.FindData.ftLastWriteTime);
        if (lastCopyDate<flDate) or (FOnlyModified=False) then
        begin
          CopyFile(PChar(Source+'\'+SearchRec.Name),PChar(Target+'\'+SearchRec.Name),not FOverwrite);
          FLogFile.SaveToFile(SearchRec.Name+' copied');
        end;
      end
      else
      begin
        CopyFile(PChar(Source+'\'+SearchRec.Name),PChar(Target+'\'+SearchRec.Name),not FOverwrite);
        FLogFile.SaveToFile(SearchRec.Name+' copied');
      end;
      if FIncludeSubFolders then
      begin
        if (shortint(SearchRec.Attr)=faDirectory) and (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then
        begin
          DoSecurityCopy(Source+'\'+SearchRec.Name,Target+'\'+SearchRec.Name);
        end;
      end;
    except
      FLogFile.SaveToFile(SearchRec.Name+' failed to copy');
    end;
  end;
  FindClose(SearchRec);
  end;
end;

procedure TSecurityCopy.ExecuteSecurityCopy;
begin
  DoSecurityCopy(FSourcePath,FTargetPath);
end;

procedure TSecurityCopy.OnTimer(Sender: TObject);
begin

  if ComponentState=[csDesigning] then
    Exit;

  FTimer.Enabled := False;
  DoSecurityCopy(FSourcePath,FTargetPath);
  FTimer.Enabled := True;
end;

destructor TSecurityCopy.Destroy;
begin
  FLogFile.Free;
  FTimer.Free;
  FDebugOptions.Create;
  inherited Destroy;
end;

procedure Register;
begin
  RegisterComponents('Components Delphi', [TSecurityCopy]);
end;

end.

Les propietas SourcePath i TargetPath determinen els directoris origen i final de la còpia. Podem, mitjançant la propietat Extension filtrar el tipus de fitxers a copiar. La propietat Active ens permet desactivar la còpia. Interval ens indica cada quan volem fer còpia, en milisegons. Amb OnlyhModified, només copiem si el fitxer s'ha modificat des de l'última còpia. Overwrite indica si reemplaçar el fitxer destí si ja existeix. IncludeSubfolders fa còpia recursiva de directoris continguts en SourcePath. Finalment, amb DebugOptions podem fer que es generi un arxiu que registri les operacions de còpia. A part d'executar-se la còpia cada vegada que es compleixi el temps que hem triat a Interval, la podem forçar amb el mètode ExecuteSecurityCopy.