mirrors/doublecmd
2
0
Fork 0
mirror of https://github.com/doublecmd/doublecmd.git synced 2026-06-21 09:58:13 +00:00
Code Issues Projects Releases Packages Wiki Activity

ADD: Wipe operation

Browse source
This commit is contained in:
Alexander Koblov 2009-08-02 10:20:01 +00:00
commit 3d1801a47d
7 changed files with 3529 additions and 2791 deletions
Download patch file Download diff file Expand all files Collapse all files

53
src/fFileOpDlg.pas
View file

@ -64,8 +64,10 @@ type
procedure InitializeCopyOperation(Operation: TFileSourceOperation);
procedure InitializeDeleteOperation(Operation: TFileSourceOperation);
procedure InitializeWipeOperation(Operation: TFileSourceOperation);
procedure UpdateCopyOperation(Operation: TFileSourceOperation);
procedure UpdateDeleteOperation(Operation: TFileSourceOperation);
procedure UpdateWipeOperation(Operation: TFileSourceOperation);
public
iProgress1Max: Integer;
@ -94,6 +96,7 @@ uses
uFileSourceOperationTypes,
uFileSourceCopyOperation,
uFileSourceDeleteOperation,
uFileSourceWipeOperation,
uFileSourceOperationMessageBoxesUI;
procedure TfrmFileOp.btnCancelClick(Sender: TObject);
@ -164,6 +167,8 @@ begin
InitializeCopyOperation(Operation);
fsoDelete:
InitializeDeleteOperation(Operation);
fsoWipe:
InitializeWipeOperation(Operation);
else
begin
@ -260,6 +265,8 @@ begin
UpdateCopyOperation(Operation);
fsoDelete:
UpdateDeleteOperation(Operation);
fsoWipe:
UpdateWipeOperation(Operation);
else
begin
@ -352,6 +359,13 @@ begin
lblFrom.Caption := rsDlgDeleting;
end;
procedure TfrmFileOp.InitializeWipeOperation(Operation: TFileSourceOperation);
begin
Caption := rsDlgDel;
InitializeControls([fodl_from_lbl, fodl_first_pb, fodl_second_pb]);
lblFrom.Caption := rsDlgDeleting;
end;
procedure TfrmFileOp.UpdateCopyOperation(Operation: TFileSourceOperation);
var
CopyOperation: TFileSourceCopyOperation;
@ -426,6 +440,45 @@ begin
lblEstimated.Caption := sEstimated;
end;
procedure TfrmFileOp.UpdateWipeOperation(Operation: TFileSourceOperation);
var
WipeOperation: TFileSourceWipeOperation;
WipeStatistics: TFileSourceWipeOperationStatistics;
begin
WipeOperation := Operation as TFileSourceWipeOperation;
WipeStatistics := WipeOperation.RetrieveStatistics;
with WipeStatistics do
begin
lblFileNameFrom.Caption := CurrentFile;
if CurrentFileTotalBytes <> 0 then
pbFirst.Position := (CurrentFileDoneBytes * 100) div CurrentFileTotalBytes
else
pbFirst.Position := 0;
if TotalBytes <> 0 then
pbSecond.Position := (DoneBytes * 100) div TotalBytes
else
pbSecond.Position := 0;
if Operation.State in [fsosNotStarted, fsosPaused, fsosWaitingForFeedback, fsosStopped] then
sEstimated := ''
else
begin
if BytesPerSecond = 0 then
sEstimated := 'Estimating time...'
else
begin
sEstimated := FormatDateTime('HH:MM:SS', RemainingTime);
sEstimated := Format(rsDlgSpeedTime, [cnvFormatFileSize(BytesPerSecond), sEstimated]);
end;
end;
end;
lblEstimated.Caption := sEstimated;
end;
procedure TfrmFileOp.ToggleProgressBarStyle;
begin
if (pbFirst.Style = pbstMarquee) and (pbSecond.Style = pbstMarquee) then

390
src/newdesign/ufilesource.pas
View file

