Public Sub CreateIISWebServer()
Dim obj As Object
Dim Web, NewWeb, Child, VirDir As Object
Dim SBinds()
Dim Ip, HostName, IIsInstallPath As String
Ip = "192.168.0.1" 'IP地址
HostName = "www.HostName.com" '主机头
IIsInstallPath = "c:\Inetpub\MyWebPath" '目录路径
Dim WebName, i, Port As Integer
WebName = 1
Port = 80 '侦听端口
On Error Resume Next
Err.Clear
Set Web = GetObject("IIS://LocalHost/W3SVC")
Do While Err.Number <> 0
If MsgBox("本服务器的Internet Iformation Server 未启动，请启动后重试。", vbRetryCancel, "IIS服务未启动") = vbCancel Then End
Err.Clear
Set Web = GetObject("IIS://LocalHost/W3SVC")
Loop
Err.Clear
For Each Child In Web
If IsNumeric(Child.Name) Then
If CInt(Child.Name) >= WebName Then WebName = CInt(Child.Name) + 1
End If
Next
Set NewWeb = Web.Create("IIsWebServer", WebName)
NewWeb.servercomment = "站点说明"
NewWeb.KeyType = "IIsWebServer"
ReDim SBinds(0)
SBinds(0) = Ip & ":" & Port & ":" & HostName
NewWeb.ServerBindings = SBinds
NewWeb.accessread = True
NewWeb.frontPageWeb = True
NewWeb.EnableDefaultDoc = True
NewWeb.DefaultDoc = "Default.htm, Default.asp, Index.htm, Index.asp"
NewWeb.AccessScript = True
NewWeb.AccessExecute = True
Set VirDir = NewWeb.Create("IIsWebVirtualDir", "Root")
VirDir.Path = IIsInstallPath
VirDir.AppCreate "TRUE"
VirDir.setinfo
NewWeb.setinfo
NewWeb.start
End Sub
Private Sub Command1_Click()
CreateIISWebServer
End Sub
