Solved

Program that?s remove specified files from hd

Posted on 2001-06-26
9
136 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
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!

 
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

Enroll in July's Course of the Month

July's Course of the Month is now available! Enroll to learn HTML5 and prepare for certification. It's free for Premium Members, Team Accounts, and Qualified Experts.

Question has a verified solution.

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

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 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…
There's a multitude of different network monitoring solutions out there, and you're probably wondering what makes NetCrunch so special. It's completely agentless, but does let you create an agent, if you desire. It offers powerful scalability …
Michael from AdRem Software outlines event notifications and Automatic Corrective Actions in network monitoring. Automatic Corrective Actions are scripts, which can automatically run upon discovery of a certain undesirable condition in your network.…
Suggested Courses
Course of the Month10 days, 4 hours left to enroll

624 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