Web site created with ASP.NET (VB), our call mode is very simple:
DIM TEST AS New Class1 ()
Test.createWebsit (WebName, Port, "D: / VB", "Localhost")
The following is the code of Class1, the job is doing the job is to establish a site. If there is a name of this site, it is automatically overwritten (Note: This class needs to reference the Actice DS Type Library) Public Class Class1
With localhost '===============================================================================================
Function CreateWebsit (Byval wwwtcpport as string, _byval wwwfilespath as string, _byval computername as string) as boolean
CreateWebsit = Truedim Tcpport () AS Object 'Established A Active Desktop' (IADS) object. First cited in VB 'prject' menu 'References' in 'with Active DS' Type 'library assembly Dim WWWServer As ActiveDs.IADsDim WWWServiceDim WWWVdir, WWWVdir2, WWWVdirRes As ActiveDs.IADsDim i As IntegerDim HandleSameCase As Boolean' made W3SVC service WWWService = GetObject ( "IIS: //" & ComputerName & "/ W3SVC") i = 1HandleSameCase = TrueOn Error GoTo ErrWouldDo 'find each WEB site For each wWWServer in WWWServiceWWWServer = NothingWWWServer = GetObject ( "IIS in IIS: // "& ComputerName &" / W3SVC / "& I) 'debug.print wwwserver.servercomment' If there is already a site to be added during the system, you must first remove the clean IF ucase (wwwserver.servercomment) = ucase (Wwwsitename) THENWWSERVICE.DELETE ("IisWebserver", i) 'Removing exit forends ifredim tcpport (1) tcpport (0) = "" TCPPORT = wwwserver.serverbindings "If the port already has, you must first remove if tcpport (0 ) = ":" & WWWTCPPort & ":" ThenWWWService.Delete ( "IISWebServer", i) 'delete Elsei = i 1End IfNextHandleSameCase = FalseCreateSite:' MsgBox IWWWServer = WWWService.Create ( "IISWebServer", i) 'create a new site WWWSERVER.SERVERCOMMENT = WWWSITENAME 'Sets Site Name WWWServer.ServerBindings = ":" & wwwtcpport & ":" Set port number wwwserver.defaultdoc = "default.asp, index.asp, default.htm, index.htm" Set the default start file wwwserver.accessscript = true 'set permissions wwwserver.accessRead = truewwwserver.setInfo )
'Creating Settings Main Directory WWWServer = getObject ("IIS: //" & ComputerName & "/ W3SVC /" & I) wwwvdir = wwwserver.create ("IisWebVirtualDir", "root") wwwvdir.path = wwwfilespath' home directory actual Disk path wwwvdir.setinfo () wwwvdir.appcreate (true) wwwster.Start () Start the new site 'to create a virtual directory' set wwwvdirres = wwwvdir.create ("IisWebVirtualDir", "resource") 'Create a virtual directory' wwwvdirres.path = Wwwfilespath /resource"'wwvdirres.accessread = true'wwvdirres.accesswrite = true'wwvdirres.setInfo
'The following is an error message for custom IIS Web Server, and the 404.htm page displayed in the home directory is specified when 404 error occurred.
WWWSERVER. HTTPERRORS = "404, 0, file," wwwfilespath "/404.htm" wwwserver.setInfo ()
CreateWebsit = TRUE
EXIT functionerrwoulddo: 'msgbox err.descriptionif (Handlesamecase = true) ingoto createlseelselsemsgbox (err.description) createwebsit = falseexit functionend IFEND Function
REM create a virtual directory program 'ComputerName server name (can be localhost)' DirName to establish a virtual directory name 'true path LinkAddr 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 IntegerCreateVirtualDir = True 'made W3SVC service Dim WWWServer As ActiveDs.IADsDim WWWServiceWWWService = GetObject ( "IIS: //" & ComputerName & "/ W3SVC") i = 1Dim HandleSameCase As BooleanHandleSameCase = TrueDim temp As Booleantemp = FalseFor Each WWWServer In WWWServicewwwserver = Nothingwwwserver = getObject ("IIS: //" & ComputerName & "/ W3SVC /" & i)
IF ucase (wwwserver.servercomment) = ucase (wwwsitename) ThenTemp = truexit forends IFI = i 1Next
If not temp thencreatevirtualdir = falseexit functionendiff
Dim wwwvirtualdir, wwwif as activeds.iads
WWWSERVER = GetObject ("IIS: //" & ComputerName & "/ W3SVC /" & I & "/ root")
REM Check that the virtual directory in this site is ON Error Goto Errhandlewwwif = getObject ("IIS: //" & ComputerName & "& DirName) REM If there is, return false Wwwif.name <> "" "thencreatevirtualdir = falseexit functionendiff
ErrHandle: 'Debug.Print Err.NumberIf Err.Number = -2147024893 ThenErr.Clear () REM if it is because the virtual directory is not found, then an error is performed CreateVirtualDir create a virtual directory GoTo ReturnCreateElseCreateVirtualDir = FalseExit FunctionEnd If
REM create a virtual directory ReturnCreate: WWWVirtualDir = WWWServer.Create ( "IISWebVirtualDir", DirName) WWWVirtualDir.Path = LinkAddrWWWVirtualDir.AccessRead = TrueWWWVirtualDir.AccessScript = TrueWWWVirtualDir.AppCreate (True) WWWVirtualDir.SetInfo ()
Createvirtualdir = TrueEnd Function
Function GetDBConnStr (ByVal DBName As String) As StringSelect Case DBNameCase "friend" GetDBConnStr = CStr (GetSetting ( "HostTask", "DBini", "ConnStr")) Case "wuye" GetDBConnStr = Replace $ (CStr (GetSetting ( "HostTask" , "DBINI", "Connstr"), "Friend", "Wuye") Case ElsegetdbConnstr = CSTR (GetSetting ("HostTask", "Dbini", "Connstr") End Selectend Function
