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é 11217 fois
Niveau
initié
Version(s) Foxpro : VFP 9.0
Description
Bonjour
Suite à une question dans le newsgroup microsoft.fr.fox
* Retourner le Path Exact d'un Répertoire (case sensitive) * (doit pouvoir se ré-écrire en procedure récursive) FUNCTION Case_Path_Dir(lsDir asstring) asString LOCAL lsRetour asString LOCAL li asInteger LOCAL liPath asInteger LOCAL laDir asString LOCAL lsPath asString IFDIRECTORY(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) DIMENSIONlaDir[1]
=ADIR(laDir, m.lsRetour+"\"+m.lsPath, "HD", 1)
m.lsRetour = m.lsRetour + "\" +laDir[1,1] next ELSE
m.lsRetour = m.lsdir endif RETURNADDBS(m.lsRetour)
* Retourner le path complet d'un Fichier avec la casse (case) FUNCTION Case_Path_FileName(lsFile asstring) asString LOCAL lsRetour asString LOCAL laDir asString IFFILE(m.lsFile) && si le Fichier existe
lsFile = FULLPATH(m.lsFile)
lsRetour = Case_Path_Dir(JUSTPATH(lsFile)) DIMENSIONlaDir[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
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
Retour à la liste
France
Fiche personnelle
Note des membres
le 06/03/2010,
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