'Establishing an Active Desktop' (IADS) object, first to reference the Active DS Type library component DIM WWWSERVER AS IADS, WWWSERVICE AS IADS, WWWVDIR, WWWVDIRES 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 'variable definition Dim SiteExist As Boolean Dim WebName' variable initialization SiteExist = False WebName = 1 CreateWebsite = True on Error ResMe next err.clear 'gets W3SVC service set wwwservice = getObject ("IIS: //" & computename & "is) do while err.number <> 0 err.clear set wwwservice = getObject ("IIS: //" & Computername & "/ W3SVC") Loop Err.Clear 'error handling' in IIS Find every Web site 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 "This site has been exist! ", VbInformation vbOKOnly," System Information "Exit Function End If 'Create a WebServer Set WWWServer = WWWService.Create (" IISWebServer ", WebName)' Create a new site WWWServer.ServerComment = WWWSiteName 'set site name WWWServer.KeyType =" IISWebServer " Wwwserver.serverbindings = ":" & wwwsiteport & ":" Set the port number and the main unit head wwwserver.defaultdoc = "default.asp, index.asp, default.htm, index.htm" Set the default startup file WWWServer. AccessScript = true 'Set permissions 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 "host settings success!", vbInformation vbOKOnly, "system information" 'set WWWVdirRes = WWWVdir.Create ( "IISWebVirtualDir", "Resource")' create virtual Directory 'wwwvdirres.path = wwwfilespath "/ resource"' wwwvdirres.accessRead = true 'wwwvdirres.accessWrite = true' wwwvdirres.setinfo 'below to customize IIS Web Server error message, wait 404 error When specified calling website home directory 404.htm page display 'wwwserver.httperrors = "404, 0, file," wwwfilespath "/404.htm"' wwwserver.setIndinfo CreateWebsite = trueEnd Function
Function DeleteWebSite (ByVal WWWSiteName As String, ByVal ComputerName As String) As Boolean 'defined variables Dim Tmp As Integer Dim WebName Dim SiteExist As Boolean' variable initialization SiteExist = False DeleteWebSite = True 'made W3SVC service On Error Resume Next Err.Clear Set WWWService = GetObject ("IIS: //" & computername & "is: ///") 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 'to delete the site WWWService.Delete "IISWebServer", WebName MsgBox "host deleted successfully!", vbInformation vbOKOnly, "system information" End FunctionPrivate Sub cmdCreateWebSite_Click () CreateWebSite txtSiteName.Text, txtS ITEPORT.TEXT, TXTSITEPATH.TEXT, TXTHOSTNAME.TEXT, TXTComputername.textend Sub
Private Sub CmddeleteWebsite_Click () deleteWebsite txtsitename.text, txtcomputername.textend Sub
