Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Program that?s remove specified files from hd

Posted on 2001-06-26
9
Medium Priority
?
139 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
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 1200 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

Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

Question has a verified solution.

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

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
In response to a need for security and privacy, and to continue fostering an environment members can turn to for support, solutions, and education, Experts Exchange has created anonymous question capabilities. This new feature is available to our Pr…
We’ve all felt that sense of false security before—locking down external access to a database or component and feeling like we’ve done all we need to do to secure company data. But that feeling is fleeting. Attacks these days can happen in many w…
Suggested Courses

715 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