Create a Windows Server site with ASP.net (VB version)

asp.net|server|window| Create a Web site with asp.net (VB), the way we call it is very simple:
Dim test as New Class1 ()
Test. Createwebsit (Webname,port, "D:\VB", "localhost")

Here is the code for CLASS1, which does the job of setting up a site and automatically overwrites the name of the site (note: This class needs to refer to the Actice DS type Library)
Public Class Class1

with localhost
'===========================

Function Createwebsit (ByVal wwwsitename as String, _
ByVal Wwwtcpport as String, _
ByVal Wwwfilespath as String, _
ByVal ComputerName as String) as Boolean

Createwebsit = True
Dim TCPPort () as Object
' Create Active Desktop ' (IADS) object. First of all, in VB ' Prject ' menu in ' references ' in ' The Active DS ' Type ' library component
Dim Wwwserver as Activeds.iads
Dim WWWService
Dim Wwwvdir, WWWVdir2, wwwvdirres as Activeds.iads
Dim I as Integer
Dim Handlesamecase as Boolean
' Access to W3SVC services
WWWService = GetObject ("iis://" & ComputerName & "/w3svc")
i = 1
Handlesamecase = True
On Error GoTo Errwoulddo
' Find every Web site in IIS
For each wwwserver in WWWService
Wwwserver = Nothing
Wwwserver = GetObject ("iis://" & ComputerName & "/w3svc/" & i)
' Debug.Print wwwserver.servercomment
' If you have a site in the system that you want to add to when you install it, remove the clean
If UCase (wwwserver.servercomment) = UCase (wwwsitename) Then
Wwwservice.delete ("IIsWebServer", i) ' Remove again
Exit for
End If
ReDim TCPPort (1)
TCPPort (0) = ""
TCPPort = wwwserver.serverbindings
' If the port is already there, delete it first
If tcpport (0) = ":" & Wwwtcpport & ":" Then
Wwwservice.delete ("IIsWebServer", i) ' Delete
Else
i = i + 1
End If
Next
Handlesamecase = False
CreateSite:
' MsgBox I
Wwwserver = Wwwservice.create ("IIsWebServer", i) ' Create a new site
Wwwserver.servercomment = Wwwsitename ' Set Station Roll Call
Wwwserver.serverbindings = ":" & Wwwtcpport & ":" ' Set port number
Wwwserver.defaultdoc = "Default.asp,index.asp,default.htm,index.htm" Set default startup file
Wwwserver.accessscript = True ' Set permissions
Wwwserver.accessread = True
Wwwserver.setinfo ()

' Create the Settings home directory
Wwwserver = GetObject ("iis://" & ComputerName & "/w3svc/" & i)
Wwwvdir = Wwwserver.create ("IIsWebVirtualDir", "root")
Wwwvdir.path = Wwwfilespath ' The actual disk path of the home directory
Wwwvdir.setinfo ()
Wwwvdir.appcreate (True)
Wwwserver.start () ' Start a new site

' Create a virtual directory
' Set wwwvdirres = wwwvdir.create ("IIsWebVirtualDir", "Resource") ' Create virtual directory
' Wwwvdirres.path = Wwwfilespath + ' \resource '
' Wwwvdirres.accessread = True
' Wwwvdirres.accesswrite = True
' Wwwvdirres.setinfo

' The following is a custom IIS WEB server error message that specifies the 404.htm page display in the home directory of the calling site when a 404 error occurs

Wwwserver.httperrors = "404,0,file," + Wwwfilespath + "\404.htm"
Wwwserver.setinfo ()

Createwebsit = True

Exit Function
Errwoulddo:
' MsgBox Err.Description
If (handlesamecase = True) Then
GoTo createsite
Else
MsgBox (Err.Description)
Createwebsit = False
Exit Function
End If
End Function

REM Establish virtual directory program
' ComputerName server name (can be localhost)
' DirName the name of the virtual directory to be established
' Linkaddr the true path of the virtual directory
' Wwwsitename site name
Function Createvirtualdir (ByVal ComputerName as String, _
ByVal dirname As String, ByVal linkaddr As String, _
ByVal Wwwsitename as String) as Boolean

Dim I as Integer
Createvirtualdir = True
' Access to W3SVC services
Dim Wwwserver as Activeds.iads
Dim WWWService
WWWService = GetObject ("iis://" & ComputerName & "/w3svc")
i = 1
Dim Handlesamecase as Boolean
Handlesamecase = True
Dim Temp as Boolean
temp = False
For each wwwserver in WWWService
Wwwserver = Nothing
Wwwserver = GetObject ("iis://" & ComputerName & "/w3svc/" & i)

If UCase (wwwserver.servercomment) = UCase (wwwsitename) Then
temp = True
Exit for
End If

i = i + 1
Next

If Not temp Then
Createvirtualdir = False
Exit Function
End If

Dim Wwwvirtualdir, wwwif as Activeds.iads

Wwwserver = GetObject ("iis://" & ComputerName & "/w3svc/" & I & "/root")

REM Check if the virtual directory already exists in the site
On Error GoTo Errhandle
wwwif = GetObject ("iis://" & ComputerName & "/w3svc/" & I & "/root/" & DirName)
REM If there is, then return false
If wwwif.name <> "" Then
Createvirtualdir = False
Exit Function
End If

Errhandle:
' Debug.Print Err.Number
If Err.Number = -2147024893 Then
Err.Clear ()
REM if the virtual directory is not found to be an error, then createvirtualdir to build the virtual directory
GoTo returncreate
Else
Createvirtualdir = False
Exit Function
End If


REM Establish virtual directory
Returncreate:
Wwwvirtualdir = Wwwserver.create ("IIsWebVirtualDir", dirname)
Wwwvirtualdir.path = linkaddr
Wwwvirtualdir.accessread = True
Wwwvirtualdir.accessscript = True
Wwwvirtualdir.appcreate (True)
Wwwvirtualdir.setinfo ()

Createvirtualdir = True
End Function

Function Getdbconnstr (ByVal dbname As String) as String
Select Case dbname
Case "Friend"
Getdbconnstr = CStr (GetSetting ("Hosttask", "Dbini", "ConnStr"))
Case "Wuye"
Getdbconnstr = replace$ (CStr (GetSetting ("Hosttask", "Dbini", "ConnStr")), "Friend", "Wuye"
Case Else
Getdbconnstr = CStr (GetSetting ("Hosttask", "Dbini", "ConnStr"))
End Select
End Function


End Class