@ -1,191 +1,199 @@
unit uFileSource;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
uFileSourceOperation,
uFileSourceOperationTypes,
uFileSourceProperty,
uFileProperty,
uFile;
type
TFileSource = class(TObject)
private
protected
FCurrentPath: String; // Always includes trailing path delimiter.
FCurrentAddress: String;
{en
Retrieves the full address of the file source
(the CurrentPath is relative to this).
This may be used for specifying address:
- archive : path to archive
- network : address of server
etc.
}
function GetCurrentAddress: String; virtual;
function GetCurrentPath: String; virtual;
procedure SetCurrentPath(NewPath: String); virtual;
{en
Returns all the properties supported by the file type of the given file source.
}
class function GetSupportedFileProperties: TFilePropertiesTypes; virtual abstract;
public
constructor Create; virtual;
function Clone: TFileSource; virtual;
procedure CloneTo(FileSource: TFileSource); virtual;
// Retrieve operations permitted on the source. = capabilities?
class function GetOperationsTypes: TFileSourceOperationTypes; virtual abstract;
// Returns a list of property types supported by this source for each file.
class function GetFilePropertiesDescriptions: TFilePropertiesDescriptions; virtual abstract;
// Retrieve some properties of the file source.
class function GetProperties: TFileSourceProperties; virtual abstract;
// Retrieves a list of files.
// This is the same as GetOperation(fsoList), executing it
// and returning the result of Operation.ReleaseFiles.
// Caller is responsible for freeing the result list.
function GetFiles: TFiles; virtual;
// These functions create an operation object specific to the file source.
// Each parameter will be owned by the operation (will be freed).
function CreateListOperation: TFileSourceOperation; virtual;
function CreateCopyInOperation(var SourceFileSource: TFileSource;
var SourceFiles: TFiles;
TargetPath: String;
RenameMask: String): TFileSourceOperation; virtual;
function CreateCopyOutOperation(var TargetFileSource: TFileSource;
var SourceFiles: TFiles;
TargetPath: String;
RenameMask: String): TFileSourceOperation; virtual;
function CreateDeleteOperation(var FilesToDelete: TFiles): TFileSourceOperation; virtual;
{en
Returns @true if the CurrentPath is the root path of the file source,
@false otherwise.
}
function IsAtRootPath: Boolean; virtual;
property CurrentPath: String read GetCurrentPath write SetCurrentPath;
property CurrentAddress: String read GetCurrentAddress;
property Properties: TFileSourceProperties read GetProperties;
property SupportedFileProperties: TFilePropertiesTypes read GetSupportedFileProperties;
end;
implementation
uses
uFileSourceListOperation;
constructor TFileSource.Create;
begin
if ClassType = TFileSource then
raise Exception.Create('Cannot construct abstract class');
inherited Create;
end;
function TFileSource.Clone: TFileSource;
begin
Result := TFileSource.Create;
CloneTo(Result);
end;
procedure TFileSource.CloneTo(FileSource: TFileSource);
begin
if Assigned(FileSource) then
begin
FileSource.FCurrentPath := FCurrentPath;
FileSource.FCurrentAddress := FCurrentAddress;
end;
end;
function TFileSource.GetCurrentAddress: String;
begin
Result := FCurrentAddress;
end;
function TFileSource.GetCurrentPath: String;
begin
Result := FCurrentPath;
end;
procedure TFileSource.SetCurrentPath(NewPath: String);
begin
if NewPath = '' then
FCurrentPath := ''
else
FCurrentPath := IncludeTrailingPathDelimiter(NewPath);
end;
function TFileSource.IsAtRootPath: Boolean;
begin
// Default root is '/'. Override in descendant classes for other.
Result := (CurrentPath = PathDelim);
end;
// Operations.
function TFileSource.GetFiles: TFiles;
var
Operation: TFileSourceOperation;
ListOperation: TFileSourceListOperation;
begin
Result := nil;
if fsoList in GetOperationsTypes then
begin
Operation := CreateListOperation;
if Assigned(Operation) then
try
ListOperation := Operation as TFileSourceListOperation;
ListOperation.Execute;
Result := ListOperation.ReleaseFiles;
finally
FreeAndNil(Operation);
end;
end;
end;
function TFileSource.CreateListOperation: TFileSourceOperation;
begin
Result := nil;
end;
function TFileSource.CreateCopyInOperation(var SourceFileSource: TFileSource;
var SourceFiles: TFiles;
TargetPath: String;
RenameMask: String): TFileSourceOperation;
begin
Result := nil;
end;
function TFileSource.CreateCopyOutOperation(var TargetFileSource: TFileSource;
var SourceFiles: TFiles;
TargetPath: String;
RenameMask: String): TFileSourceOperation;
begin
Result := nil;
end;
function TFileSource.CreateDeleteOperation(var FilesToDelete: TFiles): TFileSourceOperation;
begin
Result := nil;
end;
end.
unit uFileSource;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
uFileSourceOperation,
uFileSourceOperationTypes,
uFileSourceProperty,
uFileProperty,
uFile;
type
{ TFileSource }
TFileSource = class(TObject)
private
protected
FCurrentPath: String; // Always includes trailing path delimiter.
FCurrentAddress: String;
{en
Retrieves the full address of the file source
(the CurrentPath is relative to this).
This may be used for specifying address:
- archive : path to archive
- network : address of server
etc.
}
function GetCurrentAddress: String; virtual;
function GetCurrentPath: String; virtual;
procedure SetCurrentPath(NewPath: String); virtual;
{en
Returns all the properties supported by the file type of the given file source.
}
class function GetSupportedFileProperties: TFilePropertiesTypes; virtual abstract;
public
constructor Create; virtual;
function Clone: TFileSource; virtual;
procedure CloneTo(FileSource: TFileSource); virtual;
// Retrieve operations permitted on the source. = capabilities?
class function GetOperationsTypes: TFileSourceOperationTypes; virtual abstract;
// Returns a list of property types supported by this source for each file.
class function GetFilePropertiesDescriptions: TFilePropertiesDescriptions; virtual abstract;
// Retrieve some properties of the file source.
class function GetProperties: TFileSourceProperties; virtual abstract;
// Retrieves a list of files.
// This is the same as GetOperation(fsoList), executing it
// and returning the result of Operation.ReleaseFiles.
// Caller is responsible for freeing the result list.
function GetFiles: TFiles; virtual;
// These functions create an operation object specific to the file source.
// Each parameter will be owned by the operation (will be freed).
function CreateListOperation: TFileSourceOperation; virtual;
function CreateCopyInOperation(var SourceFileSource: TFileSource;
var SourceFiles: TFiles;
TargetPath: String;
RenameMask: String): TFileSourceOperation; virtual;
function CreateCopyOutOperation(var TargetFileSource: TFileSource;
var SourceFiles: TFiles;
TargetPath: String;
RenameMask: String): TFileSourceOperation; virtual;
function CreateDeleteOperation(var FilesToDelete: TFiles): TFileSourceOperation; virtual;
function CreateWipeOperation(var FilesToWipe: TFiles): TFileSourceOperation; virtual;
{en
Returns @true if the CurrentPath is the root path of the file source,
@false otherwise.
}
function IsAtRootPath: Boolean; virtual;
property CurrentPath: String read GetCurrentPath write SetCurrentPath;
property CurrentAddress: String read GetCurrentAddress;
property Properties: TFileSourceProperties read GetProperties;
property SupportedFileProperties: TFilePropertiesTypes read GetSupportedFileProperties;
end;
implementation
uses
uFileSourceListOperation;
constructor TFileSource.Create;
begin
if ClassType = TFileSource then
raise Exception.Create('Cannot construct abstract class');
inherited Create;
end;
function TFileSource.Clone: TFileSource;
begin
Result := TFileSource.Create;
CloneTo(Result);
end;
procedure TFileSource.CloneTo(FileSource: TFileSource);
begin
if Assigned(FileSource) then
begin
FileSource.FCurrentPath := FCurrentPath;
FileSource.FCurrentAddress := FCurrentAddress;
end;
end;
function TFileSource.GetCurrentAddress: String;
begin
Result := FCurrentAddress;
end;
function TFileSource.GetCurrentPath: String;
begin
Result := FCurrentPath;
end;
procedure TFileSource.SetCurrentPath(NewPath: String);
begin
if NewPath = '' then
FCurrentPath := ''
else
FCurrentPath := IncludeTrailingPathDelimiter(NewPath);
end;
function TFileSource.IsAtRootPath: Boolean;
begin
// Default root is '/'. Override in descendant classes for other.
Result := (CurrentPath = PathDelim);
end;
// Operations.
function TFileSource.GetFiles: TFiles;
var
Operation: TFileSourceOperation;
ListOperation: TFileSourceListOperation;
begin
Result := nil;
if fsoList in GetOperationsTypes then
begin
Operation := CreateListOperation;
if Assigned(Operation) then
try
ListOperation := Operation as TFileSourceListOperation;
ListOperation.Execute;
Result := ListOperation.ReleaseFiles;
finally
FreeAndNil(Operation);
end;
end;
end;
function TFileSource.CreateListOperation: TFileSourceOperation;
begin
Result := nil;
end;
function TFileSource.CreateCopyInOperation(var SourceFileSource: TFileSource;
var SourceFiles: TFiles;
TargetPath: String;
RenameMask: String): TFileSourceOperation;
begin
Result := nil;
end;
function TFileSource.CreateCopyOutOperation(var TargetFileSource: TFileSource;
var SourceFiles: TFiles;
TargetPath: String;
RenameMask: String): TFileSourceOperation;
begin
Result := nil;
end;
function TFileSource.CreateDeleteOperation(var FilesToDelete: TFiles): TFileSourceOperation;
begin
Result := nil;
end;
function TFileSource.CreateWipeOperation(var FilesToWipe: TFiles): TFileSourceOperation;
begin
Result := nil;
end;
end.

