Accueil > > > FILESPROC() && APPLIQUE UNE PROCÉDURE À TOUS LES FICHIERS D'UN DOSSIER [ET DE SES SOUS-DOSSIERS]
FILESPROC() && APPLIQUE UNE PROCÉDURE À TOUS LES FICHIERS D'UN DOSSIER [ET DE SES SOUS-DOSSIERS]
Information sur la source
Description
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
- 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 && 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"
Sources du même auteur
Sources de la même categorie
Commentaires et avis
Discussions en rapport avec ce code source dans le forum
Gestion multifichiers [ par gh57 ]
Quel est la commande qui permets d'effectuer une mise à jour d'un fichier(dbf) avec celui d'un autre.J'ai essayé la commande :UPDATE ON cham
fichiers necessaires au vfpoledb ? [ par lijohann ]
bonjour,j'ai une appli sous excel qui utilise le vfpoledb pour accéder à mes donées.Mon probleme est que des utilisateurs doivent
Gestion d'objet [ par spoutnic_37 ]
Salutation, Mon probleme est le suivant : comment faire un ensemble de formulaire grace à visual foxpro 6, et gérer les
Application de gestion d'une caisse de bar [ par CaromTom ]
Bonjour,Je cherche à fabriquer une caisse de bar (édition de ticket,gestion de stock) avec VFP.Avez-vous des conseils ou des sources qui pou
Vérification des fichiers en format .dbf [ par devham ]
salut, je developpe en VB.net , mais cette fois je suis obligé à faire une appliquation en VFP, l'objectif de cette appliquation c'est de ve
fichiers d'installation [ par info_maroc ]
Bonjour1 - j'ai developpe une application sous visual foxpro 9 et je veux creer les fichiers d'installation, j'ai pas sur le menu de foxpro un moyen p
creer fichiers installation [ par info_maroc ]
bonjour j'ai besoin de la procedure de generation des fichiers installation d'une application developpée par visual foxpro 9Merci
Manipulation de fichier texte [ par rr_style ]
Salut a tous Moi j'ai un serieux problème avec FoxPro j'ai développé une interface qui converti des données d'un logiciel vers un autre. grace à l
gestion melti utilsateur [ par bsmsadok ]
<img style="BORDER-LEFT-COLOR: black; BORDER-BOTTOM-COLOR: black; BORDER-TOP-COLOR: black; BORDER-RIGHT-COLOR: black; border-size: 1px" src="http://ww
Difference entre foxpro et visual foxpro [ par ducker88 ]
>Bonjour à tous,Voila deux ans que je travaille sur foxpro (tant bien que mal...) et j'apprend aujourd'hui qu'il est possible que la base ai été mi
|
Derniers Blogs
TECHDAYS PARIS 2010 : LES SERVICES D'APPLICATIONS DANS SHAREPOINT 2010TECHDAYS PARIS 2010 : LES SERVICES D'APPLICATIONS DANS SHAREPOINT 2010 par ROMELARD Fabrice
Animé par: Xavier Moreels et Julien Bakmezdjian Ce sujet est lié au partage des applications comme services dans SharePoint 2010, ceci représente la possibilité de créer sa propre application qui sera utilisable comme ceux en standard : Search...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice TECHDAYS PARIS 2010 : LA GED ET SHAREPOINT 2010TECHDAYS PARIS 2010 : LA GED ET SHAREPOINT 2010 par ROMELARD Fabrice
Animé par: Etienne Lacour Cette session a commencé par un rappel de la gestion de contenu et surtout une résumé des points ayant été amélioré avec 2010. Accompagné d'un point sur le cycle de vie des documents. Un rappel du fonctionnement de S...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice TECHDAYS PARIS 2010 : SHAREPOINT 2010 ET LES RéSEAUX SOCIAUXTECHDAYS PARIS 2010 : SHAREPOINT 2010 ET LES RéSEAUX SOCIAUX par ROMELARD Fabrice
Animé par: Olivier Lepeltier et Karim Manar Cette session commence par la présentation du concept de réseau social, mais surtout de la particularité de du réseau social dans une entreprise. La vision du réseau social est donc une extension du MyS...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice TECHDAYS PARIS 2010 : SHAREPOINT 2010 - DESCRIPTION ET NOUVEAUTéSTECHDAYS PARIS 2010 : SHAREPOINT 2010 - DESCRIPTION ET NOUVEAUTéS par ROMELARD Fabrice
Animé par: Karim Manar et Laurent Beaudouin Cette session a pour but de revenir sur ce qu'est SharePoint globalement, mais aussi de voir les évolutions liées avec l'avènement de la version 2010. A partir de la marguerite de...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice TECHDAYS PARIS 2010 : PLEINIèRE LUNDITECHDAYS PARIS 2010 : PLEINIèRE LUNDI par ROMELARD Fabrice
Comme chaque année, c'est le grand rassemblement autour des technologies Microsoft qui se déroule donc à Paris au Palais des Congrès. Cette année est riche pour Microsoft en terme de livraison produit, paris l...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice
Logiciels
DB-MAIN (9.1.0)DB-MAIN (9.1.0)DB-MAIN is a data-modeling and data-architecture tool. It is designed to help developers and anal... Cliquez pour télécharger DB-MAIN Xilisoft DPG Convertisseur (5.1.37.0120)XILISOFT DPG CONVERTISSEUR (5.1.37.0120)Xilisoft DPG Convertisseur offre aux fans de Nintendo DS une bonne solution leur permettant de dé... Cliquez pour télécharger Xilisoft DPG Convertisseur GraphicsGale (2.01.01)GRAPHICSGALE (2.01.01)GraphicsGale est un logiciel de PixelArt avec de nombreuse fonctionnalités permettant de réalisé ... Cliquez pour télécharger GraphicsGale Architecte 3D (Platinum 2010)ARCHITECTE 3D (PLATINUM 2010)Architecte 3D Platinium vous permet de concevoir facilement les plans votre future maison, de l'é... Cliquez pour télécharger Architecte 3D TeamViewer 5 (TeamViewer 5)TEAMVIEWER 5 (TEAMVIEWER 5)Dépanner un ami,expliquer une manipulation devient un jeu d'enfant.
Prise en main d'un autre ord... Cliquez pour télécharger TeamViewer 5
|