// Author: Jaron, Jiangdu News e-mail: jaron@jdinfo.net URL: http: //www.jiangdu.net article was first published in jiangdu.net, if you want to reprint this article, please indicate the source. //
'------------------------------------- -------------------------------------------------- 'Creating a virtual directory Power By Jaron, Jiangdu Information Network, 1999-2002.' If you need to set permissions, modify the 40-56 code. ** Remote '' Usage of Microsoft Corp. '' Usage: MKW3Site <- Rootdirectory | -r Root Directory> '<- Comment | -t Server Comment>' [--Computer | -c Computer1 [, Computer2 ... ]] '[- HostName | -H host name]' [--port | -o port num] '[--ipaddress | -i ip address]' [- Sitenumber | -n Sitenumber] "[--dstart ] '[--Verbose | -v]' [--help | -?] '' Ip address the ip address to assign to the new server. Optional. 'Host Name The Host Name of The Web Site for host headers.' WARNING: Only use Host Name if DNS is set up find the server 'PORT NUM The port to which the server should bind' ROOT DIRECTORY Full path to the root directory for the new server 'SERVER COMMENT The server comment - this is.. The name That Appers in the mmc. 'SiteNumberthe Site Number IS T He Number in The Path That The Web Server'Will Be Created At. IE W3SVC / 3 '' EXAMPLE 1: MKW3Site -r D: / Roots / Company11 - Dontstart -t "My Company Site" 'Example 2: mkw3site -r C: / inetpub / wwwroot -t test -o 8080 '------------------------------------- -------------------------------------------------- ---------
'Force Explicit Declaration of All VariableSoption Explicit
ON Error ResMe next
Dim ArgIPAddress, ArgRootDirectory, ArgServerComment, ArgSkeletalDir, ArgHostName, ArgPortDim ArgComputers, ArgStartDim ArgSiteNumberDim oArgs, ArgNumDim verbose 'set can be written, the script execution permissions Dim prop (15,2) Dim propNumprop (propNum, 0) = "AccessRead" prop (propNum, 1) = true 'reads set to True, unreadable to falsepropNum = propNum 1Prop (propNum, 0) = "AccessWrite" Prop (PropNum, 1) = true' can be written to true, unwrite to falsepropNum = PROPNUM 1PROP (PROPNUM, 0) = "AccessScript" PROP (PROPNUM, 1) = True 'Running script file is set to true, and the script file is set to falsepropNum = propNum 1Propnum (0) = "AccessExecute" Prop (PROPNUM, 1) = false 'can run executive file Set to true, uncomfortable execution file is set to falsepropNum = propNum 1Propnum, 0) = "EnableDirBrowsing" PROP (PROPNUM, 1) = true' Allow list of directory For TRUE, the directory is not allowed to set to falsepropNum = propNum 1
Argipaddress = "" arghostname = "" argport = 80ARGSTART = TRUEARGComputers = array (1) argcomputers (0) = "localhost" argsitenumber = 0verbose = false
Set Oargs = wscript.ArgumentsArgnum = 0
While argnum SELECT CASE LCASE (OARGNUM) CASE "--port", "- O": argnum = argnum 1argport = OARGS (argnum) case "--ipaddress", "- i": argnum = argnum 1argipaddress = OARGS (Argnum) case "--rootdirectory", "- r": argnum = argnum 1argrootdirectory = OARGS (argnum) case "--comment", "- t": argnum = argnum 1ARGSerComment = OARGS (Argnum) Case "- -Hostname "," - H ": argnum = argnum 1Arghostname = OARGS (argnum) case" --computer "," - c ": argnum = argnum 1argComputers = Split (OARGNUM),", ", -1 Case "--sitenumber", "- n": argnum = argnum 1Argsitenumber = clng (OARGS (argnum)) case "--dstart": argstart = false "--help", "-?": Call DisplayusageCase " --verbose "," -v ": verbose = truecase else: wscript.echo" unknown argument "& OARGS (argnum) call displayusagend selectargnum = argnum 1Wend If (ArgRootDirectory = "") Or (ArgServerComment = "") Thenif (ArgRootDirectory = "") thenWScript.Echo "Missing Root Directory" elseWScript.Echo "Missing Server Comment" end ifCall DisplayUsageWScript.Quit (1) End If Call AstcreateWebsite (Argipaddress, Argrootdirectory, ArgServerComment, Arghostname, Argport, Argcomputers, Argstart) Sub ASTCreateWebSite (IPAddress, RootDirectory, ServerComment, HostName, PortNum, Computers, Start) Dim w3svc, WebServer, NewWebServer, NewDir, Bindings, BindingString, NewBindings, ComputerIndex, Index, SiteObj, bDoneDim compOn Error Resume NextFor ComputerIndex = 0 To UBound (Computers ".") comp = Computers (ComputerIndex) If ComputerIndex <> UBound (Computers) ThenTrace "Creating web site on" & comp & End If 'Grab the web service objectErr.ClearSet w3svc = GetObject ( "IIS: //" & comp & "/ w3svc") if err.number <> 0 Thendisplay "Unable to open:" & "IIS: //" & Comp & "/ W3SVC" Endiffingstring = ipaddress & ":" & Portnum & ":" & Hostnametrace "Making sure this web server does not conflict with another ..." For Each WebServer in w3svcIf WebServer.Class = "IIsWebServer" ThenBindings = WebServer.ServerBindingsIf BindingString = Bindings (0) ThenTrace "The server bindings you specified are duplicated in another Virtual Web Server. "WScript.quit (1) end ifend ifnext Index = 1bdone = falseTrace "CREANG New Web Server ..." 'If the user specified a SiteNumber, then use that. Otherwise,' test successive numbers under w3svc until an unoccupied slot is foundIf ArgSiteNumber <> 0 ThenSet NewWebServer = w3svc.Create ( "IIsWebServer", ArgSiteNumber) NewWebServer.SetInfoIf (Err.Number <> 0) ThenWScript.Echo "Could not create a web site with the specified number:" & ArgSiteNumberWScript.Quit (1) ElseErr.Clear 'Verify that the newly created site can be retrievedSet SiteObj = GetObject ( "IIS: // "& Comp &" / W3SVC / "& Argsitenumber) IF (Err.Number = 0) THENBDONE = TrueTrace" Web Server Created. Path IS - "&" IIS: // "& Comp &" COULDN ' T create a web site with the specified number: "& argsitenumberwscript.quit (1) End ifend ifelsewhile (not bdone) err.clearset siteobj = getObject (" IIS: // "& Comp &" / W3SVC / "& index) IF (ERR) .Number = 0) THEN 'A Web Server IS Already Defined At this Position So IncrementIndex = INDEX 1ELSEERR.CLARSET NewWebserver = W3SVC.CREATE ("IisWebserver", Index) NewWebServer. SetInfoIf (Err.Number <> 0) Then 'If call to Create failed then try the next numberIndex = Index 1ElseErr.Clear' Verify that the newly created site can be retrievedSet SiteObj = GetObject ( "IIS: //" & comp & "/ W3SVC / "& INDEX) IF (Err.Number = 0) THENBDONE = TrueTrace" Web Server Created. Path IS - "&" IIS: // "& Comp &" / W3SVC / "& indexelseIndex = Index 1END IFEND IFEND IF 'Sanity checkIf (Index> 10000) ThenTrace "Seem to be unable to create new web server. Server number is" & Index & "." WScript.Quit (1) End IfWendEnd IfNewBindings = Array (0) NewBindings (0) = BindingStringNewWebServer.ServerBindings = NewBindingsNewWebServer.ServerComment = ServerCommentNewWebServer.SetInfo 'Now create the root directory object.Trace "Setting the home directory ..." Set NewDir = NewWebServer.Create ( "IIsWebVirtualDir", "ROOT") NewDir.Path = RootDirectoryNewDir.AccessRead = trueErr .Clearnewdir.setinfonewdir.Appcreate (TRUE) IF (Err.Number = 0) Thentrace "Home Directory Set." Elsedisplay "Error Setting Home Directory." End IF TRACE "Web Site Created!" If Start = True Tentrace "Attempting to Start New Web Server ..." Err.clearset newwebserver = getObject ("IIS: //" & Comp & "/ w3svc /" & index) newwebserver.startif err.Number <> 0 THENDISPLAY "ErrRor Starting Web Server!" Err.clearelSetrace "Web Server Started Suscall" END IFEND IFNEXTCALL ASTSETPERMS (Comp, INDEX, Argrootdirectory, Prop, Propnum) End Sub Sub ASTSetPerms (comp, ArgSiteNumber, ArgRootDirectory, propList, propCount) 'On Error Resume NextDim oAdminDim fullPathfullPath = "IIS: //" & comp & "/ w3svc /" & ArgSiteNumber & "/ ROOT" Trace "Opening path" & fullPathSet oAdmin = GetObject (FullPath) if err.number <> 0 Thendisplay Error_nonodeWScript.quit (1) End IF Dim Name, Valif PropCount> 0 Thendim i For i = 0 to propcount-1Name = proplist (i, 0) VAL = Proplist (i, 1) if verbose = true life "setting" & fullpath & "f" & "=" & valend ifoadmin.put name, (val) IF Err <> 0 ThenDisplay "Unable to set property" & nameEnd IfnextoAdmin.SetInfoIf Err <> 0 ThenDisplay "update information can not be saved." End Ifend ifEnd Sub 'Display the usage messageSub DisplayUsageWScript.Quit (1) End Sub Sub Display (MSG) WScript.echo Now & ". Error Code:" & HEX (ERR) & "-" & Msgend Sub Sub TRACE (MSG) if verbose = True thenwscript.echo now & ":" & msgend IFEND SUB
