[Resolvido] diretórios virtuais dentro de um determinado site virtual

[xanburzum 169]

Utilize a metabase do IIS para retornar uma matriz contendo os nomes de todos os diretórios virtuais dentro de um determinado site virtual em uma determinada máquina.

 

GetDirVirtual irá sempre retornar um array.

 

O array vai estar vazio, se ocorreu um erro,se for negada permissão ou a

função retorna um bad inputs . Um array vazio é também devolvido se o site contém

qualquer diretório virtual mapeamendo.

 

O array vai conter um ou mais elementos, cada um representando um nome de Diretório virtual.

 

 

Argumentos:

 

GetDirVirtual tem 2 argumentos, ambos são necessários.

 

nomemaq -

String. Necessário. nome da máquina do site onde reside. Se nulo ou

VbNullString ou String de comprimento zero "", "localhost" é utilizada.

 

sitenumber -

Long. Necessário. O número do site. Os diretórios virtuais deste site será devolvido pela função. Se nulo ou vbNullString ou

String de comprimento zero "" ou não-numérico, 1 é utilizado.

 

 

sintaxe:

Array = GetDirVirtual(nomemaq , sitenumber)

exemplo:

 

<%
Dim VirtualDirArray, VirtualDir

VirtualDirArray = GetDirVirtual("LocalHost", 1)
For Each VirtualDir In VirtualDirArray
	Response.Write( VirtualDir & "<BR>" )
Next
%>

code:

 

Function GetDirVirtual(ByVal nomemaq, ByVal sitenumber)
	Dim oLclHstRt
	Dim VirtDirArr()
	Dim oChild
	Dim path

	'input nomemaq
	If IsNull(nomemaq) Then 
		nomemaq= "LocalHost"
	ElseIf nomemaq= vbnullstring Then
		nomemaq= "LocalHost"
	ElseIf Len(Trim(nomemaq)) = 0 Then
		nomemaq= "LocalHost"
	End If

	If IsNull(sitenumber) Then 
		sitenumber = 1
	ElseIf sitenumber = vbnullstring Then
		sitenumber = 1
	ElseIf Len(Trim(sitenumber)) = 0 Then
		sitenumber = 1
	ElseIf Not IsNumeric(sitenumber) Then
		sitenumber = 1
	End If

	path = "IIS://" & nomemaq & "/w3svc/" & sitenumber & "/root"

	'error handling
	On Error Resume Next

	'tentativa de recuperar metabase para o site
	Set oLclHstRt = GetObject(path)

	If Err.Number <> 0 Then
		GetDirVirtual = Array()
		Exit Function
	End If

	'le array
	Redim VirtDirArr(-1)

	'Loop através de todos os sub objetos deste site
	for each oChild in oLclHstRt

		'só recuperar diretórios virtuais 
		If LCase(oChild.Class) = "iiswebvirtualdir" Then
			Redim Preserve VirtDirArr(UBound(VirtDirArr) + 1)
			VirtDirArr(UBound(VirtDirArr)) = oChild.Name
		End If
	next

	'release metabase
	Set oLclHstRt = Nothing

	'retorna array
	GetDirVirtual = VirtDirArr

	On Error GoTo 0
End Function