Leaked source code of windows server 2003
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

469 lines
14 KiB

'-------------------------------------------------------------------------
'Global Variables
'-------------------------------------------------------------------------
Dim G_ADMIN_PORT
Dim G_HTTP
Dim G_IIS
Dim G_HOST
Dim G_ADMIN_NAME
Dim G_SHARES_WEBSITEID
Dim G_SHARES_NAME
Dim G_objHTTPService 'WMI server HTTP object
Dim G_nNICCount 'NIC count
Dim G_objService 'WMI server HTTP object
Dim G_ADMIN_WEBSITEID 'HTTP administration web site WMI name
Dim strComputerName
Const WMI_IIS_NAMESPACE = "root\MicrosoftIISv1" 'constant to connect to WMI
G_ADMIN_PORT = "0"
G_ADMIN_NAME = "Administration"
G_SHARES_NAME = "Shares"
G_HTTP = "http://"
G_IIS = "IIS://"
G_HOST = GetSystemName()
G_SHARES_WEBSITEID = "0"
Set G_objHTTPService = GetWMIConnection(WMI_IIS_NAMESPACE)
Set G_objService = GetWMIConnection("Default")
G_SHARES_WEBSITEID = GetWebSiteID( G_SHARES_NAME )
G_ADMIN_WEBSITEID = GetWebSiteID( G_ADMIN_NAME )
G_ADMIN_PORT = GetAdminPortNumber()
Dim strSharesFolder
Set oFileSystemObject = CreateObject("Scripting.FileSystemObject")
strSharesFolder = GetSharesWebSitePath("Shares")
strSharesFolder = "c:\inetpub\shares"
Set oDefaultHTMFile = oFileSystemObject.CreateTextFile( strSharesFolder + "\default.asp", True)
oDefaultHTMFile.WriteLine( chr(60) & chr(37) )
oDefaultHTMFile.WriteLine( "Dim strServerName " )
oDefaultHTMFile.WriteLine( "Dim WinNTSysInfo " )
oDefaultHTMFile.WriteLine( "Set WinNTSysInfo = CreateObject(""WinNTSystemInfo"") " )
oDefaultHTMFile.WriteLine( "strServerName = UCASE( WinNTSysInfo.ComputerName ) " )
oDefaultHTMFile.WriteLine( chr(37) & chr(62) )
'-------------------------------------------------------------------------
'Start of localization content
'-------------------------------------------------------------------------
Dim L_HEADER
Dim L_FOOTER
Dim objLocMgr
Dim varReplace
varReplace = ""
Set objLocMgr = CreateObject("ServerAppliance.localizationmanager")
L_HEADER = GetLocString("httpsh.dll", "40300001", "")
L_FOOTER = GetLocString("httpsh.dll", "40300002", "")
set objLocMgr = nothing
'-------------------------------------------------------------------------
'End of localization content
'-------------------------------------------------------------------------
oDefaultHTMFile.WriteLine("<body marginWidth =0 marginHeight=0 topmargin=0 LEFTMARGIN=0>" )
oDefaultHTMFile.WriteLine("<table width='100%' height='100%' cellspacing=0 cellpadding=0 border=0>" )
oDefaultHTMFile.WriteLine("<tr style='BACKGROUND-COLOR: #000000;" )
oDefaultHTMFile.WriteLine("COLOR: #ffffff;FONT-FAMILY: Arial;FONT-SIZE: 12pt;FONT-WEIGHT: bold;TEXT-DECORATION: none;'> <td align=left> <img src=OEM_LOGO.gif></td>" )
oDefaultHTMFile.WriteLine("<td>" + "<" & "% = strServerName" & "%" & ">" + "</td><td align=right><img src=WinPwr_h_R.gif></td></tr>" )
oDefaultHTMFile.WriteLine("<tr width='100%' height='100%' style='PADDING-LEFT: 15px;PADDING-RIGHT: 15px;'> <td valign=top width='30%'><img src=folder.gif><br><BR><BR>" )
urlHTTPSAdmin = G_HTTPS + "<" & "% = strServerName" & "%" & ">" + ":" + G_SHARES_PORT
'oDefaultHTMFile.Writeline( "<div style='PADDING-BOTTOM: 7px;PADDING-LEFT: 7px;PADDING-RIGHT: 0px;PADDING-TOP: 0px;'>" )
'oDefaultHTMFile.Writeline( "<a style='COLOR: #000000;FONT-FAMILY: tahoma,arial,verdana,sans-serif;FONT-SIZE: 9pt;' HREF=" +urlHTTPSAdmin + ">" + L_HTTPS_FOOTER + " </a> </div" & " " & L_HTTPS_RECOMENDED )
'oDefaultHTMFile.WriteLine("<BR>")
urlAdmin = G_HTTP + "<" & "% = strServerName" & "%" & ">" + ":" + G_ADMIN_PORT
oDefaultHTMFile.Writeline( "<div style='PADDING-BOTTOM: 7px;PADDING-LEFT: 7px;PADDING-RIGHT: 0px;PADDING-TOP: 0px;'>" )
oDefaultHTMFile.Writeline( "<a style='COLOR: #000000;FONT-FAMILY: tahoma,arial,verdana,sans-serif;FONT-SIZE: 9pt;' HREF=" + urlAdmin + ">" + L_FOOTER + " </a> </div>" )
oDefaultHTMFile.WriteLine("</td><td colspan=2 valign=top width='70%'><br>" )
oDefaultHTMFile.WriteLine("<div style='font-family:arial,verdana,sans-serif;font-size:11pt;font-weight: bold;'>" )
oDefaultHTMFile.WriteLine( L_HEADER + " " + "<" & "% = strServerName" & "%" & ">" + "</H2>" )
oDefaultHTMFile.WriteLine("</div>")
Dim oWebVirtDir
Dim oWebRoot
Dim index
Dim urlAdmin, i, urlHTTPSAdmin
Dim arrVroots()
ReDim arrVroots(5000, 1 )
Set oWebRoot = GetObject( "IIS://" & G_HOST & "/" & G_SHARES_WEBSITEID & "/root")
index = -1
For Each oWebVirtDir in oWebRoot
index = index + 1
arrVroots( index, 0 ) = oWebVirtDir.Name
Next
'Call QuickSort( arrVroots, 0, index, 1, 0 )
If Index = -1 Then
oDefaultHTMFile.Writeline( "<div style='FONT-FAMILY: tahoma,arial,verdana,sans-serif;FONT-SIZE: 9pt;'")
oDefaultHTMFile.Writeline( "Empty: There are no shares to list " )
oDefaultHTMFile.Writeline( "</div>" )
End If
For i = 0 To index
oDefaultHTMFile.Writeline( "<div style='PADDING-BOTTOM: 7px;PADDING-LEFT: 7px;PADDING-RIGHT: 0px;PADDING-TOP: 0px;'>")
oDefaultHTMFile.Writeline("<a style='COLOR: #000000;FONT-FAMILY: tahoma,arial,verdana,sans-serif;FONT-SIZE: 9pt;' HREF=" + chr(34) + arrVroots( i, 0 ) + chr(34) + " > " + arrVroots( i, 0 ) + "</a></div>" )
'oDefaultHTMFile.WriteLine("</div>")
Next
oDefaultHTMFile.WriteLine("</td></tr></table></body>")
'oDefaultHTMFile.WriteLine("<BR>")
'urlHTTPSAdmin = G_HTTPS + G_HOST + ":" + G_SHARES_PORT
'oDefaultHTMFile.Writeline( "<a HREF=" +urlHTTPSAdmin + ">" + L_HTTPS_FOOTER + " </a> " & " " & L_HTTPS_RECOMENDED )
'oDefaultHTMFile.WriteLine("<BR>")
'urlAdmin = G_HTTP + G_HOST + ":" + G_ADMIN_PORT
'oDefaultHTMFile.Writeline( "<a HREF=" + urlAdmin + ">" + L_FOOTER + " </a> " )
oDefaultHTMFile.Close
'----------------------------------------------------------------------------
'
' Function : QuickSort
'
' Synopsis : sorts elements in alphabetical order
'
'
' Returns : localized string
'
'----------------------------------------------------------------------------
Sub QuickSort(arrData, iLow, iHigh)
Dim iTmpLow, iTmpHigh, iTmpMid, vTempVal(2), vTmpHold(2)
iTmpLow = iLow
iTmpHigh = iHigh
If iHigh <= iLow Then Exit Sub
iTmpMid = (iLow + iHigh) \ 2
vTempVal(0) = arrData(iTmpMid, 0)
'vTempVal(1) = arrData(iTmpMid, 1)
Do While (iTmpLow <= iTmpHigh)
Do While (arrData(iTmpLow, 0) < vTempVal(0) And iTmpLow < iHigh)
iTmpLow = iTmpLow + 1
Loop
Do While (vTempVal(0) < arrData(iTmpHigh, 0) And iTmpHigh > iLow)
iTmpHigh = iTmpHigh - 1
Loop
If (iTmpLow <= iTmpHigh) Then
vTmpHold(0) = arrData(iTmpLow, 0)
'vTmpHold(1) = arrData(iTmpLow, 1)
arrData(iTmpLow, 0) = arrData(iTmpHigh, 0)
'arrData(iTmpLow, 1) = arrData(iTmpHigh, 1)
arrData(iTmpHigh, 0) = vTmpHold(0)
'arrData(iTmpHigh, 1) = vTmpHold(1)
iTmpLow = iTmpLow + 1
iTmpHigh = iTmpHigh - 1
End If
Loop
If (iLow < iTmpHigh) Then
QuickSort arrData, iLow, iTmpHigh
End If
If (iTmpLow < iHigh) Then
QuickSort arrData, iTmpLow, iHigh
End If
End Sub
'----------------------------------------------------------------------------
'
' Function : GetLocString
'
' Synopsis : Gets localized string from resource dll
'
' Arguments: SourceFile(IN) - resource dll name
' ResourceID(IN) - resource id in hex
' ReplacementStrings(IN) - parameters to replace in string
'
' Returns : localized string
'
'----------------------------------------------------------------------------
Function GetLocString(SourceFile, ResourceID, ReplacementStrings)
' returns localized string
'
Dim objLocMgr
Dim varReplacementStrings
' prep inputs
If Left(ResourceID, 2) <> "&H" Then
ResourceID = "&H" & ResourceID
End If
If Trim(SourceFile) = "" Then
SourceFile = "svrapp"
End If
If (Not IsArray(ReplacementStrings)) Then
ReplacementStrings = varReplacementStrings
End If
' call Localization Manager
Set objLocMgr = CreateObject("ServerAppliance.LocalizationManager")
If ( IsObject(objLocMgr) ) Then
Err.Clear
'
' Disable error trapping
'
'on error resume next
'
' Get the string, do not hault for any errors
GetLocString = objLocMgr.GetString(SourceFile, ResourceID, ReplacementStrings)
Set objLocMgr = Nothing
Dim errorCode
Dim errorDesc
errorCode = Err.Number
errorDesc = Err.description
Err.Clear
'
' Check errors
'
If errorCode <> 0 Then
Dim strErrorDescription
strErrorDescription = "ISSUE: String not found. Source:" + CStr(SourceFile) + " ResID:" + CStr(ResourceID)
GetLocString = strErrorDescription
End If
Else
GetLocString = "ISSUE: Localization string not found. Source:" + CStr(SourceFile) + " ResID:" + CStr(ResourceID)
Err.Clear
End If
End Function
'-------------------------------------------------------------------------
'Function name: GetSharesWebSite
'Description: gets admin website name
'Input Variables:
'Output Variables: None
'Returns: String-Website name
'-------------------------------------------------------------------------
Function GetWebSiteID( strWebSiteName )
'On Error Resume Next
Err.Clear
Dim strMangedSiteName
Dim strWMIpath
Dim objSiteCollection
Dim objSite
strWMIpath = "select * from IIs_WebServerSetting where servercomment =" & chr(34) & strWebSiteName & chr(34)
set objSiteCollection = G_objHTTPService.ExecQuery(strWMIpath)
for each objSite in objSiteCollection
GetWebSiteID = objSite.Name
Exit For
Next
End Function
'-------------------------------------------------------------------------
'Function name: GetWMIConnection
'Description: Serves in getting connected to the server
'Input Variables: strNamespace
'Output Variables: None
'Returns: Object -connection to the server object
'Global Variables: In -L_WMICONNECTIONFAILED_ERRORMESSAGE -Localized strings
'This will try to create an object and connect to wmi if fails shows failure
'page
'-------------------------------------------------------------------------
Function GetWMIConnection(strNamespace)
Err.Clear
Dim objLocator
Dim objService
Set objLocator = CreateObject("WbemScripting.SWbemLocator")
If strNamespace = "" OR strNamespace="default" OR strNamespace="DEFAULT" OR strNamespace="Default" Then
Set objService = objLocator.ConnectServer
Else
Set objService = objLocator.ConnectServer(".",strNamespace )
End if
'If Err.number <> 0 Then
' ServeFailurePage L_WMICONNECTIONFAILED_ERRORMESSAGE & "(" & Err.Number & ")"
' Else
Set GetWMIConnection = objService
'End If
'Set to nothing
Set objLocator=Nothing
Set objService=Nothing
End Function
'-------------------------------------------------------------------------
'Function name: GetAdminPortNumber()
'Output Variables: None
'page
'-------------------------------------------------------------------------
Function GetAdminPortNumber()
'On Error Resume Next
Dim ObjNACCollection
Dim Objinst
Dim objIPArray
Dim strIPProp,strIPArray
Dim arrWinsSrv
Dim arrIPAdd,arrPort
Dim strIPList
GetAdminPortNumber = "8111"
'Getting the IIS_WEB Server Setting instance
Set ObjNACCollection = G_objHTTPService.ExecQuery("Select * from IIs_WebServerSetting where Name=" & Chr(34)& G_ADMIN_WEBSITEID & Chr(34))
Dim nIPCount
For each Objinst in ObjNACCollection
For nIPCount = 0 to ubound(Objinst.ServerBindings)
strIPArray = Objinst.ServerBindings(nIPCount)
'split the strIPArray array to get the IP address and port
arrWinsSrv = split(strIPArray,":")
arrIPAdd = arrWinsSrv(0)
arrPort = arrWinsSrv(1)
GetAdminPortNumber = arrWinsSrv(1)
Next
Next
End Function
'-------------------------------------------------------------------------
'Function name: GetSharesWebSitePath
'Description: gets admin website path
'Input Variables:
'Output Variables: None
'Returns: String-Website path
'-------------------------------------------------------------------------
Function GetSharesWebSitePath( strWebSiteName )
'On Error Resume Next
'Err.Clear
Dim strSiteName
Dim strMangedSiteName
Dim strWMIpath
Dim objSiteCollection
Dim objSite
Dim objWMI
Dim objHttpname
Dim objHttpnames
Dim str1
'set ObjWMI = getWMIConnection("root\MicrosoftIISv1")
'Set objHttpnames = objWMI.InstancesOf("IIs_WebVirtualDirSetting")
'strSiteName=GetWebSiteID( G_SHARES_NAME )
'msgbox strSiteName
' Adding all Http shares to Dictionary object
'For Each objHttpname in objHttpnames
' msgbox objHttpname.name
'str1=split(objHttpname.name,"/")
' To get http shares from only "Shares" web site
'If Mid(objHttpname.name,1,7)=strSiteName Then
' GetSharesWebSitePath = objHttpname.path
' msgbox objHttpname.path
' Exit For
' 'end if
'Next
End Function
Function GetSystemName()
Dim WinNTSysInfo
Set WinNTSysInfo = CreateObject("WinNTSystemInfo")
GetSystemName = WinNTSysInfo.ComputerName
End Function
Function GetWebSiteID( strWebSiteName )
'On Error Resume Next
Err.Clear
Dim strMangedSiteName
Dim strWMIpath
Dim objSiteCollection
Dim objSite
strWMIpath = "select * from IIs_WebServerSetting where servercomment =" & chr(34) & strWebSiteName & chr(34)
set objSiteCollection = G_objHTTPService.ExecQuery(strWMIpath)
for each objSite in objSiteCollection
GetWebSiteID = objSite.Name
Exit For
Next
End Function