asked on

I need a little help with my application...

Hello,

I need a little help ASAP with my project... I have an application that will search for all the MP3 files on the computer (searching for *.mp3)... Well, actually, this is the problem, I am using a component for the search (DIFileFinder) and the component will only let you search in a directory, I need to do the following, after the search on the C:\ drives ends to search the other drives, but first I need to detect the local drives on the computer (I need to do that because if the component doesn't find the search dir it won't give an error or do nothing). Also my application is designed not to let you close the app until the search finishes. It doesn't matter if you know a better solution for this (to search all the computer for mp3 files using wildcards) or if you could help me with my code, but I will be very thankfull if you could help me. Below is the relevant code in my app:

THIS IS THE CODE FOR THE CLOSING OF THE FORM (the Complete = 0 will change to 1 when the search is finished.)
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Complete = 0 then
begin
Action := caNone;
MessageBox(handle,'Please wait for the search to finish', 'Wait!', MB_OK or MB_ICONERROR);
end else Action := caFree;
end;

THIS IS THE CODE FOR THE SEARCH:
procedure TMainForm.ThreadExecute(Sender: TObject);
begin
Complet := 0;
while SearchEngine.Next and not SearchEngine.Abort do begin
FIles.Lines.Add(SearchEngine.FullName);
end;
ShowMessage('We found '+IntToStr(Fisiere.Lines.Count)+' MP3 files..'+#10#13#10#13+'Click Ok to continue.');
Complete := 1;
Sound.Play;
end;

Here I need the following, after the search is done instead of showing the message (ShowMessage command) if another local drive exists to search that one also, and only then show the message.

PS: I found this code for listing the local drives, so if it makes it easyer for you, you cloud use it: http://www.swissdelphicenter.ch/torry/showcode.php?id=562

Again, if you have a better solution for what I need that would be great also.

Thank you in advance for your help.

Geert G

i tend to build in a cancel on the search
and when closing a form, people aren't interested in the results any more,
so this should automatically trigger the cancel.

this check for cancel could done in the thread by checking the Terminated :

...
if not Terminated then
...

in the onClose you could to Thread.Terminate;

bandiarez

ASKER

You're right, good logical thinking... Thanks, but could you help me with the rest of the problem? Detecting the local drives and after one drive is searched, move to the next one...

Johnjces

Here is a function for getting all your drives. Put the result into a stringlist and then it should be pretty easy to use the list to iterate through all of your drives.

John

0 The drive type cannot be determined.
1 The root directory does not exist.
DRIVE_REMOVABLE The drive can be removed from the drive.
DRIVE_FIXED The disk cannot be removed from the drive. (Probably what you want)
DRIVE_REMOTE The drive is a remote (network) drive.
DRIVE_CDROM The drive is a CD-ROM drive.
DRIVE_RAMDISK The drive is a RAM disk.

function GetDrives: tStringlist;
var
  Drive    : char;
begin
 result := tStringlist.create;
 for Drive:='a' to 'z' do
  if GetDriveType(PChar(Drive+':\'))=DRIVE_FIXED then
    result.Add(Drive + ':/');
end;

Open in new window

Geert G

it's a little difficult with only that much code to help
you'll have to past a little more, for us to see where you are loading the search dir into the searchengine

Johnjces

Geert

Is your comment directed to me or the author?

John

Geert G

lol, john, the author :)

bandiarez

ASKER

For now I'm loading it in the component, not at runtime because there's no need to do that since I can't do what I want...

bandiarez

ASKER

The search engine is actually the component (DIFileFinder) but I've named it like that, and the code is ComponentName.SearchFolder = ... I guess it needs to change in the thread after the first drive is searched.

Like I said in my last project, Geert_Gruwez, because you've helped me then, I'm new to delphi but this is my style and I am learning this way.

With my thinking what I need to do is this: get the drives with the code above (or any other code to get the local drives), if another local drive other then C exist, put that list somewhere (in an array maybe) and then after the search finishes, instead of showing the message box take the other drive from the list, search for it, and do it like that with all the drives, and in the end display that message box showing how many mp3's were found (this part I got covered by getting the lines from the memo).

Geert G

i created a file finder for mp3:
without that component, and using threads ...
try it

unit uFindFiles;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;
 
type
  TCallbackProc = procedure (Sender: TObject; aMessage: string; aMessageInfo: Integer = 0) of object;
 
  TCallbackThread = class(TThread)
  private
    FCallBack: TCallbackProc;
    FCallbackMsg: string;
    FCallbackMsgInfo: integer;
    procedure SynchedCallback;
  protected
    procedure DoCallback(aMsg: string; aMsgInfo: integer = 0); virtual;
    property Callback: TCallbackProc read FCallback;
  public
    constructor Create(aCallback: TCallbackProc; CreateSuspended: Boolean = False); reintroduce; virtual;
  end;
 
  TFindFileThread = class(TCallbackThread)
  private
    fDir: string;
    fFileList: TStringList;
    procedure FindMatchingFiles(PathName: string);
  protected
    procedure Execute; override;
  public
    constructor Create(aCallback: TCallbackProc; CreateSuspended: Boolean = False); override;
    destructor Destroy; override;
  end;
 
type
  TForm1 = class(TForm)
    btnAddDir: TButton;
    lbDirs: TListBox;
    pnlThreads: TPanel;
    lbResults: TListBox;
    btnStartThreads: TButton;
    Memo1: TMemo;
    procedure btnAddDirClick(Sender: TObject);
    procedure btnStartThreadsClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    fThreadCount: Integer;
    procedure StartThread(aDir: string);
    procedure threadCallback(Sender: TObject; aMessage: string; aMessageInfo: Integer = 0);
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
{ TCallbackThread }
 
constructor TCallbackThread.Create(aCallback: TCallbackProc; CreateSuspended: Boolean = False);
begin
  inherited Create(CreateSuspended);
  FreeOnTerminate := True;
  FCallback := aCallback;
end;
 
procedure TCallbackThread.DoCallback(aMsg: string; aMsgInfo: Integer = 0);
begin
  FCallbackMsg := aMsg;
  FCallbackMsgInfo := aMsgInfo;
  Synchronize(SynchedCallback);
end;
 
procedure TCallbackThread.SynchedCallback;
begin
  if Assigned(FCallback) then
    FCallBack(Self, FCallbackMsg, FCallbackMsgInfo);
end;
 
{ TFindFileThread }
 
constructor TFindFileThread.Create(aCallback: TCallbackProc;
  CreateSuspended: Boolean);
begin
  inherited Create(aCallback, CreateSuspended);
  fFileList := TStringList.Create;
end;
 
destructor TFindFileThread.Destroy;
begin
  FreeAndNil(fFileList);
  inherited Destroy;
end;
 
procedure TFindFileThread.Execute;
begin
  DoCallback(Format('%s=started', [fDir]), 10);
  FindMatchingFiles(IncludeTrailingPathDelimiter(fDir));
  DoCallback(Format('%s=found %d', [fDir,fFileList.Count]), 100);
end;
 
procedure TFindFileThread.FindMatchingFiles(PathName: string);
var
  SearchRec: TSearchRec;
  procedure CheckFile(aFileName: string);
  var xFileName: string;
  begin
    xFileName := ExtractFileName(aFileName);
    if (xFileName[1] <> '.') then
    begin
      if SearchRec.Attr and faDirectory <> 0 then
        FindMatchingFiles(IncludeTrailingPathDelimiter(aFileName))
      else if SameText(ExtractFileExt(xFileName), '.mp3') then
        fFileList.Add(aFileName);
    end;
  end;
begin
  if FindFirst(PathName + '*.*', faAnyFile, SearchRec) = 0 then
  try
    CheckFile(PathName + SearchRec.Name);
    while FindNext(SearchRec) = 0 do
    begin
      CheckFile(PathName + SearchRec.Name);
      if fFileList.Count mod 20 = 0 then
        DoCallback(Format('%s=found %d', [fDir,fFileList.Count]), 20);
    end;
  finally
    FindClose(SearchRec);
  end;
end;
 
procedure TForm1.btnAddDirClick(Sender: TObject);
var Dir: string;
begin
  Dir := '';
  if InputQuery('MP3 Base dir', 'Enter a directory to search', Dir) then
    if DirectoryExists(Dir) then
      lbDirs.AddItem(Dir, TObject(1));
end;
 
procedure TForm1.btnStartThreadsClick(Sender: TObject);
var I: Integer;
begin
  for I := 0 to lbDirs.Count - 1 do
    if Integer(lbDirs.Items.Objects[I]) = 1 then
      StartThread(lbDirs.Items[I]);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  fThreadCount := 0;
end;
 
procedure TForm1.StartThread(aDir: string);
begin
  with TFindFileThread.Create(threadCallback, True) do
  begin
    fDir := aDir;
    Resume;
  end;
end;
 
procedure TForm1.threadCallback(Sender: TObject; aMessage: string; aMessageInfo: Integer);
var aName, aValue: string;
begin
  aName := Copy(aMessage, 1, Pos('=', aMessage)-1);
  aValue := Copy(aMessage, Length(aName)+1, Length(aName));
  Memo1.Lines.Values[aName] := aValue;
  case aMessageInfo of
    10: Inc(fThreadCount);
    100:
    begin
      Dec(fThreadCount);
      lbResults.Items.AddStrings(TFindFileThread(Sender).fFileList);
    end;
  end;
  pnlThreads.Caption := Format('Threads running = %d ', [fThreadCount]);
end;
 
end.
 
 
--- dfm ---
 
object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 463
  ClientWidth = 610
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object btnAddDir: TButton
    Left = 40
    Top = 32
    Width = 75
    Height = 25
    Caption = 'btnAddDir'
    TabOrder = 0
    OnClick = btnAddDirClick
  end
  object lbDirs: TListBox
    Left = 40
    Top = 64
    Width = 185
    Height = 121
    ItemHeight = 13
    TabOrder = 1
  end
  object pnlThreads: TPanel
    Left = 256
    Top = 16
    Width = 209
    Height = 33
    TabOrder = 2
  end
  object lbResults: TListBox
    Left = 40
    Top = 200
    Width = 529
    Height = 161
    ItemHeight = 13
    TabOrder = 3
  end
  object btnStartThreads: TButton
    Left = 144
    Top = 32
    Width = 75
    Height = 25
    Caption = 'Start Threads'
    TabOrder = 4
    OnClick = btnStartThreadsClick
  end
  object Memo1: TMemo
    Left = 248
    Top = 64
    Width = 321
    Height = 129
    Lines.Strings = (
      'Memo1')
    TabOrder = 5
  end
end

Open in new window

bandiarez

ASKER

Hello,
Thank you for the code, it's just what I needed, but I have one little problem, when I search a dir like c:\music\ it works fine, but when I search a whole drive, like c:\ I get this "C:\==fo" instead of "c"\==found 0" and nothing is shown... Could you please check the code and fix it? I will choose your answer after that because you came trough for me once again. Thanks.

philipjc

This has to win my favorite transaction of the year

Phil

ASKER CERTIFIED SOLUTION

Geert G

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial