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

Nom d'un fichier ou Nom d'un répertoire respectant la Casse (case)   



L'auteur

Francis Faure
France France
Membre Actif (personne physique)
# 0000000001
enregistré le 11/10/2004

http://www.wanagain.net
56 ans
Faure Francis
de la société Design Or Decline
Fiche personnelle


Note des membres
pas de note

Contributions > 01 - PRG : Programmation > Conversions

Nom d'un fichier ou Nom d'un répertoire respectant la Casse (case)
# 0000000686
ajouté le 21/04/2009 18:11:09 et modifié le 21/04/2009
consulté 10821 fois
Niveau initié

Version(s) Foxpro :
VFP 9.0

Description

Bonjour

 

Suite à une question dans le newsgroup microsoft.fr.fox

je me permet une petite contrib pour répondre...

 

à vos tests

 

Cordialement

Francis FAURE

Code source :
clear

* DIRECTORY
? Case_Path_Dir(SYS(5)+SYS(2003))
? Case_Path_Dir(HOME(1))
? Case_Path_Dir(HOME(2))
? Case_Path_Dir(HOME(8))

* FILES
? Case_Path_FileName(_COVERAGE)
? Case_Path_FileName(_foxcode)
? Case_Path_FileName(_beautify)


* Retourner le Path Exact d'un Répertoire (case sensitive)
* (doit pouvoir se ré-écrire en procedure récursive)
FUNCTION Case_Path_Dir(lsDir as stringas String
LOCAL lsRetour as String
LOCAL li as Integer
LOCAL liPath as Integer
LOCAL laDir as String
LOCAL lsPath as String
  IF DIRECTORY(m.lsdir) && si le répertoire existe
    lsDir = ADDBS(FULLPATH(m.lsdir))
    lsRetour = LEFT(m.lsdir,2) && unité
    liPath = OCCURS("\", m.lsdir)
    FOR li=1 TO m.liPath-1
      lsPath = STREXTRACT(m.lsdir, "\","\", m.li)
      DIMENSION laDir[1]
      =ADIR(laDir, m.lsRetour+"\"+m.lsPath, "HD", 1)
      m.lsRetour = m.lsRetour + "\" +laDir[1,1]
    next
  ELSE
    m.lsRetour = m.lsdir
  endif
RETURN ADDBS(m.lsRetour)


* Retourner le path complet d'un Fichier avec la casse (case)
FUNCTION Case_Path_FileName(lsFile as stringas String
LOCAL lsRetour as String
LOCAL laDir as String
  IF FILE(m.lsFile) && si le Fichier existe
    lsFile = FULLPATH(m.lsFile)
    lsRetour = Case_Path_Dir(JUSTPATH(lsFile))
    DIMENSION laDir[1]
    =ADIR(laDir, m.lsFile, "HA", 1)
    m.lsRetour = m.lsRetour + laDir[1,1]
  ELSE
    m.lsRetour = m.lsFile
  endif
RETURN m.lsRetour

Commentaires
le 29/04/2009, Gregory Adam a écrit :
Salut Francis,

* (doit pouvoir se ré-écrire en procedure récursive)
Ceci semble marcher

function DiskFileName(FileName)

if( empty(len(m.FileName)) )
return ''
endif

local aa[1]

if( empty(adir(aa, m.FileName, 'DHRSA', 1) ) )
return m.FileName
else
return addbs(DiskFileName(justpath(m.FileName))) + aa[1,1]
endif
endfunc

le 06/03/2010, Luc a écrit :
Salut
Ca ne fonctionne pas dans certains cas de serveurs (NAS par exemple) qui gèrent mal la casse sur les caractères accentués.
Ceci semble marcher :


MessageBox(RtvNomFichierAvecCasse(Upper(GetFile("*.*", "Nom de fichier"))))

***************************************************************************************************************************************
* Renvoyer un nom de fichier qui respecte la casse
* LG 20100306
function RtvNomFichierAvecCasse
Lparameters tcCheminFichier

Local lcNomFichier, lcCheminFichierAvecCasse, lcRepAvecCasse, laDir, liNbDir
m.lcNomFichier = JustFname(m.tcCheminFichier)

* Chemin du fichier avec casse
m.lcRepAvecCasse = Addbs(RtvNomRepertoireAvecCasse(JustPath(m.tcCheminFichier)))

Dimension m.laDir[1]
m.liNbDir = ADir(m.laDir, m.lcRepAvecCasse + m.lcNomFichier, 'AHS', 1)
If Empty(m.liNbDir)
* Répertoire non trouvé
m.lcCheminFichierAvecCasse = m.lcRepAvecCasse + m.lcNomFichier
Else
* Rechercher le fichier en question
For m.liDir = 1 To m.liNbDir
If Upper(Alltrim(m.laDir[m.liDir, 1])) == Upper(Alltrim(m.lcNomFichier))
m.lcNomFichier = m.laDir[m.liDir, 1]
Exit
Endif
Endfor
m.lcCheminFichierAvecCasse = m.lcRepAvecCasse + m.lcNomFichier
Endif

Return m.lcCheminFichierAvecCasse

Endfunc

***************************************************************************************************************************************
* Renvoyer un nom de fichier qui respecte la casse
* LG 20100306
Function RtvNomRepertoireAvecCasse
Lparameters tcRépertoire

Local lcRepParent, lcRep, lcRepParentAvecCasse, lcRépertoireAveCasse, laDir, liNbDir, liDir
m.lcRepParent = RtvRootDir(m.tcRépertoire)
m.lcRep = Strtran(tcRépertoire, Addbs(m.lcRepParent), "", -1, -1, 1)
m.lcRep = Strtran(lcRep, "\", "")
If Empty(m.lcRepParent)
* On a atteint la racine
m.lcRépertoireAveCasse = m.tcRépertoire
Else
m.lcRepParentAvecCasse = RtvNomRepertoireAvecCasse(m.lcRepParent)
Dimension m.laDir[1]
m.liNbDir = ADir(m.laDir, Addbs(m.lcRepParentAvecCasse) + "*.*", 'HD', 1)
If Empty(m.liNbDir)
* Répertoire non trouvé
m.lcRépertoireAveCasse = Addbs(m.lcRepParentAvecCasse) + m.lcRep
Else
* Rechercher le répertoire en question
For m.liDir = 1 To m.liNbDir
If Upper(Alltrim(m.laDir[m.liDir, 1])) == Upper(Alltrim(m.lcRep))
m.lcRep = m.laDir[m.liDir, 1]
Exit
Endif
Endfor
m.lcRépertoireAveCasse = Addbs(m.lcRepParentAvecCasse) + m.lcRep
Endif
Endif

Return m.lcRépertoireAveCasse
Endfunc

*********************************************************************************************
* Renvoie la racine du répertoire passé en paramètre
* LG 20050706
Func RtvRootDir
LPara tcDir

Local lcDir, lcStr, lcRoot

* Correction des paramètres
m.tcDir = Alltr(m.tcDir)
IF Right(m.tcDir, 1) = "\"
m.tcDir = Left(m.tcDir, Len(m.tcDir) - 1)
Endif

* Trivial
If .not. "\" $ Strtran(m.tcDir, "\\", "")
* Le nom de fichier ne contient pas de référence à son chemin
Return ""
Endif

* Extraire la racine
m.lcRoot = m.tcDir
Do While .not. m.lcRoot == ""
m.lcStr = Right(m.lcRoot, 1)
IF Right(m.lcRoot, 1) == "\"
Exit
Endif
m.lcRoot = Left(m.lcRoot, Len(m.lcRoot) - 1)
Enddo

Return m.lcRoot


Publicité

Les pubs en cours :


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