7453
社区成员
- 主页
...全文
请发表友善的回复…
发表回复
showmetoyou 2003-12-09
文件-->新建-->web浏览器！
imur01 2003-12-09
好东东啊！
online 2003-12-09
在实际施工中，经常会牵扯到为客户设置IIS服务器。原理并不复杂，但是实际操作时会很麻烦、繁琐，还要派工程师到现场。可否编程设置IIS服务器呢？我在本文中将稍作探讨，提供的例程很简单，只包括原理实现部分，距离实际工程应用还有很大差距。
VB6.0编程设置IIS服务器是通过调用ADSI接口，设置Metabase实现的。
可在微软网站下载Metabase管理工具，网址如下：
http://www.microsoft.com/downloads/details.aspx?FamilyID=48364a72-d54e-46dc-aacf-e3be887d17a6&DisplayLang=en
安装Metabase管理工具可以验证VB程序对Metabase数据库的更改、设置。
当然，你用Windows所带的Internet服务管理器也是一样的。
打开VB6.0开发环境，新建Exe工程。在工程引用中添加如下动态库。
Active DS Type Library
Active DS IIS Extension Dll
Active DS IIS Namespace Provider
Form1窗体上添加Command1按钮控件，Command1控件事件如下：
Private Sub Command1_Click()
Dim NamespaceObj As New IISNamespace
Dim ServiceObj As Object
Dim ServerObj As Object
Dim VDirObj As Object
On Error GoTo ErrLine
'Create a new server
Set ServiceObj = NamespaceObj.GetObject("IIsWebService", "Localhost/W3SVC")
Set ServerObj = ServiceObj.Create("IIsWebServer", "18")
'Next, configure new server
ServerObj.ServerSize = 1
ServerObj.ServerComment = "IISTest"
ServerObj.ServerBindings = ":88:"
'Write info back to Metabase
ServerObj.SetInfo
'Create virtual root directory
Set VDirObj = ServerObj.Create("IIsWebVirtualDir", "ROOT")
'Configure new virtual root
VDirObj.Path = "C:\Inetpub"
VDirObj.AccessRead = True
VDirObj.AccessWrite = True
VDirObj.EnableDirBrowsing = True
'Write info back to Metabase
VDirObj.SetInfo
'Start the IIS Server that you recently created
ServerObj.Start
MsgBox "设置成功", , ""
Exit Sub
ErrLine:
MsgBox Err.Description, , Err.Number
End Sub
运行程序，点击Command1按钮（您要具备管理员的权限），程序将创建IISTest服务器，Root目录为C:\Inetpub，端口为88。打开IE浏览器，地址栏中输入http://localhost:88，验证刚才的设置。
好了，先讲到这吧。最后，请注意：在实际工程中设置IIS服务器应谨慎，编程语句要严谨，对异常的处理也要考虑全面。
再补充两句，也可以通过ASP页面，或Javascript、VBscript脚本实现上述功能。
VB6.0编程设置IIS服务器是通过调用ADSI接口，设置Metabase实现的。
可在微软网站下载Metabase管理工具，网址如下：
http://www.microsoft.com/downloads/details.aspx?FamilyID=48364a72-d54e-46dc-aacf-e3be887d17a6&DisplayLang=en
安装Metabase管理工具可以验证VB程序对Metabase数据库的更改、设置。
当然，你用Windows所带的Internet服务管理器也是一样的。
打开VB6.0开发环境，新建Exe工程。在工程引用中添加如下动态库。
Active DS Type Library
Active DS IIS Extension Dll
Active DS IIS Namespace Provider
Form1窗体上添加Command1按钮控件，Command1控件事件如下：
Private Sub Command1_Click()
Dim NamespaceObj As New IISNamespace
Dim ServiceObj As Object
Dim ServerObj As Object
Dim VDirObj As Object
On Error GoTo ErrLine
'Create a new server
Set ServiceObj = NamespaceObj.GetObject("IIsWebService", "Localhost/W3SVC")
Set ServerObj = ServiceObj.Create("IIsWebServer", "18")
'Next, configure new server
ServerObj.ServerSize = 1
ServerObj.ServerComment = "IISTest"
ServerObj.ServerBindings = ":88:"
'Write info back to Metabase
ServerObj.SetInfo
'Create virtual root directory
Set VDirObj = ServerObj.Create("IIsWebVirtualDir", "ROOT")
'Configure new virtual root
VDirObj.Path = "C:\Inetpub"
VDirObj.AccessRead = True
VDirObj.AccessWrite = True
VDirObj.EnableDirBrowsing = True
'Write info back to Metabase
VDirObj.SetInfo
'Start the IIS Server that you recently created
ServerObj.Start
MsgBox "设置成功", , ""
Exit Sub
ErrLine:
MsgBox Err.Description, , Err.Number
End Sub
运行程序，点击Command1按钮（您要具备管理员的权限），程序将创建IISTest服务器，Root目录为C:\Inetpub，端口为88。打开IE浏览器，地址栏中输入http://localhost:88，验证刚才的设置。
好了，先讲到这吧。最后，请注意：在实际工程中设置IIS服务器应谨慎，编程语句要严谨，对异常的处理也要考虑全面。
再补充两句，也可以通过ASP页面，或Javascript、VBscript脚本实现上述功能。
taomaintao 2003-12-09
可以看懂吗?
taomaintao 2003-12-09
Function CreateWebSit(ByVal WWWSiteName As String, _
ByVal WWWTCPPort As String, _
ByVal WWWFilesPath As String, _
ByVal ComputerName As String, ByVal defaultstart As String) As Boolean
'On Error GoTo ErrWouldDo
On Error Resume Next
CreateWebSit = True
Dim TCPPort() As Variant
Dim WWWServer As IADs, WWWService As IADs, WWWVdir, WWWVdirRes As IADs
Dim i As Integer
Dim HandleSameCase As Boolean
Set WWWService = GetObject("IIS://" & ComputerName & "/W3SVC")
i = 1
HandleSameCase = True
For Each WWWServer In WWWService
Set WWWServer = Nothing
Set WWWServer = GetObject("IIS://" & ComputerName & "/W3SVC/" & i)
'Debug.Print WWWServer.ServerComment
If UCase(WWWServer.ServerComment) = UCase(WWWSiteName) Then
WWWService.Delete "IISWebServer", i
'GoTo exitsystem
Exit For
End If
ReDim TCPPort(1)
TCPPort(0) = ""
TCPPort = WWWServer.Serverbindings
If TCPPort(0) = ":" & WWWTCPPort & ":" Then
WWWService.Delete "IISWebServer", i
Else
i = i + 1
End If
Next
HandleSameCase = False
CreateSite:
'MsgBox I
Set WWWServer = WWWService.Create("IISWebServer", i)
WWWServer.ServerComment = WWWSiteName
WWWServer.Serverbindings = ":" & WWWTCPPort & ":"
WWWServer.DefaultDoc = "default.asp,index.asp,default.htm,index.htm"
WWWServer.AccessExecute = True
WWWServer.AccessRead = True
WWWServer.AccessScript = True
WWWServer.EnableDirBrowsing = True
WWWServer.DirBrowseShowDate = False
WWWServer.EnableDefaultDoc = True
WWWServer.SetInfo
Set WWWServer = GetObject("IIS://" & ComputerName & "/W3SVC/" & i)
Set WWWVdir = WWWServer.Create("IISWebVirtualDir", "root")
WWWVdir.Path = WWWFilesPath
WWWVdir.SetInfo
WWWVdir.AppCreate True
If defaultstart = "1" Then
WWWServer.start
Else
WWWServer.Stop
End If
Dim a() As String
Dim ii As Integer
Call LoadDrivenames(a) 'μ÷ó?loaddrivename,ò?a?a2?êy,·μ???y?ˉ?÷??3?
For ii = 0 To DriveCount - 1
Set WWWVdirRes = WWWVdir.Create("IISWebVirtualDir", Mid(a(ii), 1, 1))
WWWVdirRes.Path = a(ii)
WWWServer.AccessExecute = True
WWWServer.AccessRead = True
WWWServer.AccessScript = True
WWWServer.EnableDirBrowsing = True
WWWServer.DirBrowseShowDate = False
WWWServer.EnableDefaultDoc = True
WWWVdirRes.SetInfo
Next ii
WWWServer.HttpErrors = "404,0,FILE," + WWWFilesPath + "\404.htm"
WWWServer.SetInfo
CreateWebSit = True
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim sql As String
sql = "select * from opensystem where id = 1"
rs.Open Trim$(sql), conn, 1, 3, adCmdText
If Not rs.EOF Then
rs("iscreatesite") = "1"
rs.Update
End If
rs.Close
Set rs = Nothing
Exit Function
'exitsystem:
'If defaultstart = "1" Then
' WWWServer.start
'Else
' WWWServer.Stop
'End If
'Exit Function
'ErrWouldDo:
'MsgBox Err.Description & ""
'If (HandleSameCase = True) Then
'GoTo CreateSite
'Else
'MsgBox Err.Description & ""
'CreateWebSit = False
'Exit Function
'End If
End Function
ByVal WWWTCPPort As String, _
ByVal WWWFilesPath As String, _
ByVal ComputerName As String, ByVal defaultstart As String) As Boolean
'On Error GoTo ErrWouldDo
On Error Resume Next
CreateWebSit = True
Dim TCPPort() As Variant
Dim WWWServer As IADs, WWWService As IADs, WWWVdir, WWWVdirRes As IADs
Dim i As Integer
Dim HandleSameCase As Boolean
Set WWWService = GetObject("IIS://" & ComputerName & "/W3SVC")
i = 1
HandleSameCase = True
For Each WWWServer In WWWService
Set WWWServer = Nothing
Set WWWServer = GetObject("IIS://" & ComputerName & "/W3SVC/" & i)
'Debug.Print WWWServer.ServerComment
If UCase(WWWServer.ServerComment) = UCase(WWWSiteName) Then
WWWService.Delete "IISWebServer", i
'GoTo exitsystem
Exit For
End If
ReDim TCPPort(1)
TCPPort(0) = ""
TCPPort = WWWServer.Serverbindings
If TCPPort(0) = ":" & WWWTCPPort & ":" Then
WWWService.Delete "IISWebServer", i
Else
i = i + 1
End If
Next
HandleSameCase = False
CreateSite:
'MsgBox I
Set WWWServer = WWWService.Create("IISWebServer", i)
WWWServer.ServerComment = WWWSiteName
WWWServer.Serverbindings = ":" & WWWTCPPort & ":"
WWWServer.DefaultDoc = "default.asp,index.asp,default.htm,index.htm"
WWWServer.AccessExecute = True
WWWServer.AccessRead = True
WWWServer.AccessScript = True
WWWServer.EnableDirBrowsing = True
WWWServer.DirBrowseShowDate = False
WWWServer.EnableDefaultDoc = True
WWWServer.SetInfo
Set WWWServer = GetObject("IIS://" & ComputerName & "/W3SVC/" & i)
Set WWWVdir = WWWServer.Create("IISWebVirtualDir", "root")
WWWVdir.Path = WWWFilesPath
WWWVdir.SetInfo
WWWVdir.AppCreate True
If defaultstart = "1" Then
WWWServer.start
Else
WWWServer.Stop
End If
Dim a() As String
Dim ii As Integer
Call LoadDrivenames(a) 'μ÷ó?loaddrivename,ò?a?a2?êy,·μ???y?ˉ?÷??3?
For ii = 0 To DriveCount - 1
Set WWWVdirRes = WWWVdir.Create("IISWebVirtualDir", Mid(a(ii), 1, 1))
WWWVdirRes.Path = a(ii)
WWWServer.AccessExecute = True
WWWServer.AccessRead = True
WWWServer.AccessScript = True
WWWServer.EnableDirBrowsing = True
WWWServer.DirBrowseShowDate = False
WWWServer.EnableDefaultDoc = True
WWWVdirRes.SetInfo
Next ii
WWWServer.HttpErrors = "404,0,FILE," + WWWFilesPath + "\404.htm"
WWWServer.SetInfo
CreateWebSit = True
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim sql As String
sql = "select * from opensystem where id = 1"
rs.Open Trim$(sql), conn, 1, 3, adCmdText
If Not rs.EOF Then
rs("iscreatesite") = "1"
rs.Update
End If
rs.Close
Set rs = Nothing
Exit Function
'exitsystem:
'If defaultstart = "1" Then
' WWWServer.start
'Else
' WWWServer.Stop
'End If
'Exit Function
'ErrWouldDo:
'MsgBox Err.Description & ""
'If (HandleSameCase = True) Then
'GoTo CreateSite
'Else
'MsgBox Err.Description & ""
'CreateWebSit = False
'Exit Function
'End If
End Function
hzyood 2003-12-09
能不能具体点啊!
lanxk 2003-12-09
新建工程－DHTML应用程序
呵呵
呵呵