lisp2arx
Visual Programming for AutoLisp Mathématiques en programmation Lisp.. doc2cpp,doc2lsp, sld2lsp, bmp2dcl, free__GifCcapture for all-CAD'platforms..
Lista Forumurilor Pe Tematici
lisp2arx | Reguli | Inregistrare | Login

POZE LISP2ARX

Nu sunteti logat.
Nou pe simpatie:
Crina.candy pe Simpatie.ro
Femeie
22 ani
Harghita
cauta Barbat
24 - 44 ani
lisp2arx / Delphi , InnoPascal / Delphi32- Directory GetFiles from all subfolders  
Autor
Mesaj Pagini: 1
zauchan
Moderator

Inregistrat: acum 13 ani
Postari: 180
Unit
Interface
Uses sysutils,windows,ShellAPI,classes;

Code:

const  RTNORM    =5100;
const  RTERROR     =    (-5001);
const  RTCAN       =    (-5002);
const  RTREJ       =    (-5003);
const  RTFAIL      =     (-5004);
const  RTKWORD     =     (-5005);
const  RTINPUTTRUNCATED =(-5008);

Var udm_free:record agent:string;  //rem: folder remove directory
                    files:string;  //store here all dir+names
                    count:integer;
                    res_field:boolean;  //true = numar si cuantifics
              end;
Procedure Test;
Function  Vl_directory_files(const trackpath:string;wcmatch:string;addfolder:TLeadBytes;
var rendertargeT:TstringList):integer;
Implementation
Procedure Test;
Var toot:TStringList;
Begin
      udm_free.agent:='\0user\==\bin\';
      udm_free.res_field:=false;  //rem: not index prefix numbers
      if (vl_directory_files('c:\windows','*.dll',[],toot)<1) then exit;
      toot:=TStringList.Create;
      toot.clear;
      toot.SetText(pchar(udm_free.files));
      udm_free.files:='';
      toot.SaveToFile('c:\vlaxcompil\bin\codstree.ini');
      toolt.free;
End;//</Tesst Final>

Code:

Procedure FindFiles(Var FilesList: TStringList;const StartDir, FileMask: string);
var
  SR: sysutils.TSearchRec;
  DirList: TStringList;
  IsFound,fRemoveDirItself: Boolean;
  i: integer;
Label PickBoxSize;
begin
  { Build a list of the files in directory StartDir
     (not the directories!)                         }
  IsFound :=  FindFirst(StartDir+FileMask, faAnyFile-faDirectory, SR) = 0;
    if (isFound=false) then goto PickBoxSize;
  repeat   if (udm_free.res_field) and (udm_free.count<1) then begin  udm_free.files:=concat('00=',StartDir,SR.Name,#13#10);udm_free.count:=0;end else
           if (udm_free.res_field) and (udm_free.count>=1) then udm_free.files:=concat(udm_free.files,inttostr(udm_free.count),'=',StartDir,SR.Name,#13#10) else
             udm_free.files:=concat(udm_free.files,StartDir,SR.Name,#13#10);
           inc(udm_free.count);
           IsFound := FindNext(SR) = 0;
   until (not IsFound);
PickBoxSize:
  vl_FindClose(Sr);
  // Build a list of subdirectories
  DirList := TStringList.Create;
  IsFound := FindFirst(StartDir+'*.*', faAnyFile, SR) = 0;
  while IsFound do begin
    if ((SR.Attr and faDirectory) <> 0) and
         (SR.Name[1] <> '.')
      then Begin  if (length(udm_free.agent)>2)and(pos(lowercase(SR.Name),udm_free.agent)<1) then DirList.Add(StartDir + lowercase(SR.Name)) else
                    if (length(udm_free.agent)<3) then DirList.Add(StartDir + lowercase(SR.Name));
           End;
    IsFound := FindNext(SR) = 0;
  end;
  vl_FindClose(Sr);
  // Scan the list of subdirectories
  for i := 0 to DirList.Count - 1 do
    FindFiles(FilesList, DirList[i]+'\', FileMask);
  DirList.Free;
end;

//rem------------(Please you make a doantion/Paypal.com "https://goo.gl/uVmmQu"

Code:

Function  Vl_directory_files(const trackpath:string;wcmatch:string;addfolder:TLeadBytes;var rendertargeT:TstringList):integer;
Var dgnrepath:string;
begin result:=RTCAN;
      udm_free.count:=0;
      dgnrepath:=trIm(trackpath);
      if (length(dgnrepath)<3) then exit;
      if (dgnrepath[length(dgnrepath)]<>'\') then dgnrepath:=concat(dgnrepath,'\');
      wcmatch:=trim(wcmatch);
      if (wcmatch='') then wcmatch:='*.*';
      if (rendertargeT=nil) then rendertargeT:=TStringList.Create;
      FindFiles(rendertargeT,lowercase(trim(trackpath)),wcmatch);
      result:=if_int(udm_free.count<1,RTFAIL,RTNORM);
end;{--}

//rem=Colindul „Galbenă gutuie” – Corul bărbătesc Cantus Domini
Initialization
       udm_free.agent:='';
       udm_free.files:='';
       udm_free.count:=0;
       udm_free.res_field:=false;

Finalization
       udm_free.files:='';
End.

Modificat de zauchan (acum 3 ani)


_______________________________________
psw: cea de la wjndowsXP gigabyte..

pus acum 3 ani
   
Pagini: 1  

Mergi la