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

Copie de répertoire avec possibilité d'exclusion de fichiers   


L'auteur

Christophe Chenavier
France France
Membre Simple
# 0000000023
enregistré le 14/10/2004
http://www.corwin.fr
59 ans
CHENAVIER Christophe
80440 BOVES
de la société Corwin
Fiche personnelle

Note des membres
16/20
1 vote

Contributions > 01 - PRG : Programmation

Copie de répertoire avec possibilité d'exclusion de fichiers
# 0000000426
ajouté le 13/03/2007 07:53:38 et modifié le 13/03/2007
consulté 9499 fois
Niveau débutant

Version(s) Foxpro :
VFP 9.0
VFP 8.0
Description
Voici une fonction qui permet de copier un répertoire (avec tous ses sous-répertoires) et éventuellement d'exclure certains fichiers lors de la copie.
Si les fichiers à copier existent déjà à l'identique dans le répertoire de destination, il ne sont pas recopiés.
Code source :
*!*    Objet : Copie de répertoire avec possibilité d'exclusion de fichiers
*!*    Auteur : C.Chenavier
*!*    Version : 1.00 - 11/08/2005

FUNCTION CopyDirectory

LPARAMETERS cSourceDir, cDestDir, cExcept

LOCAL I, J, nCopies, cCurrentDir, nNbFiles, lCopy, oErr
LOCAL ARRAY aSubdir(1,5), aFiles(1), aDest(1)

M.cSourceDir = ADDBS(M.cSourceDir)
M.cDestDir = ADDBS(M.cDestDir)
IF NOT DIRECTORY(M.cDestDir)
   MD (M.cDestDir)
ENDIF
M.nCopies = 0
M.cCurrentDir = SET("DIRECTORY")
TRY
   SET DIRECTORY TO ('"' + M.cSourceDir + '"')
   M.nNbFiles = ADIR(aSubdir, '', 'D', 1)
CATCH
   M.nNbFiles = 0
ENDTRY
IF M.nNbFiles > 0
   ASORT(aSubdir)
   FOR I = 1 TO M.nNbFiles
       IF NOT ( aSubdir(I,1) == '.' OR aSubdir(I,1) == "..")
          M.nCopies = M.nCopies + CopyDirectory(M.cSourceDir + aSubdir(I,1), M.cDestDir + aSubdir(I,1), M.cExcept)
       ENDIF
   ENDFOR
ENDIF
SET DIRECTORY TO ('"' + M.cCurrentDir + '"')

IF NOT EMPTY(M.cExcept)
   M.cExcept = ';' + M.cExcept + ';'
ENDIF

M.nNbFiles = ADIR(aDest, M.cDestDir + "*.*", "A", 1)
FOR I = 1 TO ADIR(aFiles, M.cSourceDir + "*.*", "A", 1)
    IF EMPTY(M.cExcept) OR ATC(';'+aFiles(I,1)+';', M.cExcept) = 0
       M.lCopy = .T.
       IF M.nNbFiles > 0
          J = ASCAN(aDest, aFiles(I,1), 1, -1, 1, 8)
          IF J > 0 AND aFiles(I,2) = aDest(J,2) AND aFiles(I,3) = aDest(J,3) AND ;
             aFiles(I,4) = aDest(J,4)
             M.lCopy = .F.  && Le fichier est déjà présent à l'identique
          ENDIF
       ENDIF
       IF M.lCopy
          TRY
             COPY FILE (M.cSourceDir + aFiles(I,1)) TO (M.cDestDir + aFiles(I,1))
             M.nCopies = M.nCopies + 1
          CATCH TO oErr
             MessageBox(aFiles(I,1) + " : " + oErr.Message,16)
          ENDTRY
       ENDIF
    ENDIF
ENDFOR

RETURN M.nCopies
Commentaires
Aucun commentaire enregistré ...
www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2025.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0-SP2-HF3