1
src/newdesign/ufilesourceoperationtypes.pas
View file

@ -16,6 +16,7 @@ type
fsoCopyIn,
fsoCopyOut,
fsoDelete,
fsoWipe,
fsoSetName,
fsoSetAttribute,
fsoExecute

158
src/newdesign/ufilesourcewipeoperation.pas Normal file
View file

@ -0,0 +1,158 @@
unit uFileSourceWipeOperation;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, syncobjs,
uFileSourceOperation,
uFileSourceOperationTypes,
uFileSource,
uFile;
type
TFileSourceWipeOperationStatistics = record
CurrentFile: String;
CurrentFileTotalBytes: Int64;
CurrentFileDoneBytes: Int64;
TotalFiles: Int64;
DoneFiles: Int64;
TotalBytes: Int64;
DoneBytes: Int64;
BytesPerSecond: Int64;
RemainingTime: TDateTime;
end;
{en
Operation that wipes files from an arbitrary file source.
File source should match the class type.
}
TFileSourceWipeOperation = class(TFileSourceOperation)
private
FStatistics: TFileSourceWipeOperationStatistics;
FStatisticsAtStartTime: TFileSourceWipeOperationStatistics;
FStatisticsLock: TCriticalSection; //<en For synchronizing statistics.
FFileSource: TFileSource;
FFilesToWipe: TFiles;
protected
function GetID: TFileSourceOperationType; override;
procedure UpdateStatistics(NewStatistics: TFileSourceWipeOperationStatistics);
procedure UpdateStatisticsAtStartTime; override;
procedure EstimateSpeedAndTime(var theStatistics: TFileSourceWipeOperationStatistics);
property FileSource: TFileSource read FFileSource;
property FilesToDelete: TFiles read FFilesToWipe;
public
constructor Create(var aTargetFileSource: TFileSource;
var theFilesToWipe: TFiles); virtual reintroduce;
destructor Destroy; override;
function RetrieveStatistics: TFileSourceWipeOperationStatistics;
end;
implementation
uses
uDCUtils;
constructor TFileSourceWipeOperation.Create(var aTargetFileSource: TFileSource;
var theFilesToWipe: TFiles);
begin
with FStatistics do
begin
CurrentFile := '';
TotalFiles := 0;
DoneFiles := 0;
TotalBytes := 0;
DoneBytes := 0;
CurrentFileTotalBytes := 0;
CurrentFileDoneBytes := 0;
BytesPerSecond := 0;
RemainingTime := 0;
end;
FStatisticsLock := TCriticalSection.Create;
inherited Create(aTargetFileSource, aTargetFileSource);
FFileSource := aTargetFileSource;
aTargetFileSource := nil;
FFilesToWipe := theFilesToWipe;
theFilesToWipe := nil;
end;
destructor TFileSourceWipeOperation.Destroy;
begin
inherited Destroy;
if Assigned(FStatisticsLock) then
FreeAndNil(FStatisticsLock);
if Assigned(FFilesToWipe) then
FreeAndNil(FFilesToWipe);
if Assigned(FFileSource) then
FreeAndNil(FFileSource);
end;
function TFileSourceWipeOperation.GetID: TFileSourceOperationType;
begin
Result := fsoWipe;
end;
procedure TFileSourceWipeOperation.UpdateStatistics(NewStatistics: TFileSourceWipeOperationStatistics);
begin
FStatisticsLock.Acquire;
try
Self.FStatistics := NewStatistics;
finally
FStatisticsLock.Release;
end;
end;
procedure TFileSourceWipeOperation.UpdateStatisticsAtStartTime;
begin
FStatisticsLock.Acquire;
try
Self.FStatisticsAtStartTime := Self.FStatistics;
finally
FStatisticsLock.Release;
end;
end;
function TFileSourceWipeOperation.RetrieveStatistics: TFileSourceWipeOperationStatistics;
begin
// Statistics have to be synchronized because there are multiple values
// and they all have to be consistent at every moment.
FStatisticsLock.Acquire;
try
Result := Self.FStatistics;
finally
FStatisticsLock.Release;
end;
end;
procedure TFileSourceWipeOperation.EstimateSpeedAndTime(
var theStatistics: TFileSourceWipeOperationStatistics);
begin
FStatisticsLock.Acquire;
try
theStatistics.RemainingTime :=
EstimateRemainingTime(FStatisticsAtStartTime.DoneFiles,
theStatistics.DoneFiles,
theStatistics.TotalFiles,
StartTime,
SysUtils.Now,
theStatistics.BytesPerSecond);
finally
FStatisticsLock.Release;
end;
end;
end.

