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 : Sélectionner tout - Visualiser dans une fenêtre à part
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 ^^