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"
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.