382
src/newdesign/ufilesystemfilesource.pas
View file

@ -1,184 +1,198 @@
unit uFileSystemFileSource;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
uFileSourceOperation,
uFileSourceOperationTypes,
uLocalFileSource,
uFileSource,
uFileSourceProperty,
uFileProperty,
uFile
;
type
{en
Real file system.
}
TFileSystemFileSource = class(TLocalFileSource)
protected
procedure SetCurrentPath(NewPath: String); override;
public
constructor Create; override;
constructor Create(Path: String); overload;
function Clone: TFileSystemFileSource; override;
procedure CloneTo(FileSource: TFileSource); override;
class function GetSupportedFileProperties: TFilePropertiesTypes; override;
class function GetOperationsTypes: TFileSourceOperationTypes; override;
class function GetFilePropertiesDescriptions: TFilePropertiesDescriptions; override;
class function GetProperties: TFileSourceProperties; override;
function IsAtRootPath: Boolean; override;
function CreateListOperation: TFileSourceOperation; override;
function CreateCopyInOperation(var SourceFileSource: TFileSource;
var SourceFiles: TFiles;
TargetPath: String;
RenameMask: String): TFileSourceOperation; override;
function CreateCopyOutOperation(var TargetFileSource: TFileSource;
var SourceFiles: TFiles;
TargetPath: String;
RenameMask: String): TFileSourceOperation; override;
function CreateDeleteOperation(var FilesToDelete: TFiles): TFileSourceOperation; override;
// ------------------------------------------------------
end;
implementation
uses
uOSUtils, uDCUtils,
uFileSystemFile,
uFileSystemListOperation,
uFileSystemCopyOperation,
uFileSystemDeleteOperation;
constructor TFileSystemFileSource.Create;
begin
Create(mbGetCurrentDir);
end;
constructor TFileSystemFileSource.Create(Path: String);
begin
inherited Create;
inherited SetCurrentPath(Path);
FCurrentAddress := '';
end;
function TFileSystemFileSource.Clone: TFileSystemFileSource;
begin
Result := TFileSystemFileSource.Create(FCurrentPath);
CloneTo(Result);
end;
procedure TFileSystemFileSource.CloneTo(FileSource: TFileSource);
begin
if Assigned(FileSource) then
begin
inherited CloneTo(FileSource);
end;
end;
class function TFileSystemFileSource.GetOperationsTypes: TFileSourceOperationTypes;
begin
Result := [fsoList,
fsoCopyIn,
fsoCopyOut,
fsoDelete,
fsoSetName,
fsoSetAttribute,
fsoExecute];
//fsoSetPath / fsoChangePath
end;
class function TFileSystemFileSource.GetFilePropertiesDescriptions: TFilePropertiesDescriptions;
begin
SetLength(Result, 2);
Result[0] := TFileSizeProperty.GetDescription;
Result[1] := TFileModificationDateTimeProperty.GetDescription;
end;
class function TFileSystemFileSource.GetProperties: TFileSourceProperties;
begin
Result := [
fspDirectAccess
{$IFDEF UNIX}
, fspCaseSensitive
{$ENDIF}
];
end;
procedure TFileSystemFileSource.SetCurrentPath(NewPath: String);
begin
if not mbDirectoryExists(NewPath) then
NewPath := mbGetCurrentDir
else
mbSetCurrentDir(NewPath);
inherited SetCurrentPath(NewPath);
end;
function TFileSystemFileSource.IsAtRootPath: Boolean;
begin
Result := (GetParentDir(CurrentPath) = '');
end;
class function TFileSystemFileSource.GetSupportedFileProperties: TFilePropertiesTypes;
begin
Result := TFileSystemFile.GetSupportedProperties;
end;
function TFileSystemFileSource.CreateListOperation: TFileSourceOperation;
var
TargetFileSource: TFileSystemFileSource;
begin
TargetFileSource := Self.Clone;
Result := TFileSystemListOperation.Create(TargetFileSource);
end;
function TFileSystemFileSource.CreateCopyInOperation(var SourceFileSource: TFileSource;
var SourceFiles: TFiles;
TargetPath: String;
RenameMask: String): TFileSourceOperation;
var
TargetFileSource: TFileSystemFileSource;
begin
TargetFileSource := Self.Clone;
Result := TFileSystemCopyInOperation.Create(
SourceFileSource, TargetFileSource,
SourceFiles, TargetPath, RenameMask);
end;
function TFileSystemFileSource.CreateCopyOutOperation(var TargetFileSource: TFileSource;
var SourceFiles: TFiles;
TargetPath: String;
RenameMask: String): TFileSourceOperation;
var
SourceFileSource: TFileSystemFileSource;
begin
SourceFileSource := Self.Clone;
Result := TFileSystemCopyOutOperation.Create(
SourceFileSource, TargetFileSource,
SourceFiles, TargetPath, RenameMask);
end;
function TFileSystemFileSource.CreateDeleteOperation(var FilesToDelete: TFiles): TFileSourceOperation;
var
TargetFileSource: TFileSystemFileSource;
begin
TargetFileSource := Self.Clone;
Result := TFileSystemDeleteOperation.Create(TargetFileSource, FilesToDelete);
end;
end.
unit uFileSystemFileSource;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
uFileSourceOperation,
uFileSourceOperationTypes,
uLocalFileSource,
uFileSource,
uFileSourceProperty,
uFileProperty,
uFile
;
type
{en
Real file system.
}
{ TFileSystemFileSource }
TFileSystemFileSource = class(TLocalFileSource)
protected
procedure SetCurrentPath(NewPath: String); override;
public
constructor Create; override;
constructor Create(Path: String); overload;
function Clone: TFileSystemFileSource; override;
procedure CloneTo(FileSource: TFileSource); override;
class function GetSupportedFileProperties: TFilePropertiesTypes; override;
class function GetOperationsTypes: TFileSourceOperationTypes; override;
class function GetFilePropertiesDescriptions: TFilePropertiesDescriptions; override;
class function GetProperties: TFileSourceProperties; override;
function IsAtRootPath: Boolean; override;
function CreateListOperation: TFileSourceOperation; override;
function CreateCopyInOperation(var SourceFileSource: TFileSource;
var SourceFiles: TFiles;
TargetPath: String;
RenameMask: String): TFileSourceOperation; override;
function CreateCopyOutOperation(var TargetFileSource: TFileSource;
var SourceFiles: TFiles;
TargetPath: String;
RenameMask: String): TFileSourceOperation; override;
function CreateDeleteOperation(var FilesToDelete: TFiles): TFileSourceOperation; override;
function CreateWipeOperation(var FilesToWipe: TFiles): TFileSourceOperation; override;
// ------------------------------------------------------
end;
implementation
uses
uOSUtils, uDCUtils,
uFileSystemFile,
uFileSystemListOperation,
uFileSystemCopyOperation,
uFileSystemDeleteOperation,
uFileSystemWipeOperation;
constructor TFileSystemFileSource.Create;
begin
Create(mbGetCurrentDir);
end;
constructor TFileSystemFileSource.Create(Path: String);
begin
inherited Create;
inherited SetCurrentPath(Path);
FCurrentAddress := '';
end;
function TFileSystemFileSource.Clone: TFileSystemFileSource;
begin
Result := TFileSystemFileSource.Create(FCurrentPath);
CloneTo(Result);
end;
procedure TFileSystemFileSource.CloneTo(FileSource: TFileSource);
begin
if Assigned(FileSource) then
begin
inherited CloneTo(FileSource);
end;
end;
class function TFileSystemFileSource.GetOperationsTypes: TFileSourceOperationTypes;
begin
Result := [fsoList,
fsoCopyIn,
fsoCopyOut,
fsoDelete,
fsoWipe,
fsoSetName,
fsoSetAttribute,
fsoExecute];
//fsoSetPath / fsoChangePath
end;
class function TFileSystemFileSource.GetFilePropertiesDescriptions: TFilePropertiesDescriptions;
begin
SetLength(Result, 2);
Result[0] := TFileSizeProperty.GetDescription;
Result[1] := TFileModificationDateTimeProperty.GetDescription;
end;
class function TFileSystemFileSource.GetProperties: TFileSourceProperties;
begin
Result := [
fspDirectAccess
{$IFDEF UNIX}
, fspCaseSensitive
{$ENDIF}
];
end;
procedure TFileSystemFileSource.SetCurrentPath(NewPath: String);
begin
if not mbDirectoryExists(NewPath) then
NewPath := mbGetCurrentDir
else
mbSetCurrentDir(NewPath);
inherited SetCurrentPath(NewPath);
end;
function TFileSystemFileSource.IsAtRootPath: Boolean;
begin
Result := (GetParentDir(CurrentPath) = '');
end;
class function TFileSystemFileSource.GetSupportedFileProperties: TFilePropertiesTypes;
begin
Result := TFileSystemFile.GetSupportedProperties;
end;
function TFileSystemFileSource.CreateListOperation: TFileSourceOperation;
var
TargetFileSource: TFileSystemFileSource;
begin
TargetFileSource := Self.Clone;
Result := TFileSystemListOperation.Create(TargetFileSource);
end;
function TFileSystemFileSource.CreateCopyInOperation(var SourceFileSource: TFileSource;
var SourceFiles: TFiles;
TargetPath: String;
RenameMask: String): TFileSourceOperation;
var
TargetFileSource: TFileSystemFileSource;
begin
TargetFileSource := Self.Clone;
Result := TFileSystemCopyInOperation.Create(
SourceFileSource, TargetFileSource,
SourceFiles, TargetPath, RenameMask);
end;
function TFileSystemFileSource.CreateCopyOutOperation(var TargetFileSource: TFileSource;
var SourceFiles: TFiles;
TargetPath: String;
RenameMask: String): TFileSourceOperation;
var
SourceFileSource: TFileSystemFileSource;
begin
SourceFileSource := Self.Clone;
Result := TFileSystemCopyOutOperation.Create(
SourceFileSource, TargetFileSource,
SourceFiles, TargetPath, RenameMask);
end;
function TFileSystemFileSource.CreateDeleteOperation(var FilesToDelete: TFiles): TFileSourceOperation;
var
TargetFileSource: TFileSystemFileSource;
begin
TargetFileSource := Self.Clone;
Result := TFileSystemDeleteOperation.Create(TargetFileSource, FilesToDelete);
end;
function TFileSystemFileSource.CreateWipeOperation(var FilesToWipe: TFiles): TFileSourceOperation;
var
TargetFileSource: TFileSystemFileSource;
begin
TargetFileSource := Self.Clone;
Result := TFileSystemWipeOperation.Create(TargetFileSource, FilesToWipe);
end;
end.

498
src/newdesign/ufilesystemwipeoperation.pas Normal file
View file

@ -0,0 +1,498 @@
{
Double Commander
-------------------------------------------------------------------------
This module implements a secure erase of disk media as per the
Department of Defense clearing and sanitizing standard: DOD 5220.22-M
The standard states that hard disk media is erased by
overwriting with a character, then the character's complement,
and then a random character. Note that the standard specicically
states that this method is not suitable for TOP SECRET information.
TOP SECRET data sanatizing is only achievable by a Type 1 or 2
degauss of the disk, or by disintegrating, incinerating,
pulverizing, shreding, or melting the disk.
Copyright (C) 2008-2009 Koblov Alexander (Alexx2000@mail.ru)
Based on:
WP - wipes files in a secure way.
version 3.2 - By Uri Fridman. urifrid@yahoo.com
www.geocities.com/urifrid
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
}
unit uFileSystemWipeOperation;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
uFileSourceWipeOperation,
uFileSystemFileSource,
uFileSource,
uFileSourceOperation,
uFileSourceOperationOptions,
uFileSourceOperationUI,
uFile,
uFileSystemFile,
uDescr, uGlobs, uLog;
type
{ TFileSystemWipeOperation }
TFileSystemWipeOperation = class(TFileSourceWipeOperation)
private
everythingOK: boolean;
errors,
files,
directories: Integer;
buffer: array [0..4095] of Byte;
procedure Fill(chr: Integer);
procedure SecureDelete(pass: Integer; FileName: String);
procedure WipeDir(dir: string);
procedure WipeFile(filename: String);
private
FFullFilesTreeToDelete: TFileSystemFiles; // source files including all files/dirs in subdirectories
FStatistics: TFileSourceWipeOperationStatistics; // local copy of statistics
FDescription: TDescription;
// Options.
FSymLinkOption: TFileSourceOperationOptionSymLink;
FSkipErrors: Boolean;
FDeleteReadOnly: TFileSourceOperationOptionGeneral;
protected
procedure Wipe(aFile: TFileSystemFile);
function ShowError(sMessage: String): TFileSourceOperationUIResponse;
procedure LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
public
constructor Create(var aTargetFileSource: TFileSource;
var theFilesToWipe: TFiles); override;
destructor Destroy; override;
procedure Initialize; override;
procedure MainExecute; override;
procedure Finalize; override;
end;
implementation
uses
uOSUtils, uLng, uFindEx,
uFileSystemUtil, FileUtil, LCLProc, uClassesEx;
constructor TFileSystemWipeOperation.Create(var aTargetFileSource: TFileSource;
var theFilesToWipe: TFiles);
begin
FSymLinkOption := fsooslNone;
FSkipErrors := False;
FDeleteReadOnly := fsoogNone;
FFullFilesTreeToDelete := nil;
if gProcessComments then
FDescription := TDescription.Create(True)
else
FDescription := nil;
inherited Create(aTargetFileSource, theFilesToWipe);
end;
destructor TFileSystemWipeOperation.Destroy;
begin
inherited Destroy;
if Assigned(FDescription) then
begin
FDescription.SaveDescription;
FreeAndNil(FDescription);
end;
if Assigned(FFullFilesTreeToDelete) then
FreeAndNil(FFullFilesTreeToDelete);
end;
procedure TFileSystemWipeOperation.Initialize;
begin
// Get initialized statistics; then we change only what is needed.
FStatistics := RetrieveStatistics;
FillAndCount(FilesToDelete as TFileSystemFiles,
FFullFilesTreeToDelete,
FStatistics.TotalFiles,
FStatistics.TotalBytes); // gets full list of files (recursive)
FDescription.Clear;
end;
procedure TFileSystemWipeOperation.MainExecute;
var
aFile: TFileSystemFile;
CurrentFileIndex: Integer;
begin
for CurrentFileIndex := FFullFilesTreeToDelete.Count - 1 downto 0 do
begin
aFile := FFullFilesTreeToDelete[CurrentFileIndex] as TFileSystemFile;
FStatistics.CurrentFile := aFile.Path + aFile.Name;
UpdateStatistics(FStatistics);
Wipe(aFile);
with FStatistics do
begin
DoneFiles := DoneFiles + 1;
DoneBytes := DoneBytes + aFile.Size;
EstimateSpeedAndTime(FStatistics);
UpdateStatistics(FStatistics);
// Update overall progress.
if TotalFiles <> 0 then
UpdateProgress((DoneFiles * 100) div TotalFiles);
end;
CheckOperationState;
end;
end;
procedure TFileSystemWipeOperation.Finalize;
begin
end;
//fill buffer with characters
//0 = with 0, 1 = with 1 and 2 = random
procedure TFileSystemWipeOperation.Fill(chr: Integer);
var i: integer;
begin
if chr=0 then
begin
for i := Low(buffer) to High(buffer) do
buffer[i] := 0;
exit;
end;
if chr=1 then
begin
for i := Low(buffer) to High(buffer) do
buffer[i] := 1;
exit;
end;
if chr=2 then
begin
for i := Low(buffer) to High(buffer) do
buffer[i] := Random(256);
exit;
end;
end;
procedure TFileSystemWipeOperation.SecureDelete(pass: Integer; FileName: String);
var
n, i: Integer;
max,
iPos,
iMax: Int64;
fs: TFileStreamEx;
rena: String; // renames file to delete
begin
try
if mbRenameFile(filename,ExtractFilePath(filename)+'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aaaaaaa') then
begin
rena:= ExtractFilePath(filename)+'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aaaaaaa';
filename:=rena;
end;
except
DebugLn('wp: error renaming file: '+filename);
everythingOK:=False;
errors:=errors+1;
Exit;
end;
fs := TFilestreamEx.Create(FileName, fmOpenReadWrite or fmShareExclusive);
try
for i := 1 to pass do
begin
//---------------Progress--------------
CheckOperationState; // check pause and stop
iMax:= fs.Size * 3;
iPos:= 0;
FStatistics.CurrentFileTotalBytes:= iMax;
FStatistics.CurrentFileDoneBytes:= iPos;
UpdateStatistics(FStatistics);
//-------------------------------------
//with zeros
fill(0);
max := fs.Size;
fs.Position := 0;
while max > 0 do
begin
if max > SizeOf(buffer) then
n := SizeOf(buffer)
else
n := max;
fs.Write(Buffer, n);
max := max - n;
//---------------Progress--------------
CheckOperationState; // check pause and stop
Inc(iPos, n);
FStatistics.CurrentFileDoneBytes:= iPos;
EstimateSpeedAndTime(FStatistics);
UpdateStatistics(FStatistics);
//-------------------------------------
end;
FileFlush(fs.Handle);
//with ones
fill(1);
max := fs.Size;
fs.Position := 0;
while max > 0 do
begin
if max > SizeOf(buffer) then
n := SizeOf(buffer)
else
n := max;
fs.Write(Buffer, n);
max := max - n;
//---------------Progress--------------
CheckOperationState; // check pause and stop
Inc(iPos, n);
FStatistics.CurrentFileDoneBytes:= iPos;
EstimateSpeedAndTime(FStatistics);
UpdateStatistics(FStatistics);
//-------------------------------------
end;
FileFlush(fs.Handle);
//with random data
fill(2);
max := fs.Size;
fs.Position := 0;
while max > 0 do
begin
if max > SizeOf(buffer) then
n := SizeOf(buffer)
else
n := max;
fs.Write(Buffer, n);
max := max - n;
//---------------Progress--------------
CheckOperationState; // check pause and stop
Inc(iPos, n);
FStatistics.CurrentFileDoneBytes:= iPos;
EstimateSpeedAndTime(FStatistics);
UpdateStatistics(FStatistics);
//-------------------------------------
end;
FileFlush(fs.Handle);
end;
FileTruncate(fs.Handle, 0);
fs.Free;
except
on E: Exception do
begin
DebugLn('wp: error wiping: '+filename+': '+E.Message);
fs.Free;
everythingOK:=False;
errors:=errors+1;
Exit;
end;
end;
try
mbDeleteFile(FileName);
except
on E: Exception do
begin
DebugLn('wp: error deleting: '+filename+': '+E.Message);
fs.Free;
everythingOK:=False;
errors:=errors+1;
Exit;
end;
end;
files:= files+1;
DebugLn('OK');
everythingOK:= True;
end;
procedure TFileSystemWipeOperation.WipeDir(dir: string);
var
Search: TSearchRec;
ok: Integer;
sPath: String;
begin
sPath:= IncludeTrailingPathDelimiter(dir);
ok:= FindFirstEx(sPath + '*', faAnyFile, Search);
while ok = 0 do begin
if ((Search.Name <> '.' ) and (Search.Name <> '..')) then
begin
if fpS_ISDIR(Search.Attr) then
begin
//remove read-only attr
try
FileCopyAttr(sPath + Search.Name, sPath + Search.Name, True);
except
DebugLn('wp: FAILED when trying to remove read-only attr on '+ sPath + Search.Name);
end;
DebugLn('entering '+ sPath + Search.Name);
WipeDir(sPath + Search.Name);
end
else
begin
//remove read-only attr
try
if not FileCopyAttr(sPath + Search.Name, sPath + Search.Name, True) then
DebugLn('wp: FAILED when trying to remove read-only attr on '+ sPath + Search.Name);
except
DebugLn('wp: FAILED when trying to remove read-only attr on '+ sPath + Search.Name);
end;
// do something with the file
DebugLn('wiping '+ sPath + Search.Name);
SecureDelete(gWipePassNumber, sPath + Search.Name);
end;
end;
ok:= FindNextEx(Search);
end;
FindCloseEx(Search);
try
if everythingOK then
begin
DebugLn('wiping ' + dir);
if not mbRemoveDir(dir) then
begin
DebugLn('wp: error wiping directory ' + dir);
// write log -------------------------------------------------------------------
LogMessage(Format(rsMsgLogError+rsMsgLogRmDir, [dir]), [log_dir_op, log_delete], lmtError);
//------------------------------------------------------------------------------
end
else
begin
directories:= directories + 1;
DebugLn('OK');
// write log -------------------------------------------------------------------
LogMessage(Format(rsMsgLogSuccess+rsMsgLogRmDir, [dir]), [log_dir_op, log_delete], lmtSuccess);
//------------------------------------------------------------------------------
end;
end;
except
on EInOutError do DebugLn('Couldn''t remove '+ dir);
end;
end;
procedure TFileSystemWipeOperation.WipeFile(filename: String);
var
Found: Integer;
SRec: TSearchRec;
sPath: String;
begin
sPath:= ExtractFilePath(filename);
{ Use FindFirst so we can specify wild cards in the filename }
Found:= FindFirstEx(filename,faReadOnly or faSysFile or faArchive or faSysFile,SRec);
if Found <> 0 then
begin
DebugLn('wp: file not found: ', filename);
errors:= errors+1;
exit;
end;
while Found = 0 do
begin
//remove read-only attr
try
if not FileCopyAttr(sPath + SRec.Name, sPath + SRec.Name, True) then
DebugLn('wp: FAILED when trying to remove read-only attr on '+ sPath + SRec.Name);
except
DebugLn('wp: can''t wipe '+ sPath + SRec.Name + ', file might be in use.');
DebugLn('wipe stopped.');
errors:= errors+1;
everythingOK:= False;
exit;
end;
DebugLn('wiping ' + sPath + SRec.Name);
SecureDelete(gWipePassNumber, sPath + SRec.Name);
if not everythingOK then
DebugLn('wp: couldn''t wipe ' + sPath + SRec.Name);
Found:= FindNextEx(SRec); { Find the next file }
end;
FindCloseEx(SRec);
end;
procedure TFileSystemWipeOperation.Wipe(aFile: TFileSystemFile);
var
FileName: String;
begin
try
FileName:= aFile.Path + aFile.Name;
if aFile.IsDirectory then // directory
WipeDir(FileName)
else // files
WipeFile(FileName);
// process comments if need
if gProcessComments and Assigned(FDescription) then
FDescription.DeleteDescription(FileName);
except
DebugLn('Can not wipe ', FileName);
end;
end;
function TFileSystemWipeOperation.ShowError(sMessage: String): TFileSourceOperationUIResponse;
begin
if gSkipFileOpError then
begin
if Assigned(Thread) then
logWrite(Thread, sMessage, lmtError, True)
else
logWrite(sMessage, lmtError, True);
Result := fsourSkip;
end
else
begin
Result := AskQuestion(sMessage, '', [fsourSkip, fsourCancel], fsourSkip, fsourCancel);
if Result = fsourCancel then
RaiseAbortOperation;
end;
end;
procedure TFileSystemWipeOperation.LogMessage(sMessage: String; logOptions: TLogOptions; logMsgType: TLogMsgType);
begin
case logMsgType of
lmtError:
if not (log_errors in gLogOptions) then Exit;
lmtInfo:
if not (log_info in gLogOptions) then Exit;
lmtSuccess:
if not (log_success in gLogOptions) then Exit;
end;
if logOptions <= gLogOptions then
begin
logWrite(Thread, sMessage, logMsgType);
end;
end;
end.

4838
src/uacts.pas
View file

File diff suppressed because it is too large Load diff