Filesproc() && applique une procédure à tous les fichiers d'un dossier [et de ses sous-dossiers]

Soyez le premier à donner votre avis sur cette source.

Snippet vu 4 766 fois - Téléchargée 31 fois

Contenu du snippet

FilesProc() illustre plusieurs particularités de VFP :
- les messages de déboguage ASSERT acitfs seulement si SET ASSERTS ON
- la récursion (ici dans les sous-dossiers d'un dossier)
- grâce au typage souple des variables, la possibilité de passer n'importe quel type à une procédure
- la fonction aDir() permettant de trouver le contenu d'un dossier avec un masque de fichiers
- le passage de paramètre par référence avec la balise @
- la tabulation du contenu d'une liste délimitée au moyen de la fonction aLines()
- le comptage du nombre de paramètres effectivement passés au moyen de la fonction Pcount()
- la programmation dynamique au moyen de la fonction Evaluate()

Le code comporte une procédure de test FilesProc_Test qui affiche simplement les fichiers .xls contenus dans un dossier [et ses sou-dossiers]

/!\ cette fonction nécessite des fonctions postées par ailleurs :
- asubFolders()
- aAppend()

Source / Exemple :


PROCEDURE FilesProc && Applique une procédure à tous les fichiers d'un dossier [et de ses sous-dossiers] ; jusqu'à 5 paramètres peuvent être passés à la procédure
	LPARAMETERS ;
		tcDir,; &&	Adresse du dossier où les fichiers sont à chercher
		tcProcName,; && Nom de la procédure à appliquer à chaque fichier trouvé
		tcFileMasks,; && [*.*] Masques de fichiers à traiter (séparés par virgule)
		tlSubDirs,; &&	[.F.] Chercher dans les sous-dossiers
		tcSubDirsExcl,;	&& [space(0)] Sous-dossiers à exclure de la recherche (séparés par virgule)
		tuProcParm1,; && [] 1er paramètre à passer à la procédure
		tuProcParm2,; && [] 2ème paramètre à passer à la procédure
		tuProcParm3,; && [] 3ème paramètre à passer à la procédure
		tuProcParm4,; && [] 4eme paramètre à passer à la procédure
		tuProcParm5 && [] 5ème paramètre à passer à la procédure

  • on pourrait passer jusqu'à 19 paramètres à la procédure ...
LOCAL lnResult && Nombre de fichiers traités m.lnResult = 0
  • Si les paramètres requis sont valides
LOCAL llParms m.llParms = Vartype(m.tcDir)=='C' ; AND Directory(m.tcDir) ; AND Vartype(m.tcProcName) == 'C' ; AND NOT Empty(m.tcProcName) && comment vérifier que la procédure est visible ? ASSERT m.llParms MESSAGE Program() + " - Invalid Required parameters" IF m.llParms LOCAL lcDir m.lcDir = Addbs(m.tcDir)
  • Assigner leurs valeurs par défaut aux paramètres optionnels
LOCAL lcFileMasks, llSubDirs, lcSubDirsExcl m.lcFileMasks = Iif(Vartype(m.tcFileMasks) == 'C', Alltrim(m.tcFileMasks), [*.*]) m.llSubDirs = Iif(Vartype(m.tlSubDirs) == 'L', m.tlSubDirs, .F.) m.lcSubDirsExcl = Iif(m.llSubDirs AND Vartype(m.tcSubDirsExcl)=='C', Upper(m.tcSubDirsExcl), Space(0))
  • Tabuler les fichiers situés dans le répertoire indiqué et répondant au(x) masque(s)
LOCAL lnMasks, lcMask, lnDocs LOCAL ARRAY laMasks[1], laDocs[1], laDocs1[1] m.lnMasks = ALines(m.laMasks, m.lcFileMasks, .T., VIRGULE) FOR EACH m.lcMask IN m.laMasks DIMENSION laDocs1[1] laDocs1[1] = .F. aDir(m.laDocs1, m.lcDir + m.lcMask) && pas de dossier m.lnDocs = aAppend(@m.laDocs, @m.laDocs1) ENDFOR Asort(m.laDocs, 1)
  • Si recherche dans les sous-dossiers demandée,
IF m.llSubDirs
  • Si sous-dossier(s) dans le dossier
LOCAL lnSubDirs LOCAL ARRAY laSubDirs[1] m.lnSubDirs = aSubFolders(@m.laSubDirs, m.lcDir) IF m.lnSubDirs > 0
  • Ajouter les sous-dossiers au tableau de documents
m.lnDocs = aAppend(@laDocs, @laSubDirs)
  • Tabuler les sous-dossiers à exclure éventuels
LOCAL lnDirsExcl LOCAL ARRAY laDirsExcl[1] m.lnDirsExcl = aLines(m.laDirsExcl, m.lcSubDirsExcl, .T., VIRGULE) ENDIF ENDIF
  • Si le dossier comporte des documents
IF m.lnDocs > 0
  • Préparer la chaine de paramètres à passer à la procédure
LOCAL lnProcParms, lcProcParms, lnProcParm m.lnProcParms = Pcount() - 5 && les paramètres commencent en 6è position m.lcProcParms = Space(0) IF m.lnProcParms > 0 FOR m.lnProcParm = 1 TO m.lnProcParms m.lcProcParms = m.lcProcParms + VIRGULE + 'm.tuProcParm' + Transform(m.lnProcParm) ENDFOR ENDIF
  • Pour chaque "document" (fichier ou sous-dossier)
LOCAL lnDoc, lcDoc, lcDocAdr, llDoc FOR m.lnDoc = 1 to m.lnDocs m.lcDoc = laDocs[m.lnDoc, 1] m.lcDocAdr = m.lcDir + m.lcDoc
  • Si dossier exploitable, récurser le cas échéant
IF 'D' $ Upper(laDocs[m.lnDoc, 5]) IF m.llSubDirs ; AND ! InList(m.lcDoc, '.', '..') ; AND (m.lnDirsExcl = 0 OR Ascan(laDirsExcl, Upper(m.lcDoc)) = 0) m.lnResult = m.lnResult + ; && pour récursion Evaluate('FilesProc (m.lcDocAdr, m.tcProcName, m.lcFileMasks, m.llSubDirs, m.lcSubDirsExcl' + ; m.lcProcParms + ")") ENDIF
  • Sinon (fichier), appliquer la procédure indiquée
ELSE m.llDoc = Evaluate(m.tcProcName + [("] + m.lcDocAdr + ["] + m.lcProcParms + ")") m.lnResult = m.lnResult + Iif(m.llDoc, 1, 0) ENDIF ENDFOR ENDIF ENDIF RETURN m.lnResult
  • -------------------------------
PROCEDURE FilesProc_Test && Teste FilesProc ? Sys(16) LOCAL lnFiles m.lnFiles = FilesProc(GetDir(Curdir(),'',"Où sont les fichiers Excel à traiter ?", 16), ; 'FilesProc_Test_Proc', '*.xls',.T., '', Date()) ? Transform(m.lnFiles) + " Fichiers traités"

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.