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: New action actWipe for secure file deleting

Browse source
This commit is contained in:
Alexander Koblov 2008-05-17 09:46:37 +00:00
commit 8d95bb469a
14 changed files with 2233 additions and 2130 deletions
Download patch file Download diff file Expand all files Collapse all files

3
doublecmd.lpi
View file

@ -68,6 +68,7 @@
<ComponentName Value="frmMain"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<ResourceFilename Value="fmain.lrs"/>
<UnitName Value="fMain"/>
</Unit2>
@ -295,7 +296,7 @@
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="$(LazarusDir)\ide\"/>
<SrcPath Value="$(LazarusDir)\lcl\;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType)\"/>
<SrcPath Value="$(LazarusDir)\lcl\;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType)\;$(fpcsrcdir)\packages\fcl-base\src\"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>

13
fmain.lfm
View file

@ -27,6 +27,7 @@ object frmMain: TfrmMain
OnShow = frmMainShow
Position = poDesktopCenter
ShowHint = True
LCLVersion = '0.9.25'
object pnlSyncSize: TPanel
Height = 26
Top = 24
@ -429,8 +430,6 @@ object frmMain: TfrmMain
Font.Name = 'courier'
ParentColor = False
TabOrder = 4
BookMarkOptions.OnChange = nil
Gutter.OnChange = nil
Gutter.CodeFoldingWidth = 14
Keystrokes = <
item
@ -756,7 +755,6 @@ object frmMain: TfrmMain
ReadOnly = True
RightEdge = 0
ScrollBars = ssVertical
SelectedColor.OnChange = nil
OnSpecialLineColors = seLogWindowSpecialLineColors
end
object LogSplitter: TSplitter
@ -765,8 +763,8 @@ object frmMain: TfrmMain
Top = 286
Width = 676
Align = alBottom
ResizeStyle = rsLine
ResizeAnchor = akBottom
ResizeStyle = rsLine
end
object mnuMain: TMainMenu
left = 283
@ -1415,6 +1413,13 @@ object frmMain: TfrmMain
DisableIfNoHandler = True
OnExecute = actOpenDirInNewTabExecute
end
object actWipe: TAction
Category = 'Commands'
Caption = 'Wipe'
DisableIfNoHandler = True
OnExecute = actWipeExecute
ShortCut = 32814
end
end
object pmHotList: TPopupMenu
left = 152

1
fmain.lrt
View file

@ -86,6 +86,7 @@ TFRMMAIN.ACTCOPYFULLNAMESTOCLIP.CAPTION=Copy Filename(s) with Full &Path
TFRMMAIN.ACTTARGETEQUALSOURCE.CAPTION=Target &= Source
TFRMMAIN.ACTEXCHANGE.CAPTION=Swap &Panels
TFRMMAIN.ACTOPENDIRINNEWTAB.CAPTION=Open folder in new tab
TFRMMAIN.ACTWIPE.CAPTION=Wipe
TFRMMAIN.TBEDIT.CAPTION=Edit
TFRMMAIN.TBDELETE.CAPTION=Delete
TFRMMAIN.MENUITEM2.CAPTION=-

56
fmain.pas
View file

@ -62,6 +62,7 @@ type
actCopyNamesToClip: TAction;
actCopyFullNamesToClip: TAction;
actExchange: TAction;
actWipe: TAction;
actOpenDirInNewTab: TAction;
actTargetEqualSource: TAction;
actOpen: TAction;
@ -238,6 +239,7 @@ type
procedure actShowButtonMenuExecute(Sender: TObject);
procedure actTransferLeftExecute(Sender: TObject);
procedure actTransferRightExecute(Sender: TObject);
procedure actWipeExecute(Sender: TObject);
procedure btnLeftClick(Sender: TObject);
procedure btnLeftDirectoryHotlistClick(Sender: TObject);
procedure btnRightClick(Sender: TObject);
@ -588,6 +590,60 @@ begin
SetNotActFrmByActFrm;
end;
procedure TfrmMain.actWipeExecute(Sender: TObject);
var
fl:TFileList;
WT : TWipeThread;
begin
with ActiveFrame do
begin
if pnlFile.PanelMode in [pmArchive, pmVFS] then // if in VFS
begin
msgOK(rsMsgErrNotSupported);
Exit;
end; // in VFS
SelectFileIfNoSelected(GetActiveItem);
end;
case msgYesNoCancel(GetFileDlgStr(rsMsgDelSel,rsMsgDelFlDr)) of
mmrNo:
begin
ActiveFrame.UnMarkAll;
Exit;
end;
mmrCancel:
begin
with ActiveFrame do
UnSelectFileIfSelected(GetActiveItem);
Exit;
end;
end;
fl:=TFileList.Create; // free at Thread end by thread
try
CopyListSelectedExpandNames(ActiveFrame.pnlFile.FileList,fl,ActiveFrame.ActiveDir);
(* Wipe files *)
if not Assigned(frmFileOp) then
frmFileOp:= TfrmFileOp.Create(Application);
try
WT := TWipeThread.Create(fl);
WT.FFileOpDlg:= frmFileOp;
WT.sDstPath:= NotActiveFrame.ActiveDir;
//DT.sDstMask:=sDstMaskTemp;
frmFileOp.Thread:= TThread(WT);
frmFileOp.Show;
WT.Resume;
except
WT.Free;
end;
except
FreeAndNil(frmFileOp);
end;
end;
procedure TfrmMain.btnLeftClick(Sender: TObject);
begin
with Sender as TSpeedButton do

