Classe imbriqués en vbscript de dossiers (applicable asp)
Contenu du snippet
Comment accéder à tous les menbres d'une class imbriquée à elle même.
uneClasse.sousClasse(5).sousClasse(2).titre = "titi"
uneSousClasseTmp = new classtype
uneClasse = new classtype
uneClasse.add(uneSousClasseTmp)
.....
.....
uneClasse.sousClasse(5).sousClasse(2).titre = "toto"
uneClasse.sousClasse(5).sousClasse(2).titre = "toto"
uneClasse.AddClass = uneSousClasseTmp
Response.Write "un sous Titre = " & uneClasse.sousClasse(2).titre & "<br>"
Response.Write "taille uneClasse.sousClasse = " & ubound(uneClasse.sousClasse)
résultat sur console:
-----------------------------------------
Affiche tout type2 = Start
-----------------------------------------
> dir(1) --- l_name = Premier - niveau = 0
ubound(m_lstDossiers) = 4
> dir(5) --- l_name = Sous Test1 - niveau = 1
ubound(m_lstDossiers) = 0
> dir(2) --- l_name = test1 - niveau = 1
ubound(m_lstDossiers) = 0
> dir(3) --- l_name = test2 - niveau = 1
ubound(m_lstDossiers) = 0
> dir(4) --- l_name = test3 - niveau = 1
ubound(m_lstDossiers) = 1
> dir(6) --- l_name = Trois 2 - niveau = 2
ubound(m_lstDossiers) = 0
-----------------------------------------
Affiche tout type2 = FIN
-----------------------------------------
- enregistrez dans un fichier.VBS
- tapez (dans une console) : cscript "fichier.VBS" à l'emplacement du source pour voir défiler les dossiers créés.
Conclusion:
- Faire des classes avec des fonctions de parcour récusive est dure car il y a peut ou pas d'éxemple qui montre comment la former pour pouvoir connaitre la taille des sous élémentents à fin de les parcourirs récursivement.
nb: Les sous classes sont clasées, à l'affichage (et prènnent compte les balises HTML pour ASP) par ordre alphabétique, donc, après un premier affichage les éléments ont changée de place.
Avantage du code:
- Peut d'éxemple, voir aucun ne sont disponibles qui permèttent l'accès à des sous classe du type class.sousClasse(1).sousClasse(4).titre
- montre une astuce pour connaitre la taille des sous éléménts à afficher.
- Utiliste un appel recursif d'affichage des sous sous sous classes
- Exemple d'appel VBScript souhaité:
uneClasse.sousClasse(5).sousClasse(2).titre = "titi"
- Permetre le type d'appel suivant:
uneSousClasseTmp = new classtype
uneClasse = new classtype
uneClasse.add(uneSousClasseTmp)
.....
.....
uneClasse.sousClasse(5).sousClasse(2).titre = "toto"
uneClasse.sousClasse(5).sousClasse(2).titre = "toto"
uneClasse.AddClass = uneSousClasseTmp
Response.Write "un sous Titre = " & uneClasse.sousClasse(2).titre & "<br>"
Response.Write "taille uneClasse.sousClasse = " & ubound(uneClasse.sousClasse)
résultat sur console:
-----------------------------------------
Affiche tout type2 = Start
-----------------------------------------
> dir(1) --- l_name = Premier - niveau = 0
ubound(m_lstDossiers) = 4
> dir(5) --- l_name = Sous Test1 - niveau = 1
ubound(m_lstDossiers) = 0
> dir(2) --- l_name = test1 - niveau = 1
ubound(m_lstDossiers) = 0
> dir(3) --- l_name = test2 - niveau = 1
ubound(m_lstDossiers) = 0
> dir(4) --- l_name = test3 - niveau = 1
ubound(m_lstDossiers) = 1
> dir(6) --- l_name = Trois 2 - niveau = 2
ubound(m_lstDossiers) = 0
-----------------------------------------
Affiche tout type2 = FIN
-----------------------------------------
Source / Exemple :
' Source VBscript à lancer dans une console: csscript struct.vbs
' Adaptable en ASP
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'on peut egalement l'améliorer en ajoutant une classe fichier en l'intégrants celle-ci comme tabeau de structur ou de class (pour y ajouter des fonctions affiche etc...), dans la classe dossiers
'un simple fonction resussive de parcours de dossiers locaux peut suffir, sans avoir besoin de l'intégrer dans la class
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' - IdFolder déclaré à l'extèrieur, evite d'avoir à transmettre le dernier ID unique utilisé par la dernière la classe incluse
' mais il est possible de le transmettre aux classes filles pour qu'elle aient le repères à fin de créer leur identififiant unique et incémenté
' , à condition de prendre garde à le modifier lorsqu'on souhaite créer une aboréscence extèrieure complèe pour l'insérer ensuite dans une arboréscence existante, car elle partiraient toutes deux du même ID de'origine
' - DEPLUS, pour ASP et Script dans pages:
' L'ID extèrieur à la classe permet de creér plusieurs arboréscences distinctes pour les afficher
' dans la même pages pour qu'un javascript puisse identifier, de manière unique, les calques (DIV)
' qu'ils faudraient "masquer / afficher"
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Dim IdFolder
class clsDossier
' Variables Privées et Public de la classe
' --------------------------------------------------- clsDossier
private m_id
' - l'id permet seuleument si onsouhaite identifier des élément HTML ex <div id="folder<%=un_dossier.Id%>"><% un_dossier.Affiche %></div>
private m_name
private m_coupable
private m_nbPeres
private m_nbSousDossiers
private m_nbFichiers
private m_lstDossiers()
private m_lstPeres()
private m_trier 'Booléen qui peut passer à true si on décide de créer une fonction de trie
private m_lstSelect
private m_lstFichiers
private m_cnstVide
private m_defaut_targ
private m_cnstTrait
public lien_parent
private m_cnst_nameFileVide
Private Sub Class_Initialize
' --------------------------------------------------- clsDossier - INITIALIZE
m_trier = false
m_nbFichiers = 0
m_nbSousDossiers = 0
m_nbPeres = 1
m_coupable = false
m_cnstTrait = " "
m_cnstVide = "<font size=1> </font>"'"Pas de fichiers dans ce dossier. "
m_defaut_targ = "content"
m_alt= ""
redim m_lstDossiers(0)
redim m_lstPeres(0)
' redim preserve m_lstDossiers(0)
IdFolder = cint(IdFolder)+1
m_id = IdFolder
m_lstPeres(0) = IdFolder
end sub
Private Sub Class_Terminate
' --------------------------------------------------- clsDossier - TERMINATE
' - Destructions des Objets {dossiers et fichiers}
dim l_indiceDossiers, l_indiceFichiers
l_indiceDossiers = 0
l_indiceFichiers = 0
if IsArray(m_lstDossiers) then
for l_indiceDossiers =0 to ubound(m_lstDossiers) - 1
set m_lstDossiers(l_indiceDossiers) = nothing
next
end if
' - Décommanter pour verifier la destruction de tout les objets
' -------------------------------------------------------------
' wscript.echo "clsDossier ---- Class_Terminate m_id = " & m_id & vbcrlf
m_nbPeres = 0
redim preserve m_lstDossiers(0)
' - Décrémemente les ID, mais à enlever si plusieurs classe dossiers distinces sont crées dans la même page.
IdFolder = cint(IdFolder)-1
end sub
' *********************************************************************
' clsDossier - Private FUNCTION
' *********************************************************************
Private Function ReplaceTest(patrn, replStr, str1)
' --------------------------------------------------- clsDossier - ReplaceTest(patrn, replStr, str1)
dim i_test, str1_old
dim l_regEx ' Create variables.
i_test = 0
Set l_regEx = New RegExp ' Create regular expression.
l_regEx.Global = false ' Set pattern.
l_regEx.IgnoreCase = True ' Make case insensitive.
l_regEx.Pattern = patrn ' Set pattern.
while l_regEx.Test(str1)
str1= l_regEx.Replace(str1, replStr) ' Make replacement.
i_test = i_test + 1
wend
set l_regEx = nothing
ReplaceTest = str1
end Function
' Public Function TrieTabHTML(byref inTab) - Utilisisée dans AfficheFichiers()
Private sub TrierDossiers
' --------------------------------------------------- clsDossier - ReplaceTest3(patrn, replStr, byval str1)
dim l_DossierTemp
dim l_n_dossierI, l_n_dossierJ
dim l_I_limit, l_J_limit
dim l_i
dim l_j
l_i=0
l_j = 0
' ne pas instancier l_DossierTemp avec un "new", sinom les ID sont incrémentés inutillement car une nouvelle instance de class est crée
if (UBound(m_lstDossiers)) > 0 then
for l_i=0 to UBound(m_lstDossiers)-1
for l_j=0 to UBound(m_lstDossiers)-1
if (l_i<>l_j) and (l_i > l_j) and(StrComp(ReplaceTest("(<.+>)+(.+)","$2" ,l_n_dossierI),ReplaceTest("(<.+>)+(.+)","$2" , l_n_dossierJ), vbTextCompare) = -1) then
set l_DossierTemp = m_lstDossiers(l_i)
set m_lstDossiers(l_i) = m_lstDossiers(l_j)
set m_lstDossiers(l_j) = l_DossierTemp
set l_DossierTemp = nothing
end if
next
next
end if
m_trier = true
end sub
Private sub TrierDossiersParID
' --------------------------------------------------- clsDossier - ReplaceTest3(patrn, replStr, byval str1)
dim l_DossierTemp
dim l_n_dossierI, l_n_dossierJ, l_i, l_j
dim l_I_limit, l_J_limit
' redim m_lstSelect(0)
l_i=0
l_j=0
if (UBound(m_lstDossiers)) > 0 then
' FONCTIONNE MAIS INCREMENTE INUTILLEMT (Début)°
' set l_DossierTemp = new clsDossier
for l_i=0 to UBound(m_lstDossiers)-1
for l_j=0 to UBound(m_lstDossiers)-1
l_n_dossierI =m_lstDossiers(i).ID
l_n_dossierJ = m_lstDossiers(J).ID
' if (i<>j) and (StrComp(l_n_dossierI, l_n_dossierJ, vbTextCompare) = -1) then ' = <
if (l_i<>l_j) and(l_i > l_j) then
' l_nameI = ltrim(rtrim(ReplaceTest2("(.*)[<+.+>+]*(.*)", "$1$3", l_nameI )))
' l_nameJ = ltrim(rtrim(ReplaceTest2("(.*)[<+.+>+]*(.*)", "$1$3", l_nameJ )))
set l_DossierTemp = m_lstDossiers(i)
set m_lstDossiers(i) = m_lstDossiers(j)
set m_lstDossiers(j) = l_DossierTemp
set l_DossierTemp = nothing
end if
next
next
' FONCTIONNE MAIS INCREMENTE INUTILLEMT (Fin)°
' set l_DossierTemp = nothing
end if
end sub
' *********************************************************************
' clsDossier - Property LET
' *********************************************************************
Public Property Let AddDossier(p_SousDossier)
' --------------------------------------------------- clsDossier - LET - AddDossier(unSousDossier)
dim i
redim Preserve m_lstDossiers(m_nbSousDossiers+1)
'MODIF set m_lstDossiers(m_nbSousDossiers) = new clsDossier
set m_lstDossiers(m_nbSousDossiers) = p_SousDossier
for i = 0 to (ubound(m_lstPeres)-1)
m_lstDossiers(m_nbSousDossiers).AddPere = m_lstPeres(i)
next
' m_lstDossiers(m_nbSousDossiers).AddPere2 m_lstPeres, m_id
' le trie doit être fait seulement, avant l'affichage, pour que membres de la classe restent accéssible le temps du remplisage des classes imbriquées
' si une fonction extérieur décide d'améliorer les titre des dossiers, elle doit pour les retrouvé sans faire une fonction ID ou de recherche par le nom qui peut se retrouver plusieurs fois dans les dossiers
if i>0 then
m_trier = false
end if
m_nbSousDossiers = m_nbSousDossiers + 1
end Property
' ---------------------------------------------------
Public Property Let AddPere(unPere)
' --------------------------------------------------- clsDossier - LET - AddPere desc = Rempli le tableau des dossiers assendant pour evité un affichage infinit
dim y
y=0
redim Preserve m_lstPeres(m_nbPeres +1)
m_lstPeres(m_nbPeres) = unPere
' -------------------------------------------------------
' - Quand j'ajoute un pere , je l'ajoute aux sous doddsseir
' -------------------------------------------------------
' for x =0 to ubound(m_lstDossiers) - 1
MsgBox "m_nbPeres 412 = " & m_nbPeres
for y=0 to ubound(m_lstDossiers) - 1
m_lstDossiers(y).AddPere = unPere
' MsgBox "y = " & y
next
m_nbPeres = m_nbPeres + 1
end property
' ---------------------------------------------------
Public Property Let Name(strName)
' --------------------------------------------------- clsDossier - LET - Name
' strName = Replace(strName, chr(34), " ")
m_name = strName
end Property
' ---------------------------------------------------
Property Let ID(unID) ' ne doit pas être utilisé hors de la classe car il ajouterait un nouvel id et ne remplacerait pas le précédant
' --------------------------------------------------- clsDossier - LET - Name
dim x,y, l_IDold
l_IDold = m_id
m_id = unID
' Boucle qui mets à jours les dossiers fils lorsqu'un dossier contient déjà des sous dossiers
for y =0 to ubound(m_lstDossiers) - 1
for x = 0 to ubound(m_lstPeres) -1
m_lstDossiers(y).AddPere = m_lstPeres(x)
next
next
end Property
' *********************************************************************
' clsDossier - Property GET
' *********************************************************************
Property Get ID()
ID = m_id
end Property
Public Property Get GetSousDossiers()
' --------------------------------------------------- PROPERTY - GET - GetSousDossiers
GetSousDossiers = m_lstDossiers
end property
Public Property get GetSousDossier(indice_g2)
' --------------------------------------------------- PROPERTY - GET - GetSousDossier
if (indice_g2 <= UBound(m_lstDossiers)-1) then
set GetSousDossier = m_lstDossiers(indice_g2)
' set GetSousDossierLast = m_lstDossiers(ubound(m_lstDossiers)-1)
else
MsgBox "Ajouter un sous dossier avant - GetSousDossier('" & indice_g2 & "')"
set GetSousDossier= nothing
end if
' TrierDossiers
End property
'### NOUVEAU
Public Property get GetSousDossierLast()
' --------------------------------------------------- PROPERTY - GET - GetSousDossier
if (UBound(m_lstDossiers)>0) then
set GetSousDossierLast = m_lstDossiers(ubound(m_lstDossiers)-1)
else
msgbox("Ajouter un sous dossier avant - GetSousDossierLast(" & ubound(m_lstDossiers)-1 & ")" & vbcrlf _
& "UBound(m_lstDossiers)-1 = " & UBound(m_lstDossiers)-1)
set GetSousDossierLast= nothing
end if
' TrierDossiers
End property
Public Property Get Name()
' --------------------------------------------------- PROPERTY - GET - Name
Name = m_name
end Property
' *********************************************************************
' clsDossier - Public Function
' *********************************************************************
public Function Affiche()
' ------------------------------------------------------------------------------------ clsDossier -
dim tempSousDossier
dim l_isd
dim l_trait
l_isd = 0
wscript.echo " dir(" & m_id & ") --- l_name = " & m_name
wscript.echo "ubound(m_lstDossiers) = " & ubound(m_lstDossiers)
if IsArray(m_lstDossiers) then
TrierDossiers
for l_isd=0 to ubound(m_lstDossiers)-1
m_lstDossiers(l_isd).Affiche
next
' l_isd = l_isd + 1
end if
end function
public Function Affiche2(p_niveau) 'transmet les niveaux
' ------------------------------------------------------------------------------------ clsDossier -
dim tempSousDossier
dim l_isd
dim l_trait
dim compt
compt = 0
l_isd = 0
for compt = 0 to p_niveau
l_trait = l_trait & m_cnstTrait
next
wscript.echo l_trait & "> dir(" & m_id & ") --- l_name = " & m_name & " - niveau = " & p_niveau
wscript.echo l_trait & " ubound(m_lstDossiers) = " & ubound(m_lstDossiers) & "" & vbCrLf
if IsArray(m_lstDossiers) then
TrierDossiers
p_niveau = p_niveau+1
for l_isd=0 to ubound(m_lstDossiers)-1
m_lstDossiers(l_isd).Affiche2 p_niveau
p_niveau = p_niveau -1
next
' l_isd = l_isd + 1
end if
end function
' Crétion d'un dossier inclu rapides en une ligne sans avoir à renseigner toute la classe
' -----------------------------------------------------------------------------------
Public function AddDossierTarget(p_name, p_chemin,p_target)
' -----------------------------------------------------------------------------------
dim l_tmpDossier
dim l_i
set l_tmpDossier = new clsDossier
with l_tmpDossier
.Name = p_name
end with
redim Preserve m_lstDossiers(m_nbSousDossiers + 1)
set m_lstDossiers(m_nbSousDossiers) = l_tmpDossier
m_lstDossiers(m_nbSousDossiers).AddPere = m_id
for l_i = 0 to ubound(m_lstPeres) -1
m_lstDossiers(m_nbSousDossiers).AddPere = m_lstPeres(l_i)
next
set l_tmpDossier = nothing
m_nbSousDossiers = m_nbSousDossiers + 1
AddDossierTarget = m_nbSousDossiers-1
End function
end class
' - Sript d'éxemple d'utilisation de la classe: clsDossiers
'---------------------------------------------------------------------
dim unDossierTeste, unDossierTeste1, unDossierTeste2, unDossierTeste3
IdFolder = 0
set unDossierTeste = new clsDossier
set unDossierTeste1 = new clsDossier
set unDossierTeste2 = new clsDossier
set unDossierTeste3 = new clsDossier
unDossierTeste.Name = "Premier"
unDossierTeste1.Name = "test1"
unDossierTeste2.Name = "test2"
unDossierTeste3.Name = "test3"
unDossierTeste.AddDossierTarget "Sous Test1", "c:\", "_sefl"
unDossierTeste.AddDossier = unDossierTeste1
unDossierTeste.AddDossier = unDossierTeste2
unDossierTeste.AddDossier= unDossierTeste3
' Attention, si unDossierTeste3 s'ajoute à unDossierTeste3 sans qye le premier soit passer à nothing, on obtient un boucle infinit dans l'affichage car les deux variable pointent au même endroit
' il faut donc le réinitilister pour eviter une boucle infinit d'appel pointant à la m^m adresse.
set unDossierTeste1 = nothing
set unDossierTeste2 = nothing
set unDossierTeste3 = nothing
set unDossierTeste3 = new clsDossier
unDossierTeste3.Name = "Trois 2"
unDossierTeste.GetSousDossierLast.AddDossier = unDossierTeste3
wscript.echo "unDossierTeste.Name = " & unDossierTeste.Name & vbCrLf _
& "-----------------------------------------" & vbcrlf _
& "ubound(unDossierTeste.GetSousDossiers) = " & ubound(unDossierTeste.GetSousDossiers) & vbcrlf _
& "ubound(unDossierTeste.GetSousDossierLast.GetSousDossiers) = " & ubound(unDossierTeste.GetSousDossierLast.GetSousDossiers) & vbcrlf _
& "-----------------------------------------" & vbcrlf & vbcrlf _
& "unDossierTeste.GetSousDossierLast.Name = " & unDossierTeste.GetSousDossierLast.Name & vbCrLf _
& "-----------------------------------------" & vbcrlf _
& "unDossierTeste.GetSousDossier(0).Name = " & unDossierTeste.GetSousDossier(0).Name & vbcrlf _
& "unDossierTeste.GetSousDossier(1).Name = " & unDossierTeste.GetSousDossier(1).Name & vbcrlf _
& "unDossierTeste.GetSousDossierLast.Name = " & unDossierTeste.GetSousDossierLast.Name & vbcrlf _
& "unDossierTeste.GetSousDossierLast.GetSousDossierLast.Name = " & unDossierTeste.GetSousDossierLast.GetSousDossierLast.Name & vbcrlf
'unDossierTeste.GetSousDossierLast.GetSousDossierLast.Name = "nom Changé"
wscript.echo " nom changer = " & unDossierTeste.GetSousDossierLast.GetSousDossierLast.Name & vbcrlf _
& "-----------------------------------------" & vbcrlf & vbcrlf
wscript.echo vbcrlf & "-----------------------------------------" & vbcrlf & "Affiche tout type1 = Start "_
& vbCrLf & "-----------------------------------------" & vbcrlf
unDossierTeste.Affiche
wscript.echo vbcrlf & "-----------------------------------------" & vbcrlf & "Affiche tout type1 = FIN "_
& vbCrLf & "-----------------------------------------" & vbcrlf
wscript.echo vbcrlf & "-----------------------------------------" & vbcrlf & "Affiche tout type2 = Start "_
& vbCrLf & "-----------------------------------------" & vbcrlf
unDossierTeste.Affiche2(0)
wscript.echo vbcrlf & "-----------------------------------------" & vbcrlf & "Affiche tout type2 = FIN "_
& vbCrLf & "-----------------------------------------" & vbcrlf
Conclusion :
- Pour tester :
- enregistrez dans un fichier.VBS
- tapez (dans une console) : cscript "fichier.VBS" à l'emplacement du source pour voir défiler les dossiers créés.
Conclusion:
- Faire des classes avec des fonctions de parcour récusive est dure car il y a peut ou pas d'éxemple qui montre comment la former pour pouvoir connaitre la taille des sous élémentents à fin de les parcourirs récursivement.
nb: Les sous classes sont clasées, à l'affichage (et prènnent compte les balises HTML pour ASP) par ordre alphabétique, donc, après un premier affichage les éléments ont changée de place.
Avantage du code:
- Peut d'éxemple, voir aucun ne sont disponibles qui permèttent l'accès à des sous classe du type class.sousClasse(1).sousClasse(4).titre
- montre une astuce pour connaitre la taille des sous éléménts à afficher.
- Utiliste un appel recursif d'affichage des sous sous sous classes
A voir également
- Classe imbriqués en vbscript de dossiers (applicable asp)
- Diagramme de classe en ligne - Forum Java
- Vbscript msgbox - Conseils pratiques -Visual Basic / VB.NET
- Impossible de définir la propriété visible de la classe worksheet ✓ - Forum Visual Basic 6
- Vbscript goto - Forum Visual Basic
- Réponse examen asp construction ✓ - Forum C / C++ / C++.NET
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.