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

Commenter

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

S'inscrire maintenant

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.

Du même auteur (AbaqueInside)