Solved

This is easy

Posted on 1998-03-30
5
241 Views
Last Modified: 2010-04-06
Is there any built in functions that can return me the number of files found (Including sub directories) when i pass in a directory path. I just want the number of files found not including the directories

If there isn't can anyone show me how to do this??

Thanks in Advance,
Ermac
0
Comment
Question by:ermac
5 Comments
 

Expert Comment

by:Dippen
ID: 1361049
Use the FindFirst and the FindNext functions for that problem. This function would do the job (written in D3):

function TForm1.CountFiles(Path : shortstring) : Integer;
var
  SearchResult : TSearchRec;
  ErrorCode,
  LocalResult : Integer;

begin
  Result := 0;
  LocalResult := 0;
  ErrorCode := FindFirst(path+'\*.*',faDirectory,SearchResult);
  while (ErrorCode = 0) do begin
    Inc(LocalResult);
    ErrorCode := FindNext(SearchResult);
  end;
  result := LocalResult;
end;
 

//Daniel, Sweden
0
 

Author Comment

by:ermac
ID: 1361050
Hi Dippen

You solution doesn't check for sub directories...
I need to count the number of files in the sub directories as well

Probably have to use some recursion...

Ermac
0
 
LVL 5

Expert Comment

by:julio011597
ID: 1361051
Then you need a CountFiles(), as written by Dippen, incapsulated in a tree traversal algorithm - do you need some code, or a plain-english algorithm description?
0
 
LVL 1

Expert Comment

by:lowlevel
ID: 1361052
you'll have to modify this a bit, but I think this should do it.

var
  count          : record
    filesize       : cardinal;
    realsize       : cardinal;
    num            : cardinal;
    attrOccur      : array[tAttr] of cardinal;
  end;

procedure getAFileSpec (startpath,filespec : string);
var
  sr        : tSearchRec;
  finished  : integer;
  goSub     : boolean;
begin
//first get all files/dirs matching the file-spec and process them.
//if the user wants fDoFSSubs, that's done here too...
  finished:=findFirst (startPath+filespec, faAnyFile, sr);
  while finished=0 do begin
    doThing (startpath,sr);
    if (fDoFSSubs in todolist) and      //do we even want this?
       (sr.attr and faDirectory >0) and  //err, is this a directory?
       (sr.name[1]<>'.')                 //not the . and .. dir's, please
      then getAFileSpec (startPath+sr.name+'\', fileSpec);
    finished:=findNext (sr);
  end;
  if fDoDebug in todolist then writeln ('Err: ',finished);
  findClose (sr);

//need to do process ALL sub-dirs?
  if (fDoAllSubs in toDoList) {and (filespec<>'*.*')} then begin
    finished:=findFirst (startPath+'*.*', faDirectory, sr);
    while finished=0 do begin
      if (sr.name<>'.') and (sr.name<>'..')
        then getAFileSpec (startPath+sr.name+'\', filespec);
      finished:=findNext (sr);
    end;
    if fDoDebug in todolist then writeln ('Err2: ',finished);
    findClose (sr);
  end;
end;

procedure doThing (startpath : string; sr : tSearchRec);
  procedure doCount;
  var
    size: cardinal;
    i    : tAttr;
  begin
    if sr.Size<HDDClustSize
      then size:=HDDClustSize
      else size:=sr.size;
    inc (count.filesize, sr.size);
    inc (count.realsize, size);
    inc (count.num);
  //keep track of what attributes occur how often
    for i:=low (tAttr) to high(tAttr) do begin
      if ((sr.attr and ord(attrVal[i])) > 0) then inc (count.attrOccur[i])
    end;
  end;

  procedure doDelSubStr;
  var
    strToDel : string;
    newName  : string;
    foundAt,
    l,
    i        : integer;
  begin
  //get the full string to delete first.
    for i:=1 to 9 do
      if paramstr(i)=stuffItCanDo[fDelSubStr].str then break;
    strToDel:=paramstR(i+1);

    if (strToDel[1]='-') then begin
      writeln ('ERROR [during deleting] : parameters are wrong!');
      exit;
    end;

  //modify name
    newName:=sr.name;
    foundAt:=instring (newName,strToDel,false, 0);
    while foundAt<>0 do begin
      delete (newName, foundAt, length (strToDel));
      foundAt:=instring (newName,strToDel,false, 0);
    end;
    if sr.name<>newname then
      if not renameFile (startPath+sr.name, startPath+newname) then debug ('Err: could not rename file');
  end;

  procedure doRepSubStr;
  var
    strToDel : string;
    strToRep : string;
    newName  : string;
    foundAt,
    l,
    i        : integer;
  begin
  //get the parameters
    for i:=1 to 9 do
      if paramstr(i)=stuffItCanDo[fRepSubStr].str then break;
    strToDel:=paramstR(i+1);
    strToRep:=paramstr(i+2);

    if (length(strToDel)<1) or (length(strToRep)<1) then begin
      writeln ('ERROR [during replacing] : parameters are wrong!');
      exit;
    end else
      if (strToDel[1]='-') or (strToRep[1]='-') then begin
        writeln ('ERROR [during replacing] : parameters are wrong!');
        exit;
      end;

  //modify name
    newName:=sr.name;
    foundAt:=instring (newName,strToDel,false, 0);
    while foundAt<>0 do begin
      delete (newName, foundAt, length (strToDel));
      insert (strToRep, newName, foundAt);
      foundAt:=instring (newName,strToDel,false, 0);
    end;
    if sr.name<>newname then
      if not renameFile (startPath+sr.name, startPath+newname) then debug ('Err: could not rename file');
  end;

begin
  if (sr.name='.') or (sr.name='..') then exit;
//counting
  if fCount in todolist then doCount;
//deleting sub-strings from filenames
  if fDelSubStr in todolist then doDelSubStr;
  if fRepSubStr in todolist then doRepSubStr;

//test
  if fDoDebug in todolist then
    if ((sr.attr and faDirectory)>0)
      then writeln ('dir : '+startPath+sr.name)
      else writeln ('file: '+startPath+sr.name);
end;

0
 
LVL 3

Accepted Solution

by:
williams2 earned 20 total points
ID: 1361053
ok, this one does the work!

function TForm1.CountFiles(Path : string) : Integer;
var
  SearchResult : TSearchRec;
  ErrorCode,
  LocalResult : Integer;
begin
  Result:= 0;
  LocalResult := 0;
  ErrorCode := FindFirst(path+'\*.*',faAnyFile,SearchResult);
  while (ErrorCode = 0) do
  begin
    If (SearchResult.Name<>'.') AND (SearchResult.Name<>'..') then
    Begin
      If (SearchResult.Attr AND faDirectory)>0 then
        Inc(LocalResult,CountFiles(Path+'\'+SearchResult.Name))
      else
        Inc(LocalResult);
    End;
    ErrorCode := FindNext(SearchResult);
  end;
  result := LocalResult;
end;

Regards
Williams
0

Featured Post

Live: Real-Time Solutions, Start Here

Receive instant 1:1 support from technology experts, using our real-time conversation and whiteboard interface. Your first 5 minutes are always free.

Question has a verified solution.

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

Suggested Solutions

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
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…
This video shows how to use Hyena, from SystemTools Software, to bulk import 100 user accounts from an external text file. View in 1080p for best video quality.
A short tutorial showing how to set up an email signature in Outlook on the Web (previously known as OWA). For free email signatures designs, visit https://www.mail-signatures.com/articles/signature-templates/?sts=6651 If you want to manage em…

785 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