Solved

Program that?s remove specified files from hd

Posted on 2001-06-26
9
129 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
 
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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
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

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
It is a freely distributed piece of software for such tasks as photo retouching, image composition and image authoring. It works on many operating systems, in many languages.
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

743 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

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now