上一篇
下一篇
用ASP編程式控制制在IIS建立Web站點的程式代碼
作者:tank 日期:2005-01-09
' ''**********************************************************************************
' 創建一個WebServer
' 必須參數：WRoot,為創建站點的物理目錄；WComment為站點說明；WPort為站點端口；'ServerRun為是否自動運行
' 當創建成功時返回1，失敗時提示退出并返回0，當創建站點成功但啟動失敗時返回2
''**********************************************************************************
''
''******************注意：WPort為List類型，意為服務器端口，***************
'' 本函數在IIS5.0上通過，＊＊必須以管理員身份登錄＊＊
'' 端口舉例：
'' Dim WPort,bindlists,createflag,oComputer
'' oComputer="LocalHost"
'' binglists=Array(0)
'' binglists(0)=":80:"''端口號為80
'' WPort=binglists
'' createflag=CreateWebServer("D:\myweb","我的家園",WPort,False)''調用建站函數
'' If creatflag=0 Then
'' Response.Write "創建站點失敗！請確定是否有權限"
'' ElseIf createflag=1 Then
'' Response.Write "創建站點成功！"
'' ElseIf createflag=2 Then
'' Response.Write "創建站點成功，但啟動站點失敗，可能端口沖突！"
'' End If
''********************************************************************************
''關于Ftp站點的創建我已發表在asp版，請有興趣的朋友自己去查看
''如有問題，歡迎跟我聯系:nonepassby@163.com
Function CreateWebServer(WRoot,WComment,WPort,ServerRun)
On Error Resume Next
Dim ServiceObj,ServerObj,VDirObj
Set ServiceObj = GetObject("IIS://"&oComputer&"/W3SVC")'' 首先創建一個服務實例
WNumber=1
Do While IsObject(ServiceObj.GetObject("IIsWebServer",WNumber))
If Err.number<>0 Then
Err.Clear()
Exit Do
End If
WNumber=WNumber+1
Loop
Set ServerObj = ServiceObj.Create("IIsWebServer", WNumber)'' 然后創建一個WEB服務器
If (Err.Number <> 0) Then'' 是否出錯
''Response.Write "錯誤: 創建Web服務器的ADSI操作失敗！"
CreateWebServer=0
Exit Function
End If
'' 接著配置服務器
ServerObj.ServerSize = 1 '' 中型大小
ServerObj.ServerComment = WComment ''說明
ServerObj.ServerBindings = WPort ''端口
ServerObj.EnableDefaultDoc=True
'' 提交信息
ServerObj.SetInfo
'' 最后，建立虛擬目錄
Set VDirObj = ServerObj.Create("IIsWebVirtualDir", "ROOT")
If (Err.Number <> 0) Then'' 是否出錯
''Response.Write "錯誤: 創建虛擬目錄的ADSI操作失敗！"
CreateWebServer=0
Exit Function
End If
'' 配置虛擬目錄
VDirObj.Path = WRoot
VDirObj.AccessRead = True
VDirObj.AccessWrite = True
VDirObj.EnableDirBrowsing = False
VDirObj.EnableDefaultDoc=True
VDirObj.AccessScript=True
VDirObj.AppCreate2 2
VDirObj.AppFriendlyName="默認應用程序"
VDirObj.SetInfo
If ServerRun = True Then
ServerObj.Start
If (Err.Number <> 0) Then '' Error！
''Response.Write "錯誤: 起動服務器時出錯！請手動啟動WebServer "&WComment&"！<br>"
CreateWebServer=2
Exit Function
End If
End If
Set VDirObj=Nothing
Set ServerObj=Nothing
Set ServiceObj=Nothing
CreateWebServer=1
End Function
本講將使用到ADSI，即活動目錄服務接口.可以到15Seconds.com找到一些相關的資料.
1.創建用戶
下面這段代碼在獨立服務器white上創建用戶user1,初始口令user1,用到了ADSI.
Dim Username,UserPass
Dim oDomain,oUser
Username = "user1"
UserPass = "user1"
Set oDomain = GetObject("WinNT://white")
Set oUser = oDomain.Create ("user", UserName)
If (err.number = 0) Then
oUser.SetInfo
oUser.SetPassword UserPass
oUser.SetInfo
Else
WScript.Echo "創建用戶" & UserName & "出錯！"
End If
Set oUser = Nothing
Set oDomain = Nothing
2.創建目錄
使用FileSystemObject創建目錄:
Dim FsObject
Dim tmpFolder
Set FsObject = WScript.CreateObject("Scripting.FileSystemObject")
tmpFolder = "D:\userdate\user1"
If Not FsObject.FolderExists(tmpFolder) Then
FsObject.CreateFolder(tmpFolder)
If Err.Number<>0 Then
WScript.Echo "創建目錄" & tmpFolder & "失敗！"
End If
End If
注意在創建目錄前,先檢查了目錄是否存在,如果存在,則不用創建了.
3.創建站點
下面這個子程序負責創建一個WWW站點,各個參數的意義為：站點IP地址,站點根目錄,站點說明,主機名,端口號,計算機名(一搬為LOCALHOST),是否立即啟動,匿名訪問時所使用的帳號,匿名訪問時所用帳號的口令,LOG文件的目錄.
函數返回所建站點在IIS中的序號(在IIS中,所有站點依次編號,第一個為1).
一個調用示例：siteid = ASTCreateWebSite("10.1.3.122","d:\userdata\user1","www_user1","","80","LocalHost",True,"IUSR_user1","8iui%#","D:\Logfiles")
Function ASTCreateWebSite(IPAddress, RootDirectory, ServerComment, HostName, PortNum, Computer, Start,AnonymousUserName,AnonymousUserPass,LogFileDirectory)
Dim w3svc, WebServer, NewWebServer, NewDir
Dim Bindings, BindingString, NewBindings, Index, SiteObj, bDone
On Error Resume Next
Err.Clear
Set w3svc = GetObject("IIS://" & Computer & "/w3svc")
If Err.Number <> 0 Then
WScript.Echo "無法打開: "&"IIS://" & Computer & "/w3svc" & VbCrlf & "程序將退出."
WScript.Quit (1)
End If
BindingString = IpAddress & ":" & PortNum & ":" & HostName
For Each WebServer in w3svc
If WebServer.Class = "IIsWebServer" Then
Bindings = WebServer.ServerBindings
If BindingString = Bindings(0) Then
WScript.Echo "IP地址沖突:" & IpAddress & ",請檢測IP地址！." & VbCrlf & "取消創建本站點。"
Exit Function
End If
End If
Next
Index = 1
bDone = False
While (Not bDone)
Err.Clear
Set SiteObj = GetObject("IIS://"&Computer&"/w3svc/" & Index)
If (Err.Number = 0) Then
Index = Index + 1
Else
Err.Clear
Set NewWebServer = w3svc.Create("IIsWebServer", Index)
If (Err.Number <> 0) Then
Index = Index + 1
Else
Err.Clear
Set SiteObj = GetObject("IIS://"&Computer&"/w3svc/" & Index)
If (Err.Number = 0) Then
bDone = True
Else
Index = Index + 1
End If
End If
End If
If (Index > 10000) Then
WScript.Echo "看起來不能創建站點，正在創建的站點的序號為： "&Index&"." & VbCrlf & "取消創建本站點。"
Exit Function
End If
Wend
NewBindings = Array(0)
NewBindings(0) = BindingString
NewWebServer.ServerBindings = NewBindings
NewWebServer.ServerComment = ServerComment
NewWebServer.AnonymousUserName = AnonymousUserName
NewWebServer.AnonymousUserPass = AnonymousUserPass
NewWebServer.KeyType = "IIsWebServer"
NewWebServer.FrontPageWeb = True
NewWebServer.EnableDefaultDoc = True
NewWebServer.DefaultDoc = "Default.htm, Default.asp, Index.htm, Index.asp"
NewWebServer.LogFileDirectory = LogFileDirectory
NewWebServer.SetInfo
Set NewDir = NewWebServer.Create("IIsWebVirtualDir", "ROOT")
NewDir.Path = RootDirectory
NewDir.AccessRead = true
NewDir.AppFriendlyName = "應用程序" & ServerComment
NewDir.AppCreate True
NewDir.AccessScript = True
Err.Clear
NewDir.SetInfo
If (Err.Number = 0) Then
Else
WScript.Echo "主目錄創建時出錯."
End If
If Start = True Then
Err.Clear
Set NewWebServer = GetObject("IIS://" & Computer & "/w3svc/" & Index)
NewWebServer.Start
If Err.Number <> 0 Then
WScript.Echo "啟動站點時出錯!"
Err.Clear
Else
End If
End If
ASTCreateWebSite = Index
End Function
下面函數創建ＦＴＰ站點：
Function ASTCreateFtpSite(IPAddress, RootDirectory, ServerComment, HostName, PortNum, Computer, Start,LogFileDirectory)
Dim MSFTPSVC, FtpServer, NewFtpServer, NewDir
Dim Bindings, BindingString, NewBindings, Index, SiteObj, bDone
On Error Resume Next
Err.Clear
Set MSFTPSVC = GetObject("IIS://" & Computer & "/MSFTPSVC")
If Err.Number <> 0 Then
WScript.Echo "無法打開: "&"IIS://" & Computer & "/MSFTPSVC" & VbCrlf & "程序將退出."
WScript.Quit (1)
End If
BindingString = IpAddress & ":" & PortNum & ":" & HostName
For Each FtpServer in MSFTPSVC
If FtpServer.Class="IIsFtpServer" Then
Bindings = FtpServer.ServerBindings
If BindingString = Bindings(0) Then
WScript.Echo "IP地址沖突:" & IpAddress & ",請檢測IP地址！." & VbCrlf & "取消創建本站點。"
Exit Function
End If
End If
Next
Index = 1
bDone = False
While (Not bDone)
Err.Clear
Set SiteObj = GetObject("IIS://"&Computer&"/MSFTPSVC/" & Index)
If (Err.Number = 0) Then
Index = Index + 1
Else
Err.Clear
Set NewFtpServer = MSFTPSVC.Create("IIsFtpServer", Index)
If (Err.Number <> 0) Then
Index = Index + 1
Else
Err.Clear
Set SiteObj = GetObject("IIS://"&Computer&"/MSFTPSVC/" & Index)
If (Err.Number = 0) Then
bDone = True
Else
Index = Index + 1
End If
End If
End If
If (Index > 10000) Then
WScript.Echo "看起來不能創建站點，正在創建的站點的序號為： "&Index&"." & VbCrlf & "取消創建本站點。"
Exit Function
End If
Wend
NewBindings = Array(0)
NewBindings(0) = BindingString
NewFtpServer.ServerBindings = NewBindings
NewFtpServer.ServerComment = ServerComment
NewFtpServer.AllowAnonymous = False
NewFtpServer.AccessWrite = True
NewFtpServer.AccessRead = True
NewFtpServer.DontLog = False
NewFtpServer.LogFileDirectory = LogFileDirectory
NewFtpServer.SetInfo
Set NewDir = NewFtpServer.Create("IIsFtpVirtualDir", "ROOT")
NewDir.Path = RootDirectory
NewDir.AccessRead = true
Err.Clear
NewDir.SetInfo
If (Err.Number = 0) Then
Else
WScript.Echo "主目錄創建時出錯."
End If
If Start = True Then
Err.Clear
Set NewFtpServer = GetObject("IIS://" & Computer & "/MSFTPSVC/" & Index)
NewFtpServer.Start
If Err.Number <> 0 Then
WScript.Echo "啟動站點時出錯!"
Err.Clear
Else
End If
End If
ASTCreateFtpSite = Index
End Function
文章來自: 
引用通告: 
Tags: