cDateOrder() - Renvoie l'ordre d'une date quel que soit son format
# 0000000035
ajouté le 01/11/2004 13:58:39 et modifié le 30/03/2005
consulté 9391 fois
Niveau
débutant
Version(s) Foxpro : VFP 9.0 VFP 8.0 VFP 7.0
Description
Si vous clients vous livrent des tables avec des dates mal foutues (genre saisies n'importe comment ), ...
cDateOrder() peut vous aider à y voir plus clair.
Trois fonctions annexes dans le paquet :
nRAtSep() Position du premier séparateur en partant de la droite
nLRAtSep () Position du premier séparateur en partant de la gauche ou de la droite
nYearCent () Année avec le siècle
Code source :
FUNCTION cDateOrder && Ordre d'une date LPARAMETERS ;
tcDate && Date sous la forme [JJ][MM]AA[AA], séparée par '.', '/', ou '-' LOCAL lcResult
m.lcResult = Space(8)
* Si une date valide a été passée IFVartype(m.tcDate) == 'C' ; ANDVal(Chrtran(m.tcDate, DATE_SEP, Space(0))) > 0
* Localiser les éventuels séparateurs d'an et de mois LOCAL lnSepAn, lnSepMois
m.lnSepAn = nRatSep(m.tcDate, DATE_SEP, 1)
m.lnSepMois = nRatSep(m.tcDate, DATE_SEP, 2)
* Calculer l'an (avec le siècle), le mois et le jour en numérique LOCAL lnAn, lnMois, lnJour
m.lnAn = nYearCent(Val(Substr(m.tcDate, m.lnSepAn + 1)))
m.lnMois = Val(Substr(m.tcDate, m.lnSepMois + 1, m.lnSepAn - 1))
m.lnMois = Iif(m.lnMois < 1 or m.lnMois > 12, 1, m.lnMois)
m.lnJour = Val(Substr(m.tcDate, 1, m.lnSepMois - 1))
m.lnJour = Iif(m.lnJour < 1 or m.lnJour > 31, 1, m.lnJour)
* Calculer le résultat
m.lcResult = Dtoc(Date(m.lnAn, m.lnMois, m.lnJour), 1) && 1 Returns the date in a format suitable for indexing ENDIF
RETURN m.lcResult
* ----------- FUNCTION nRAtSep && Position du premier séparateur en partant de la droite LPARAMETER ;
tcChain,; && Chaîne à analyser
tcSeps,; && [".,:;|/\-_*#!$§£&"] Séparateurs recherchés
tnOcc && [1] Numéro d'occurrence de séparateur recherchée LOCAL lnResult && Position du séparateur dans la chaîne (= 0 si aucun)
m.lnResult = nLRAtSep ('R', m.tcChain, m.tcSeps, m.tnOcc)
RETURN m.lnResult
* ----------- FUNCTION nLRAtSep && Position du premier séparateur en partant de la gauche ou de la droite LPARAMETER ;
tcSens,; && ['L'] indique s'il faut chercher en partant de la gauche (L) ou de la droite (R)
tcChain,; && Chaîne à analyser
tcSeps,; && [".,:;|/\-_*#!$§£&"] Séparateurs recherchés
tnOcc && [1] Numéro d'occurrence de séparateur recherchée LOCAL lnResult && Position du séparateur dans la chaîne (= 0 si aucun)
m.lnResult = 0
#DEFINE DEFAULT_SEP ".,:;|/\-_*#!$§£&"
* Si une chaîne non vide a été passée IFVartype(m.tcChain) == 'C' ; ANDNOTEmpty(m.tcChain)
* Pour chaque séparateur LOCAL lnSep, lcSep For m.lnSep = 1 toLen(m.lcSeps)
m.lcSep = Substr(m.lcSeps, m.lnSep, 1)
* Si le séparateurs est dans le chaine, arrêter
m.lnResult = Iif(m.lcSens = 'L', ; AT (m.lcSep, m.tcChain, m.lnOcc), ; RAT (m.lcSep, m.tcChain, m.lnOcc)) IF m.lnResult > 0 EXIT ENDIF ENDFOR ENDIF
RETURN m.lnResult
* ----------- FUNCTION nYearCent && Année avec le siècle LPARAMETERS ;
tnYear && Année avec ou sans le siècle LOCAL lnResult
m.lnResult = 0 IFVartype(m.tnYear)=='N' IF m.tnYear > 99
m.lnResult = m.tnYear ELSE
#DEFINE CENT_CURRENT Int(Year(Date())/100)*100
#DEFINE CENT_ROLLOVER Year(Date()) - CENT_CURRENT + 30
m.lnResult = CENT_CURRENT - Iif(m.tnYear > CENT_ROLLOVER, 100, 0) + m.tnYear ENDIF ENDIF