4
language/doublecmd.bg.po
View file

@ -2003,6 +2003,10 @@ msgstr "Ширина"
msgid "Windows: 'rahs' Unix: 'rwxrwxrwx'"
msgstr "Windows: 'rahs' Unix: 'rwxrwxrwx'"
#: TFRMMAIN.ACTWIPE.CAPTION
msgid "Wipe"
msgstr ""
#: TFRMFILEPROPERTIES.LBLWRITE.CAPTION
msgid "Write"
msgstr "Четене"

4244
language/doublecmd.chs.po
View file

File diff suppressed because it is too large Load diff

4
language/doublecmd.cs.po
View file

@ -2005,6 +2005,10 @@ msgstr "Šířka"
msgid "Windows: 'rahs' Unix: 'rwxrwxrwx'"
msgstr "Windows: 'rahs' Unix: 'rwxrwxrwx'"
#: TFRMMAIN.ACTWIPE.CAPTION
msgid "Wipe"
msgstr ""
#: TFRMFILEPROPERTIES.LBLWRITE.CAPTION
msgid "Write"
msgstr "Zápis"

4
language/doublecmd.de.po
View file

@ -2003,6 +2003,10 @@ msgstr "Weite"
msgid "Windows: 'rahs' Unix: 'rwxrwxrwx'"
msgstr "Windows: 'rahs' Unix: 'rwxrwxrwx'"
#: TFRMMAIN.ACTWIPE.CAPTION
msgid "Wipe"
msgstr ""
#: TFRMFILEPROPERTIES.LBLWRITE.CAPTION
msgid "Write"
msgstr "Schreiben"

4
language/doublecmd.es.po
View file

@ -2003,6 +2003,10 @@ msgstr "Anchura"
msgid "Windows: 'rahs' Unix: 'rwxrwxrwx'"
msgstr "Windows: 'rahs' Unix: 'rwxrwxrwx'"
#: TFRMMAIN.ACTWIPE.CAPTION
msgid "Wipe"
msgstr ""
#: TFRMFILEPROPERTIES.LBLWRITE.CAPTION
msgid "Write"
msgstr "Escritura"

4
language/doublecmd.nl.po
View file

@ -2003,6 +2003,10 @@ msgstr "breedte"
msgid "Windows: 'rahs' Unix: 'rwxrwxrwx'"
msgstr "Windows: 'rahs' Unix: 'rwxrwxrwx'"
#: TFRMMAIN.ACTWIPE.CAPTION
msgid "Wipe"
msgstr ""
#: TFRMFILEPROPERTIES.LBLWRITE.CAPTION
msgid "Write"
msgstr "Schrijf"

4
language/doublecmd.po
View file

@ -2123,3 +2123,7 @@ msgstr ""
msgid "Open folder in new tab"
msgstr ""
#: TFRMMAIN.ACTWIPE.CAPTION
msgid "Wipe"
msgstr ""

4
language/doublecmd.ru.po
View file

@ -2002,6 +2002,10 @@ msgstr "Ширина"
msgid "Windows: 'rahs' Unix: 'rwxrwxrwx'"
msgstr ""
#: TFRMMAIN.ACTWIPE.CAPTION
msgid "Wipe"
msgstr ""
#: TFRMFILEPROPERTIES.LBLWRITE.CAPTION
msgid "Write"
msgstr "Запись"

4
language/doublecmd.uk.po
View file

@ -2002,6 +2002,10 @@ msgstr "Ширина"
msgid "Windows: 'rahs' Unix: 'rwxrwxrwx'"
msgstr ""
#: TFRMMAIN.ACTWIPE.CAPTION
msgid "Wipe"
msgstr ""
#: TFRMFILEPROPERTIES.LBLWRITE.CAPTION
msgid "Write"
msgstr "Запис"

14
uwipethread.pas
View file

@ -275,7 +275,9 @@ procedure TWipeThread.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
@ -288,20 +290,20 @@ begin
begin
//remove read-only attr
try
if not FileCopyAttr(SRec.Name, SRec.Name, True) then
DebugLn('wp: FAILED when trying to remove read-only attr on '+SRec.Name);
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 '+SRec.Name+', file might be in use.');
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 '+SRec.Name);
SecureDelete(strtoint(paramstr(1)),SRec.Name);
DebugLn('wiping ' + sPath + SRec.Name);
SecureDelete(1, sPath + SRec.Name);
if not everythingOK then
DebugLn('wp: couldn''t wipe '+filename);
DebugLn('wp: couldn''t wipe ' + sPath + SRec.Name);
Found:= FindNextEx(SRec); { Find the next file }
end;