ATOUTFOX
COMMUNAUTÉ FRANCOPHONE DES PROFESSIONNELS FOXPRO
Visual FoxPro : le développement durable

FilesProc() - Applique une procédure à tous les | des fichiers d'un dossier [et ses sous-dossiers]   



L'auteur

FoxInCloud (Th. Nivelet)
France 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é 4462 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é ...

Publicité

Les pubs en cours :

www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2018.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0