Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 140
  • Last Modified:

Program that?s remove specified files from hd

I don?t now if this is a properly request. But I try any way.

I need a program that?s remove specified files from hd.
I have try to make it my self but get stop when it come to mask and read it from
a file with multi search on files.

It most work in delphi5 with out DB controls.

1: Form with a path and mask  field.
2: Listbox (List files removed from hd)
3: Possible to select recursive mode.
4: Multi select in mask field and with ?*? (ex *.nfo;my*.*;t*.nfo )
5: Store mask and target field in a INI file (Auto read and store)
6: possible to cancel Search and remove operation.

Simple a program that?s remove files on my hd and read mask from file
And optimized to remove files as it found it.
It most work on win9x system.

Need the source in complete project form.

If this is a stupid question let me now.    
0
Dark_King
Asked:
Dark_King
  • 6
  • 2
1 Solution
 
Dark_KingAuthor Commented:
I have try to set the point to more but it don?t work
0
 
Dark_KingAuthor Commented:
:)
0
 
geobulCommented:
Hi,

-two edit boxes:
 edtPath for path like 'c:\test' or 'c:\test\'
 edtMask for the mask like '*.pas' or '*.~pa;*.~df' - semicolon delimited
-one checkbox if checked then include subfolders
-two buttons
 btnFind - finds files based on the path and masks and fills the lbFiles listBox
 btnDelete - deletes files from the list box.

And finally stores path and mask into a file (const IniName = ...) and reads them at startup.
-----

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    edtPath: TEdit;
    Label1: TLabel;
    edtMask: TEdit;
    Label2: TLabel;
    lbFiles: TListBox;
    btnFind: TButton;
    btnDelete: TButton;
    cbSubdirs: TCheckBox;
    procedure btnFindClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure edtPathExit(Sender: TObject);
    procedure edtMaskExit(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses inifiles;

const
  IniName = 'c:\temp\myini.ini';

// Enumerating files in a subtree
procedure GetFiles(FromDir, Mask: String; IncludeSubdirs : boolean; List: TListBox);
var
 DirInfo: TSearchRec;
 R, i: Integer;
 DirList: TStringList;
begin
 // Fill SubDirs list
 if FromDir[Length(FromDir)] <> '\' then FromDir := FromDir + '\';
 DirList := TStringList.Create;
 try
  if IncludeSubdirs then begin
   R := FindFirst(FromDir + '*.*', faDirectory, DirInfo);
   if R = 0 then begin
    repeat
     if (DirInfo.Name <> '.') and (DirInfo.Name <> '..') then begin
       DirList.Add(FromDir + DirInfo.Name);
     end;
     R := FindNext(DirInfo);
    until R <> 0;
    FindClose(DirInfo);
   end;
  end;
 // Add files from the current dir
  R := FindFirst(FromDir + Mask, faAnyfile, DirInfo);
  if R = 0 then begin
   repeat
     if (DirInfo.Name <> '.') and (DirInfo.Name <> '..') then begin
       if (((DirInfo.Attr and faDirectory) <> 0) and IncludeSubdirs) then GetFiles(FromDir + DirInfo.Name + '\', Mask, IncludeSubdirs, List)
         else List.Items.Add(FromDir + DirInfo.Name);
     end;
     R := FindNext(DirInfo);
   until R <> 0;
   FindClose(DirInfo);
  end;
  // Call it recursively
  if IncludeSubdirs then begin
    for i := 0 to DirList.Count - 1 do begin
      GetFiles(DirList[i], Mask, IncludeSubdirs, List);
    end;
  end;
 finally
   DirList.Free;
 end;
end;

function SplitStr(Var AString : String; ADelim : String) : String;
var APos : Integer;
begin
 Result := '';
 APos := Pos(ADelim,AString);
 if APos > 0 then begin
   Result := Copy(AString,1,APos-1);
   AString := copy(Astring,APos+length(Adelim),MaxLongInt);
 end else begin
   Result := AString;
   AString := '';
 end;
end;

procedure TForm1.btnFindClick(Sender: TObject);
var
  s, Mask: string;
begin
  lbFiles.Items.Clear;
  s := edtMask.Text;
  while s <> '' do begin
    Mask := SplitStr(s,';');
    GetFiles(edtPath.Text,Mask,cbSubdirs.Checked,lbFiles);
  end;
end;

procedure TForm1.btnDeleteClick(Sender: TObject);
var
  i: integer;
begin
  for i := 0 to lbFiles.Items.Count - 1 do begin
    DeleteFile(lbFiles.Items[i]);
  end;
  lbFiles.Items.Clear;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
   Sec : String;
begin
 with TIniFile.Create(IniName) do begin
  try
   Sec := 'edit';
   edtPath.text := ReadString(Sec, 'path','');
   edtMask.text := ReadString(Sec, 'mask','');
  finally
   Free;
  end;
 end;
end;

procedure TForm1.edtPathExit(Sender: TObject);
var
   Sec, Key, Value : String;
begin
  with TIniFile.Create(IniName) do begin
  try
   Sec := 'edit';
   Key := 'path';
   Value := edtPath.Text;
   WriteString(Sec,Key,Value);
  finally
   Free;
  end;
 end;
end;

procedure TForm1.edtMaskExit(Sender: TObject);
var
   Sec, Key, Value : String;
begin
  with TIniFile.Create(IniName) do begin
  try
   Sec := 'edit';
   Key := 'mask';
   Value := edtMask.Text;
   WriteString(Sec,Key,Value);
  finally
   Free;
  end;
 end;
end;

end.


Regards, Geo
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
Dark_KingAuthor Commented:
It work great. Point near for you.
But is it possible to get a Cancel button for "btnFindClick"
0
 
Dark_KingAuthor Commented:
It work great. Point near for you.
But is it possible to get a Cancel button for "btnFindClick"
0
 
Dark_KingAuthor Commented:
I going for my semester in one our, So get going on this "Geobul"

Don?t worry I read it to night from home.
0
 
CrazyOneCommented:
Hi Dark_King this is not related directly to your question but I am sure you have noticed that some of the words in your comments have question marks were I am sure you meant for them to be apostrophe's. I bet you are using MS Word. If so and if you would like for these question marks not to appear then the way to do that is by turning off the smart quote options. Just thought I would pass on this info in case you were curious about it why it is happening.:>)


The Crazy One
0
 
Dark_KingAuthor Commented:
Tanks for that CrazyOne.

(apostrophe's apostrophe's apostrophe's apostrophe's apostrophe's)
0
 
geobulCommented:
Yes, it's possible:
- one new button btnStop
- one new boolean variable StopFind
- and the cursor becomes Hourglass while searching.
Look at the comments at the end of btnFindClick.
-----
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    edtPath: TEdit;
    Label1: TLabel;
    edtMask: TEdit;
    Label2: TLabel;
    lbFiles: TListBox;
    btnFind: TButton;
    btnDelete: TButton;
    cbSubdirs: TCheckBox;
    btnStop: TButton;
    procedure btnFindClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure edtPathExit(Sender: TObject);
    procedure edtMaskExit(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  StopFind: boolean;

implementation

{$R *.DFM}

uses inifiles;

const
  IniName = 'c:\temp\myini.ini';

// Enumerating files in a subtree
procedure GetFiles(FromDir, Mask: String; IncludeSubdirs : boolean; List: TListBox);
var
 DirInfo: TSearchRec;
 R, i: Integer;
 DirList: TStringList;
begin
 // Fill SubDirs list
 if FromDir[Length(FromDir)] <> '\' then FromDir := FromDir + '\';
 DirList := TStringList.Create;
 try
  if IncludeSubdirs then begin
   R := FindFirst(FromDir + '*.*', faDirectory, DirInfo);
   if R = 0 then begin
    repeat
     if (DirInfo.Name <> '.') and (DirInfo.Name <> '..') then begin
       DirList.Add(FromDir + DirInfo.Name);
     end;
     R := FindNext(DirInfo);
    until R <> 0;
    FindClose(DirInfo);
   end;
  end;
 // Add files from the current dir
  R := FindFirst(FromDir + Mask, faAnyfile, DirInfo);
  if R = 0 then begin
   repeat
     if (DirInfo.Name <> '.') and (DirInfo.Name <> '..') then begin
       if (((DirInfo.Attr and faDirectory) <> 0) and IncludeSubdirs) then GetFiles(FromDir + DirInfo.Name + '\', Mask, IncludeSubdirs, List)
         else List.Items.Add(FromDir + DirInfo.Name);
     end;
     R := FindNext(DirInfo);
   until R <> 0;
   FindClose(DirInfo);
  end;
  // Call it recursively
  Application.ProcessMessages;
  if not StopFind then begin
    if IncludeSubdirs then begin
      for i := 0 to DirList.Count - 1 do begin
        GetFiles(DirList[i], Mask, IncludeSubdirs, List);
      end;
    end;
  end;
 finally
   DirList.Free;
 end;
end;

function SplitStr(Var AString : String; ADelim : String) : String;
var APos : Integer;
begin
 Result := '';
 APos := Pos(ADelim,AString);
 if APos > 0 then begin
   Result := Copy(AString,1,APos-1);
   AString := copy(Astring,APos+length(Adelim),MaxLongInt);
 end else begin
   Result := AString;
   AString := '';
 end;
end;

procedure TForm1.btnFindClick(Sender: TObject);
var
  s, Mask: string;
begin
  StopFind := false;
  Screen.Cursor := crAppStart;
  lbFiles.Items.Clear;
  s := edtMask.Text;
  while s <> '' do begin
    Mask := SplitStr(s,';');
    GetFiles(edtPath.Text,Mask,cbSubdirs.Checked,lbFiles);
  end;
  // remove the next line if you want to stop with current search results (not to cancel)
  if StopFind then lbFiles.Items.Clear;
  // end remove
  Screen.Cursor := crDefault;
end;

procedure TForm1.btnDeleteClick(Sender: TObject);
var
  i: integer;
begin
  for i := 0 to lbFiles.Items.Count - 1 do begin
    DeleteFile(lbFiles.Items[i]);
  end;
  lbFiles.Items.Clear;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
   Sec : String;
begin
 with TIniFile.Create(IniName) do begin
  try
   Sec := 'edit';
   edtPath.text := ReadString(Sec, 'path','');
   edtMask.text := ReadString(Sec, 'mask','');
  finally
   Free;
  end;
 end;
end;

procedure TForm1.edtPathExit(Sender: TObject);
var
   Sec, Key, Value : String;
begin
  with TIniFile.Create(IniName) do begin
  try
   Sec := 'edit';
   Key := 'path';
   Value := edtPath.Text;
   WriteString(Sec,Key,Value);
  finally
   Free;
  end;
 end;
end;

procedure TForm1.edtMaskExit(Sender: TObject);
var
   Sec, Key, Value : String;
begin
  with TIniFile.Create(IniName) do begin
  try
   Sec := 'edit';
   Key := 'mask';
   Value := edtMask.Text;
   WriteString(Sec,Key,Value);
  finally
   Free;
  end;
 end;
end;

procedure TForm1.btnStopClick(Sender: TObject);
begin
  StopFind := true;
end;

end.
-------

Regards, Geo
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 6
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now