ASP / ASP.NET : 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.

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>&nbsp;</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)
Classe metier - Conseils pratiques -Visual Basic / VB.NET
Vbscript msgbox - Conseils pratiques -Visual Basic / VB.NET
Vbscript goto - Forum Visual Basic
Classe etudiant c++ - Forum C++ & C++ .NET
Transformer diagramme de classe en code java - Forum Java

Ajouter un commentaire Commentaire

S'inscrire maintenant

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.

Classe imbriqués en vbscript de dossiers (applicable asp)

Contenu du snippet

Source / Exemple :

Conclusion :

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Du même auteur (internetdev)

Dhtml ie filtre dégradé (outil html pour développeur)

Objets imbriquées en tableau (en vbscript ou asp)

Source / Exemple :

Conclusion :

A voir également

Vous n'êtes pas encore membre ? inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Du même auteur (internetdev)

Dhtml ie filtre dégradé (outil html pour développeur)

Objets imbriquées en tableau (en vbscript ou asp)

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !