Solved

Program that?s remove specified files from hd

Posted on 2001-06-26
9
132 Views
Last Modified: 2010-04-06
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
Comment
Question by:Dark_King
  • 6
  • 2
9 Comments
 
LVL 6

Author Comment

by:Dark_King
ID: 6230193
I have try to set the point to more but it don?t work
0
 
LVL 6

Author Comment

by:Dark_King
ID: 6230706
:)
0
 
LVL 17

Expert Comment

by:geobul
ID: 6230816
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
Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
LVL 6

Author Comment

by:Dark_King
ID: 6231006
It work great. Point near for you.
But is it possible to get a Cancel button for "btnFindClick"
0
 
LVL 6

Author Comment

by:Dark_King
ID: 6231008
It work great. Point near for you.
But is it possible to get a Cancel button for "btnFindClick"
0
 
LVL 6

Author Comment

by:Dark_King
ID: 6231197
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
 
LVL 44

Expert Comment

by:CrazyOne
ID: 6231445
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
 
LVL 6

Author Comment

by:Dark_King
ID: 6231490
Tanks for that CrazyOne.

(apostrophe's apostrophe's apostrophe's apostrophe's apostrophe's)
0
 
LVL 17

Accepted Solution

by:
geobul earned 300 total points
ID: 6231493
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

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…
With Secure Portal Encryption, the recipient is sent a link to their email address directing them to the email laundry delivery page. From there, the recipient will be required to enter a user name and password to enter the page. Once the recipient …

808 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question