【VB實現(xiàn)】VB代碼實現(xiàn)對IIS的管理

作者：佚名   時間：2012-04-13   分享到：

'建立活動桌面'（IADS）對象,首先要引用 Active DS Type library 組件
Dim WWWServer As IADs, WWWService As IADs, WWWVDir, WWWVdirRes As IADs

Function CreateWebSite(ByVal WWWSiteName As String, _
ByVal WWWSitePort As String, _
ByVal WWWSitePath As String, _
ByVal WWWHostName As String, _
ByVal ComputerName As String) As Boolean
'變量定義
Dim SiteExist As Boolean
Dim WebName

'變量初始化
SiteExist = False
WebName = 1
CreateWebSite = True
On Error Resume Next
Err.Clear
'取得W3SVC服務
Set WWWService = GetObject("IIS://" & ComputerName & "/W3SVC")
Do While Err.Number <> 0
Err.Clear
Set WWWService = GetObject("IIS://" & ComputerName & "/W3SVC")
Loop
Err.Clear
'出錯處理
'在IIS中查找每一個WEB站點
For Each WWWServer In WWWService
If UCase(Trim(WWWServer.ServerComment)) <> UCase(Trim(WWWSiteName)) Then
If IsNumeric(WWWServer.Name) Then
If CInt(WWWServer.Name) >= WebName Then WebName = CInt(WWWServer.Name) + 1
End If
Else
SiteExist = True
Exit For
End If
Next
If SiteExist Then
MsgBox "該站點已經(jīng)存在！", vbInformation + vbOKOnly, "系統(tǒng)信息"
Exit Function
End If
'創(chuàng)建WebServer
Set WWWServer = WWWService.Create("IISWebServer", WebName) '創(chuàng)建新站點
WWWServer.ServerComment = WWWSiteName '設置站點名
WWWServer.KeyType = "IISWebServer"
WWWServer.ServerBindings = ":" & WWWSitePort & ":" & WWWHostName '設置端口號和主機頭
WWWServer.DefaultDoc = "Default.asp,Index.asp,Default.htm,Index.htm" '設置默認啟動文件
WWWServer.AccessScript = True '設置權限
WWWServer.AccessRead = True
WWWServer.FrontPageWeb = True
WWWServer.EnableDefaultDoc = True
WWWServer.DefaultDoc = "Default.htm, Default.asp, Index.htm, Index.asp"
Set WWWVDir = WWWServer.Create("IISWebVirtualDir", "Root")
WWWVDir.Path = WWWSitePath
WWWVDir.AppCreate True
WWWVDir.SetInfo
WWWServer.SetInfo
WWWServer.Start
MsgBox "主機設置成功！", vbInformation + vbOKOnly, "系統(tǒng)信息"

'Set WWWVdirRes = WWWVdir.Create("IISWebVirtualDir", "Resource") '創(chuàng)建虛擬目錄
'WWWVdirRes.Path = WWWFilesPath + "\Resource"
'WWWVdirRes.AccessRead = True
'WWWVdirRes.AccessWrite = True
'WWWVdirRes.SetInfo
'下面為自定義IIS Web Server的錯誤信息，等發(fā)生404錯誤時候指定調(diào)用網(wǎng)站主目錄下的404.htm頁面顯示
'WWWServer.HttpErrors = "404,0,FILE," + WWWFilesPath + "\404.htm"
'WWWServer.SetInfo
CreateWebSite = True
End Function

Function DeleteWebSite(ByVal WWWSiteName As String, ByVal ComputerName As String) As Boolean
'定義變量
Dim Tmp As Integer
Dim WebName
Dim SiteExist As Boolean
'變量初始化
SiteExist = False
DeleteWebSite = True
'取得W3SVC服務
On Error Resume Next
Err.Clear
Set WWWService = GetObject("IIS://" & ComputerName & "/W3SVC")
Do While Err.Number <> 0
Err.Clear
Set WWWService = GetObject("IIS://" & ComputerName & "/W3SVC")
Loop
Err.Clear
For Each WWWServer In WWWService
If UCase(Trim(WWWServer.ServerComment)) <> UCase(Trim(WWWSiteName)) Then
SiteExist = False
Else
If IsNumeric(WWWServer.Name) Then
WebName = WWWServer.Name
End If
SiteExist = True
Exit For
End If
Next
'刪除站點
WWWService.Delete "IISWebServer", WebName
MsgBox "主機刪除成功！", vbInformation + vbOKOnly, "系統(tǒng)信息"
End Function

Private Sub cmdCreateWebSite_Click()
CreateWebSite txtSiteName.Text, txtSitePort.Text, txtSitePath.Text, txtHostName.Text, txtComputerName.Text
End Sub

Private Sub cmdDeleteWebSite_Click()
DeleteWebSite txtSiteName.Text, txtComputerName.Text
End Sub