VB 自动配置IIS

admin

2014年3月26日 1:16 本文热度 9173

'建立活动桌面'（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