L'auteur
FoxInCloud (Th. Nivelet)
 France
Membre Simple
# 0000000014
enregistré le 13/10/2004
http://www.foxincloud.com/
Nivelet Thierry
75016 Paris
de la société Abaque
 Fiche personnelle
 Note des membres
pas de note
|
Contributions > 01 - PRG : Programmation
FilesProc() - Applique une procédure à tous les | des fichiers d'un dossier [et ses sous-dossiers]
# 0000000019
ajouté le 21/10/2004 09:55:00 et modifié le 21/10/2004
consulté 10329 fois
Niveau
initié
|
| Description |
|---|
FilesProc() peut être utilisée pour :
- Sauvegarde, synchronisation de dossiers
- Recherche / remplacement de texte dans tous les fichiers (renommage de procédure par exemple avec VFP<8)
- Renommage de fichiers en masse
- etc.
L'action sera réalisée par la procédure mentionnée comme 2è paramètre
FilesProc() illustre plusieurs particularités de VFP :
- les messages de déboguage ASSERT actifs 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 des paramètres de 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 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 sous-dossiers]
/!\ cette fonction nécessite des fonctions postées par ailleurs :
- asubFolders()
- aAppend() |
| Code source : |
|---|
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"
* -----------
PROCEDURE FilesProc_Test_Proc && Procédure appelée par FilesProc_Test()
LPARAMETERS ;
tcFile,;
tuParm
* Affiche l'adresse du fichier et le paramètre
? m.tcFile + Space(2) + 'paramètre : ' + Transform(m.tuParm)
|
| Commentaires |
|---|
Aucun commentaire enregistré ...
|
|
|
Retour à la liste