&

VB 自動配置IIS

admin

2014年3月26日 1:16 本文熱度 5652

'建立活動桌面'（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 "該站點已經存在！", vbInformation + vbOKOnly, "系統信息"
Exit Function
End If
'創建WebServer
Set WWWServer = WWWService.Create("IISWebServer", WebName) '創建新站點
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, "系統信息"

'Set WWWVdirRes = WWWVdir.Create("IISWebVirtualDir", "Resource") '創建虛擬目錄
'WWWVdirRes.Path = WWWFilesPath + "\Resource"
'WWWVdirRes.AccessRead = True
'WWWVdirRes.AccessWrite = True
'WWWVdirRes.SetInfo
'下面為自定義IIS Web Server的錯誤信息，等發生404錯誤時候指定調用網站主目錄下的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, "系統信息"
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

該文章在 2014/3/26 1:16:54 編輯過


全部評論1
	admin 2014年3月26日 1:18 使用vbscript自動配置IIS 最近因為參與一項WEB工程的緣故,寫了一個VBScript的程序，用于配置IIS的虛擬目錄。特寫出來大家一起分享。源程序如下：（已在Win2000通過） strServerName ="localhost" strRootPath="g:documents" ''虛擬目錄路徑 strVRName="Test" ''虛擬目錄名稱 strDefaultDoc="index.asp" ''起始文檔 Dim objIIS ''MsgBox "IIS://" & strServerName & "/W3SVC/1" On Error Resume Next Set objIIS=GetObject("IIS://" & strServerName & "/W3SVC/1") If err=-2147024893 Then MsgBox "IIS不存在!" & vbcrlf & "請驗證IIS是否已正確安裝!",vbcritical Wscript.Quit ElseIf err<>0 Then MsgBox "未知錯誤!",vbcritical Wscript.Quit End If On Error GoTo 0 Set objVirtualDir=objIIS.GetObject("IISWebVirtualDir","Root") For each VR in objVirtualDir If VR.Name=strVRName Then MsgBox "虛擬目錄" & strVRName & "已存在!",vbinformation Wscript.Quit End If Next On Error Resume Next Set fs=Wscript.CreateObject("Scripting.FileSystemObject") Set objFolder=fs.GetFolder(strRootPath) If err=76 Then MsgBox "路徑" & strRootPath & "不存在!",vbcritical Wscript.Quit End If Set objFolder=nothing Set fs=nothing On Error GoTo 0 On Error Resume Next Set VirDir=objVirtualDir.Create("IISWebVirtualDir",strVRName) VirDir.AccessRead=true VirDir.Path=strRootPath VirDir.DefaultDoc=VirDir.DefaultDoc & "," & strDefaultDoc VirDir.setInfo If err<>0 Then MsgBox "創建虛擬目錄失敗!",vbcritical Else MsgBox "虛擬目錄" & strVRName & "成功創建在服務器" & strServerName & "上!",vbinformation End If 代碼的關鍵在于創建虛擬目錄，及其中的配置： Set VirDir=objVirtualDir.Create("IISWebVirtualDir",strVRName) VirDir.AccessRead=true VirDir.Path=strRootPath VirDir.DefaultDoc=VirDir.DefaultDoc & "," & strDefaultDoc VirDir.setInfo 該評論在 2014/3/26 1:18:38 編輯過

關鍵字查詢

配置

iis

自動

正在查詢...

點晴ERP是一款針對中小制造業的專業生產管理軟件系統,系統成熟度和易用性得到了國內大量中小企業的青睞。

點晴PMS碼頭管理系統主要針對港口碼頭集裝箱與散貨日常運作、調度、堆場、車隊、財務費用、相關報表等業務管理，結合碼頭的業務特點，圍繞調度、堆場作業而開發的。集技術的先進性、管理的有效性于一體，是物流碼頭及其他港口類企業的高效ERP管理信息系統。

點晴WMS倉儲管理系統提供了貨物產品管理,銷售管理,采購管理,倉儲管理,倉庫管理,保質期管理,貨位管理,庫位管理,生產管理,WMS管理系統,標簽打印,條形碼,二維碼管理,批號管理軟件。

點晴免費OA是一款軟件和通用服務都免費，不限功能、不限時間、不限用戶的免費OA協同辦公管理系統。

VB 自動配置IIS

全部評論1