Problème création VirtualDirectory dans une fonction ASP(VBScript) [Résolu]

[Marduk]

Bonjour à tous.


Je viens solliciter votre aide car je rencontre un problème : j'ai, sur un de mes sites, une interface qui doit permettre de créer des sous-parties du site, dont entre autre la création d'une VirtualDirectory sur le site.


j'ai donc une fonction "type" qui est censée effectuer cette tâche, mais dès le début (lors du GetObject("IIS://...")), j'ai un code d'erreur différent de 0, et je ne comprends pas pourquoi...

je vous colle le contenu d'une page de test contenant la fonction et son appel

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
<%
Sub CreateWebVirtualDir(DomainName,WebServerComment,Name,Path)
	On Error Resume Next
	'Display "STARTING CreateWebVirtualDir --- Creating Web virtual diretory '" & Path & "'..."

	Dim Domain, WebServer, WebServerID, vRoot, vDir
	
	'Create and object for the Web service
%>Create and object for the Web service<br><%
	Set Domain = GetObject("IIS://" & DomainName & "/W3SVC")
	If (Err <> 0) Then
		Display "TERMINATING CreateWebVirtualDir --- Error accessing domain '" & DomainName & "', or W3Svc."
%>Error Code : <%=Err%><br><%
'		Exit Sub
Err.Clear
	End If

	
	'Check if the Web server specified by the user exists
%>Check if the Web server specified by the user exists<br><%
	WebServerID = -1
	For Each WebServer in Domain
		If WebServer.Class = "IIsWebServer" Then
			If WebServer.ServerComment = WebServerComment Then
				WebServerID = WebServer.Name
				Exit For
			End If
		End If
	Next

	If (WebServerID = -1) Then
		Display "TERMINATING CreateWebVirtualDir --- Error accessing Web server '" & WebServerComment & "'. Server may not exist."
WebServer = 1
'		Exit Sub
	End If

	'Get the server's virtual root 
%>Get the server's virtual root<br><%
	Set vRoot = GetObject("IIS://" & DomainName & "/W3Svc/" & WebServerID & "/root")
	If (Err <> 0) Then
		Display "TERMINATING CreateWebVirtualDir --- Error accessing root on Web server '" & WebServerComment & "'."
%>Erreur code : <%=Err%><br><%
'		Exit Sub
Err.Clear
	End If

	'Create the new virtual directory
%>Create the new virtual directory<br><%
	Set vDir = vRoot.Create("IIsWebVirtualDir",Name)
	If (Err <> 0) Then
		Display "TERMINATING CreateWebVirtualDir --- Error creating IIsWebVirtualDir object '" & Name & "'on root of Web server '" & WebServerComment & "'. Alias may already exist."
%>Err code : <%=Err%><br><%
'		Exit Sub
	End If

	'Set the new virtual directory path
%>Set the new virtual directory path<br><%
	vDir.Path = Path
	If (Err <> 0) Then
		Display "TERMINATING CreateWebVirtualDir --- Error creating IIsWebVirtualDir object path '" & Path & "' on root of Web server '" & WebServerComment & "'. Path may be invalid."
%>Err code : <%=Err%><br><%
'		Exit Sub
Err.Clear
	End If

	'Set the default doc
%>Set the default doc<br><%
	vDir.DefaultDoc = "index.asp, index.htm"
	If (Err <> 0) Then
		Display "TERMINATING CreateWebVirtualDir --- Error set default documents"
%>Err Code : <%=Err%><br><%
'		Exit Sub
Err.Clear
	End If

	'Assign application Name
%>Assign application Name<br><%
	Call vDir.AppCreate(True)
	vDir.AppFriendlyName = Name
	If (Err <> 0) Then
		Display "TERMINATING CreateWebVirtualDir --- Error assigning Application Name of IIsWebVirtualDir object '" & Name & "'on root of Web server '" & WebServerComment & "'. Alias may already exist."
%>Err Code : <%=Err%><br><%
'		Exit Sub
Err.Clear
	End If

	'Save the changes
%>Save the changes<br><%
	vDir.SetInfo
	If (Err <> 0) Then
		Display "TERMINATING CreateWebVirtualDir --- Error saving IIsWebVirtualDir object on root of Web server '" & WebServerComment & "'.  Object may be locked."
%>Err Code : <%=Err%><br><%
'		Exit Sub
Err.Clear
	End If

	'Display "COMPLETED CreateWebVirtualDir --- Web virtual directory '" & Path & "' created successfully on Web server '" & WebServerComment & "'."
End Sub


Dim FSO, ToFolder
Set FSO = CreateObject("Scripting.FileSystemObject")
%>FSO créé<br><%Set ToFolder = FSO.GetFolder( "e:/inetpub/wwwroot/mathez" & "/Events/testVD/")
%>ToFolder défini<br><%
CreateWebVirtualDir "localhost", "Default Web Site", "testVD", ToFolder
%>VD créée

et le résultat :

FSO créé
ToFolder défini
Create and object for the Web service
Error Code : 13
Check if the Web server specified by the user exists
Get the server's virtual root
Erreur code : 13
Create the new virtual directory
Err code : 13
Set the new virtual directory path
Err code : 13
Set the default doc
Err Code : 13
Assign application Name
Err Code : 13
Save the changes
Err Code : 13
VD créée

(bien sûr, la virtualdirectory n'est pas crée, le message s'affiche uniquement parce que j'ai shunté les sorties de fonction)





si vous aviez une idée pour me dépanner ^^

[zzzThibaut]

Bonjour
Je pense que c'est un problème de sécurité. L'utilisateur qui exécute le process n'a pas les droits suffisant pour exécuter ton script.
Si tu utilises un accès anonyme, mets le compte IUSR_computername dans le groupe local admin. (Juse pour le test car cela te cré un trou de sécurité gigantesque)
Si tu utilises NTLM essaye de te connecter à ton site avec un admin du serveur.
zzzThibaut

[Marduk]

rah, je suis un boulet ^^


bon, j'ai pas ajouté l'user anonyme dans la liste des admin (c'est un serveur pro, il y a des sites en production), mais j'ai changé l'utilisateur sur le fichier asp spécifique et y ai mis le comte admin. Ca fonctionne très bien, maintenant, merci bien ^^


me reste plus qu'à faire quelque chose d'équivalent au niveau du fichier qui contient la fonction sur le site en production...