diff --git a/DataEliminator.dproj b/DataEliminator.dproj new file mode 100644 index 0000000..e3be742 --- /dev/null +++ b/DataEliminator.dproj @@ -0,0 +1,993 @@ + + + {EA5F1D03-57B5-4B6C-B437-BABECCE06C8C} + 18.8 + VCL + DataEliminator.dpr + True + Release + Win32 + 1 + Application + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + DataEliminator + $(BDS)\bin\delphi_PROJECTICON.ico + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + + + true + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + $(BDS)\bin\default_app.manifest + CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) + 1033 + FireDACSqliteDriver;FireDACDSDriver;DBXSqliteDriver;FireDACPgDriver;fmx;IndySystem;TeeDB;tethering;inetdbbde;vclib;DBXInterBaseDriver;DataSnapClient;DataSnapServer;DataSnapCommon;DataSnapProviderClient;DBXSybaseASEDriver;DbxCommonDriver;vclimg;dbxcds;DatasnapConnectorsFreePascal;MetropolisUILiveTile;vcldb;RARComponent_d2009;vcldsnap;fmxFireDAC;DBXDb2Driver;DBXOracleDriver;CustomIPTransport;vclribbon;dsnap;IndyIPServer;fmxase;vcl;IndyCore;DBXMSSQLDriver;IndyIPCommon;CloudService;FmxTeeUI;FireDACIBDriver;CodeSiteExpressPkg;DataSnapFireDAC;FireDACDBXDriver;soapserver;inetdbxpress;dsnapxml;FireDACInfxDriver;FireDACDb2Driver;adortl;LockBox3DR;FireDACASADriver;bindcompfmx;vcldbx;FireDACODBCDriver;RESTBackendComponents;rtl;dbrtl;DbxClientDriver;DISQLite3_DXE6;FireDACCommon;bindcomp;inetdb;Tee;DBXOdbcDriver;vclFireDAC;xmlrtl;DataSnapNativeClient;svnui;ibxpress;IndyProtocols;DBXMySQLDriver;FireDACCommonDriver;bindcompdbx;bindengine;vclactnband;soaprtl;FMXTee;TeeUI;bindcompvcl;vclie;FireDACADSDriver;vcltouch;VclSmp;FireDACMSSQLDriver;FireDAC;DBXInformixDriver;Intraweb;VCLRESTComponents;CoolTrayIconD16;DataSnapConnectors;dsnapcon;DBXFirebirdDriver;inet;fmxobj;FireDACMySQLDriver;soapmidas;vclx;svn;DBXSybaseASADriver;FireDACOracleDriver;fmxdae;RESTComponents;bdertl;FireDACMSAccDriver;dbexpress;DataSnapIndy10ServerTransport;IndyIPClient;$(DCC_UsePackage) + true + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + FireDACSqliteDriver;FireDACDSDriver;DBXSqliteDriver;FireDACPgDriver;fmx;IndySystem;TeeDB;tethering;vclib;DBXInterBaseDriver;DataSnapClient;DataSnapServer;DataSnapCommon;DataSnapProviderClient;DBXSybaseASEDriver;DbxCommonDriver;vclimg;dbxcds;DatasnapConnectorsFreePascal;MetropolisUILiveTile;vcldb;vcldsnap;fmxFireDAC;DBXDb2Driver;DBXOracleDriver;CustomIPTransport;vclribbon;dsnap;IndyIPServer;fmxase;vcl;IndyCore;DBXMSSQLDriver;IndyIPCommon;CloudService;FmxTeeUI;FireDACIBDriver;DataSnapFireDAC;FireDACDBXDriver;soapserver;inetdbxpress;dsnapxml;FireDACInfxDriver;FireDACDb2Driver;adortl;LockBox3DR;FireDACASADriver;bindcompfmx;FireDACODBCDriver;RESTBackendComponents;rtl;dbrtl;DbxClientDriver;FireDACCommon;bindcomp;inetdb;Tee;DBXOdbcDriver;vclFireDAC;xmlrtl;DataSnapNativeClient;ibxpress;IndyProtocols;DBXMySQLDriver;FireDACCommonDriver;bindcompdbx;bindengine;vclactnband;soaprtl;FMXTee;TeeUI;bindcompvcl;vclie;FireDACADSDriver;vcltouch;VclSmp;FireDACMSSQLDriver;FireDAC;DBXInformixDriver;Intraweb;VCLRESTComponents;DataSnapConnectors;dsnapcon;DBXFirebirdDriver;inet;fmxobj;FireDACMySQLDriver;soapmidas;vclx;DBXSybaseASADriver;FireDACOracleDriver;fmxdae;RESTComponents;FireDACMSAccDriver;dbexpress;DataSnapIndy10ServerTransport;IndyIPClient;$(DCC_UsePackage) + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + DEBUG;$(DCC_Define) + true + false + true + true + true + + + false + Debug + true + 1033 + true + Icon.ico + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + Debug + true + 1033 + true + Icon.ico + ..\..\Downloads\iconfinder_108_Shredder_Confidential_data_file_information_office_paper_4308295.png + ..\..\Downloads\iconfinder_108_Shredder_Confidential_data_file_information_office_paper_4308295.png + + + + MainSource + + +
frmMain
+ dfm + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + + + + + DataEliminator.dpr + + + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + File C:\Program Files (x86)\FastReport 6 VCL Enterprise\LibD26\dclfrxBDE26.bpl not found + File C:\Program Files (x86)\FastReport 6 VCL Enterprise\LibD26\dclfsBDE26.bpl not found + + + + + + Assets\ + Logo44x44.png + true + + + + + DataEliminator.exe + true + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + classes + 1 + + + classes + 1 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + 0 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + 1 + + + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + + + Contents + 1 + + + Contents + 1 + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + + + + + + + + + + + True + False + + + 12 + + + + + diff --git a/Main.dfm b/Main.dfm index ad5e862..bedff70 100644 --- a/Main.dfm +++ b/Main.dfm @@ -4,7 +4,7 @@ object frmMain: TfrmMain BorderIcons = [biSystemMenu, biMinimize] BorderStyle = bsSingle Caption = 'Eliminator ' - ClientHeight = 319 + ClientHeight = 391 ClientWidth = 520 Color = clBtnFace Font.Charset = DEFAULT_CHARSET @@ -20,7 +20,7 @@ object frmMain: TfrmMain TextHeight = 13 object Status: TStatusBar Left = 0 - Top = 300 + Top = 372 Width = 520 Height = 19 Panels = < @@ -31,67 +31,79 @@ object frmMain: TfrmMain item Width = 50 end> - ExplicitTop = 282 - ExplicitWidth = 517 end object GB_FreeSWipe: TGroupBox Left = 8 - Top = 227 + Top = 285 Width = 503 - Height = 64 - Caption = 'Free Space Wipe' - TabOrder = 1 + Height = 56 + Enabled = False + TabOrder = 5 object lblDriveLetter: TLabel - Left = 15 - Top = 30 + Left = 25 + Top = 19 Width = 32 Height = 13 Caption = 'Drive :' + Enabled = False end object cbLogicalDrivers: TComboBoxEx - Left = 53 - Top = 27 + Left = 63 + Top = 16 Width = 145 Height = 22 ItemsEx = <> Style = csExDropDownList + Enabled = False TabOrder = 0 end object btnFreeSWipe: TButton - Left = 406 - Top = 25 - Width = 75 + Left = 356 + Top = 14 + Width = 110 Height = 25 Caption = 'Wipe' + Enabled = False TabOrder = 1 OnClick = btnFreeSWipeClick end end object GB_Browse: TGroupBox Left = 8 - Top = 172 - Width = 117 + Top = 8 + Width = 308 Height = 49 - TabOrder = 2 + TabOrder = 0 object btnSelectFiles: TButton - Left = 15 + Left = 44 Top = 10 - Width = 75 + Width = 110 Height = 25 - Caption = 'Open' + Caption = 'Add Files' TabOrder = 0 OnClick = btnSelectFilesClick end + object btnAddfromDir: TButton + Left = 160 + Top = 10 + Width = 110 + Height = 25 + Caption = 'Open Directory' + TabOrder = 1 + OnClick = btnAddfromDirClick + end end object lstWipe: TListView Left = 8 - Top = 8 + Top = 63 Width = 503 Height = 158 Columns = < item AutoSize = True Caption = 'Selected Files ...' + MaxWidth = 5000 + MinWidth = 499 end> FlatScrollBars = True GridLines = True @@ -99,19 +111,19 @@ object frmMain: TfrmMain RowSelect = True ShowColumnHeaders = False SortType = stText - TabOrder = 3 + TabOrder = 2 ViewStyle = vsReport end object GB_Wipe: TGroupBox - Left = 392 - Top = 172 - Width = 119 + Left = 322 + Top = 8 + Width = 189 Height = 49 - TabOrder = 4 + TabOrder = 1 object btnDestroyFiles: TButton - Left = 22 + Left = 42 Top = 10 - Width = 75 + Width = 110 Height = 25 Caption = 'Wipe' TabOrder = 0 @@ -119,11 +131,11 @@ object frmMain: TfrmMain end end object GB_Methods: TGroupBox - Left = 131 - Top = 172 - Width = 255 + Left = 8 + Top = 227 + Width = 504 Height = 49 - TabOrder = 5 + TabOrder = 3 object lblWipeStd: TLabel Left = 16 Top = 16 @@ -132,21 +144,41 @@ object frmMain: TfrmMain Caption = 'Wipe Method :' end object cbWipeMethods: TComboBox - Left = 92 + Left = 97 Top = 12 - Width = 145 + Width = 249 Height = 22 Style = csOwnerDrawFixed ItemIndex = 0 TabOrder = 0 - Text = 'Secure - 1 Pass' + Text = 'Secure - 1 Pass [ Fast - Low Security ]' Items.Strings = ( - 'Secure - 1 Pass' - 'DoD - 3 Passes' - 'NSA - 7 Passes' - 'Gutmann - 35 Passes') + 'Secure - 1 Pass [ Fast - Low Security ]' + 'DoD - 3 Passes [ Fast - Medium Security ]' + 'NSA - 7 Passes [ Medium - Good Security ]' + 'Gutmann - 35 Passes [ Slow - Ultra Security ]') end end + object chFreeSpaceWipe: TCheckBox + Left = 15 + Top = 278 + Width = 201 + Height = 17 + Caption = 'Free Space Wipe [ Also Erase MFT ]' + TabOrder = 4 + OnClick = chFreeSpaceWipeClick + end + object Progress: TProgressBar + Left = 8 + Top = 347 + Width = 504 + Height = 19 + Max = 0 + Smooth = True + MarqueeInterval = 1 + Step = 1 + TabOrder = 6 + end object OpenFile: TOpenDialog Filter = 'Any File|*.*' Options = [ofHideReadOnly, ofAllowMultiSelect, ofEnableSizing] @@ -171,7 +203,7 @@ object frmMain: TfrmMain StopMode = smTerminate OnRun = FreeSpaceWipeRun OnTerminate = FreeSpaceWipeTerminate - Left = 20 - Top = 15 + Left = 35 + Top = 90 end end diff --git a/Main.pas b/Main.pas index f8b42ba..ad668c0 100644 --- a/Main.pas +++ b/Main.pas @@ -41,7 +41,7 @@ interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,math, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.FileCtrl,IdBaseComponent, IdThreadComponent, - Vcl.ComCtrls, System.UITypes, System.Types, System.IOUtils, ActiveX,ComObj, System.StrUtils; + Vcl.ComCtrls, System.UITypes, System.Types, System.IOUtils, ActiveX,ComObj, System.StrUtils,Masks; type TfrmMain = class(TForm) @@ -61,18 +61,23 @@ TfrmMain = class(TForm) GB_Methods: TGroupBox; lblWipeStd: TLabel; cbWipeMethods: TComboBox; + btnAddfromDir: TButton; + chFreeSpaceWipe: TCheckBox; + Progress: TProgressBar; procedure btnSelectFilesClick(Sender: TObject); procedure btnDestroyFilesClick(Sender: TObject); procedure FShredderRun(Sender: TIdThreadComponent); procedure FShredderTerminate(Sender: TIdThreadComponent); procedure ShredFileAndDelete; - procedure WriteZeroBytes(FileName:String); function RandomPassword(PLen: Integer): string; procedure FormCreate(Sender: TObject); procedure btnFreeSWipeClick(Sender: TObject); procedure FreeSpaceWipeRun(Sender: TIdThreadComponent); procedure FreeSpaceWipeTerminate(Sender: TIdThreadComponent); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); + procedure btnAddfromDirClick(Sender: TObject); + function MyGetFiles(const Path, Masks: string): TStringDynArray; + procedure chFreeSpaceWipeClick(Sender: TObject); private { Private declarations } public @@ -86,6 +91,7 @@ TfrmMain = class(TForm) frmMain: TfrmMain; JobStatus:Boolean; Free_SWipe:Boolean; + FilesInDir:TStringList; implementation @@ -120,8 +126,14 @@ procedure SetFileCreationTime(const FileName: string; const DateTime: TDateTime) procedure TfrmMain.btnFreeSWipeClick(Sender: TObject); begin Free_SWipe := False; - btnFreeSWipe.Enabled := False; - FreeSpaceWipe.Start; + if Trim(cbLogicalDrivers.Text) = '' then + begin + MessageBoxA(self.Handle,'Please Select Drive You Want To Wipe !','Error',MB_ICONERROR); + end else + begin + btnFreeSWipe.Enabled := False; + FreeSpaceWipe.Start; + end; end; procedure TfrmMain.btnSelectFilesClick(Sender: TObject); @@ -139,6 +151,23 @@ procedure TfrmMain.btnSelectFilesClick(Sender: TObject); end; +procedure TfrmMain.chFreeSpaceWipeClick(Sender: TObject); +begin + if GB_FreeSWipe.Enabled = False then + begin + GB_FreeSWipe.Enabled := True; + lblDriveLetter.Enabled := True; + cbLogicalDrivers.Enabled := True; + btnFreeSWipe.Enabled := True; + end else + begin + GB_FreeSWipe.Enabled := False; + lblDriveLetter.Enabled := False; + cbLogicalDrivers.Enabled := False; + btnFreeSWipe.Enabled := False; + end; +end; + function TfrmMain.RandomPassword(PLen: Integer): string; var str: string; @@ -184,11 +213,12 @@ procedure TfrmMain.FreeSpaceWipeRun(Sender: TIdThreadComponent); FWbemObject : OLEVariant; oEnum : IEnumvariant; iValue : LongWord; - CBlock:Integer; + CBlock,I:Integer; F:file; - Data:string; + Data,FileName:string; hFile:THandle; FreeSize:UInt64; + FilesInDir:TStringDynArray; begin try if (cbLogicalDrivers.Text <> '') then @@ -232,6 +262,7 @@ procedure TfrmMain.FreeSpaceWipeRun(Sender: TIdThreadComponent); end; CloseFile(F); end; + end; except @@ -240,6 +271,25 @@ procedure TfrmMain.FreeSpaceWipeRun(Sender: TIdThreadComponent); CoUninitialize; CloseFile(F); DeleteFile(cbLogicalDrivers.Text + '$00000000.tmp'); + // Erase MFT + TDirectory.CreateDirectory(cbLogicalDrivers.Text + 'Eliminator'); + if System.SysUtils.DirectoryExists(cbLogicalDrivers.Text + 'Eliminator') then + begin + for I := 0 to 80000 do + begin + FileName := IntToStr(I) + '.elim'; + hFile := CreateFile(PChar(cbLogicalDrivers.Text + 'Eliminator\' + FileName), + GENERIC_ALL, FILE_SHARE_WRITE, nil, CREATE_ALWAYS, + FILE_ATTRIBUTE_NORMAL, 0); + CloseHandle(hFile); + end; + + + FilesInDir := MyGetFiles(cbLogicalDrivers.Text + 'Eliminator','*.*'); + for I := 0 to High(FilesInDir) do + DeleteFile(FilesInDir[I]); + RemoveDir(cbLogicalDrivers.Text + 'Eliminator') + end; FreeSpaceWipe.Stop; FreeSpaceWipe.Terminate; @@ -259,7 +309,7 @@ procedure TfrmMain.FreeSpaceWipeTerminate(Sender: TIdThreadComponent); procedure TfrmMain.FShredderRun(Sender: TIdThreadComponent); begin try - if OpenFile.Files.Count <> 0 then + if ( OpenFile.Files.Count <> 0 ) or (lstWipe.Items.Count > 0) then begin btnDestroyFiles.Enabled := False; ShredFileAndDelete; @@ -285,109 +335,180 @@ procedure TfrmMain.FShredderTerminate(Sender: TIdThreadComponent); end; end; +function TfrmMain.MyGetFiles(const Path, Masks: string): TStringDynArray; +var + MaskArray: TStringDynArray; + Predicate: TDirectory.TFilterPredicate; +begin + MaskArray := SplitString(Masks, ';'); + Predicate := + function(const Path: string; const SearchRec: TSearchRec): Boolean + var + Mask: string; + begin + for Mask in MaskArray do + if MatchesMask(SearchRec.Name, Mask) then + exit(True); + exit(False); + end; + Result := TDirectory.GetFiles(Path, Predicate); +end; + + procedure TfrmMain.ShredFileAndDelete(); var F:file; - CBlock, FSize:Cardinal; + CBlock, FSize:UInt64; s:String; I,Passes:Integer; + FileHandle: THandle; +Const + Buf : Byte = 0; begin - for I := lstWipe.Items.Count - 1 downto 0 do - begin - AssignFile(F,lstWipe.Items[I].Caption); - Reset(F,1); - FSize := FileSize(F); - CBlock := 0; - if FSize <> 0 then - begin - - case cbWipeMethods.ItemIndex of - 0: - begin - repeat - Randomize; - s := RandomPassword((FSize div 2)); - BlockWrite(F,PChar(s)^,(FSize div 2)); - CBlock := CBlock + (FSize div 2); - until (CBlock >= FSize); - end; - 1: - begin - for Passes := 0 to 2 do - begin - repeat - Randomize; - s := RandomPassword((FSize div 2)); - BlockWrite(F,PChar(s)^,(FSize div 2)); - CBlock := CBlock + (FSize div 2); - until (CBlock >= FSize); - end; - end; - 2: - begin - for Passes := 0 to 6 do - begin - repeat - Randomize; - s := RandomPassword((FSize div 2)); - BlockWrite(F,PChar(s)^,(FSize div 2)); - CBlock := CBlock + (FSize div 2); - until (CBlock >= FSize); + for I := lstWipe.Items.Count - 1 downto 0 do + begin + FileHandle := CreateFile(PChar(lstWipe.Items[I].Caption), GENERIC_READ, + 0, {exclusive} + nil, {security} + OPEN_EXISTING, + FILE_ATTRIBUTE_NORMAL, + 0); + + FSize := GetFileSize(FileHandle,nil); + CloseHandle(FileHandle); + //=========================================// + + AssignFile(F,lstWipe.Items[I].Caption); + Reset(F,1); + //FSize := FileSize(F); + CBlock := 0; + if FSize <> 0 then + begin + + case cbWipeMethods.ItemIndex of + 0: + begin + Progress.Max := FSize; + // Write Random Data. + repeat + Randomize; + s := RandomPassword(1024); + BlockWrite(F,PChar(s)^,length(s)); + CBlock := CBlock + length(s); + + Progress.Position := CBlock; + until (CBlock >= FSize); + + + // Empty File. + Rewrite(F); + Progress.Position := 0; + end; + 1: + begin + Progress.Max := FSize; + for Passes := 0 to 2 do + begin + CBlock := 0; + // Write Random Data. + repeat + Randomize; + s := RandomPassword(1024); + BlockWrite(F,PChar(s)^,length(s)); + CBlock := CBlock + length(s); + + Progress.Position := CBlock; + until (CBlock >= FSize); + + // Empty File. + Rewrite(F); + Progress.Position := 0; + end; + end; + 2: + begin + Progress.Max := FSize; + for Passes := 0 to 6 do + begin + CBlock := 0; + // Write Random Data. + repeat + Randomize; + s := RandomPassword(1024); + BlockWrite(F,PChar(s)^,length(s)); + CBlock := CBlock + length(s); + + Progress.Position := CBlock; + until (CBlock >= FSize); + + // Empty File. + Rewrite(F); + Progress.Position := 0; + end; + end; + 3: + begin + Progress.Max := FSize; + for Passes := 0 to 34 do + begin + CBlock := 0; + // Write Random Data. + repeat + Randomize; + s := RandomPassword(1024); + BlockWrite(F,PChar(s)^,length(s)); + CBlock := CBlock + length(s); + + + Progress.Position := CBlock; + until (CBlock >= FSize); + + // Empty File. + Rewrite(F); + Progress.Position := 0; + end; end; - end; - 3: - begin - for Passes := 0 to 34 do - begin - repeat - Randomize; - s := RandomPassword((FSize div 2)); - BlockWrite(F,PChar(s)^,(FSize div 2)); - CBlock := CBlock + (FSize div 2); - until (CBlock >= FSize); - end; - end; - end; - end; + end; + end; - CloseFile(F); - WriteZeroBytes(lstWipe.Items[I].Caption); + CloseFile(F); - Randomize; - SetFileCreationTime(lstWipe.Items[I].Caption,RandomRange(100,25000)); - RenameFile(lstWipe.Items[I].Caption,ExtractFilePath(lstWipe.Items[I].Caption) + '$000000.tmp'); - DeleteFile(ExtractFilePath(lstWipe.Items[I].Caption) + '$000000.tmp'); - lstWipe.Items[I].Delete; - end; + Randomize; + SetFileCreationTime(lstWipe.Items[I].Caption,RandomRange(100,25000)); + RenameFile(lstWipe.Items[I].Caption,ExtractFilePath(lstWipe.Items[I].Caption) + '$000000.tmp'); + DeleteFile(ExtractFilePath(lstWipe.Items[I].Caption) + '$000000.tmp'); + lstWipe.Items[I].Delete; + end; FShredder.Terminate; end; - -procedure TfrmMain.WriteZeroBytes(FileName: String); +procedure TfrmMain.btnAddfromDirClick(Sender: TObject); var - fs: TFileStream; - MyFile:file; - Buff: array of byte; + i:Integer; + FilesInDir:TStringDynArray; begin - fs := TFileStream.Create(FileName, fmOpenWrite); - SetLength(Buff, fs.Size); - FillChar(Buff[0], Length(Buff), #0); - + lstWipe.Clear; + with TFileOpenDialog.Create(nil) do try - fs.Position := 0; - fs.Write(Buff[0], Length(Buff)); + Options := [fdoPickFolders]; + if Execute then + begin + if FileName <> '' then + begin + + FilesInDir := TDirectory.GetFiles(FileName, '*.*', TSearchOption.soAllDirectories); + for I := 0 to High(FilesInDir) do + begin + lstWipe.AddItem(FilesInDir[I],nil); + end; + end; + end; finally - fs.Free; + Free; end; - - AssignFile(MyFile,FileName); - Rewrite(MyFile); - CloseFile(MyFile); - end; - procedure TfrmMain.btnDestroyFilesClick(Sender: TObject); begin if MessageDlg('Are you sure ?',mtConfirmation,mbYesNo,0) = mrYes then