Dim oAPI : Set oAPI = CreateObject("MOM.ScriptAPI")
HandleError("Failed to create MOM.ScriptAPI")
Dim FSO : Set FSO = CreateObject("Scripting.FileSystemObject")
HandleError("Failed to create Scripting.FileSystemObject")
Dim WShell : Set WShell = CreateObject("wscript.shell")
HandleError("Failed to create wscript.shell")
Dim Args : Set Args = WScript.Arguments
If Args.Count < 5 Then
WScript.Quit
End If
Dim SourceType : SourceType = Args(0)
Dim SourceId : SourceId = Args(1)
Dim ManagedEntityId : ManagedEntityId = Args(2)
Dim SafeEnable : SafeEnable = Args(3)
Dim ComputerIdentity : ComputerIdentity = Args(4)
Const WMI_WA_NAMESPACE = "winmgmts:{impersonationLevel=impersonate}!\\.\root\webadministration"
Const WMI_WA_DIRECTORY = "Select * from virtualdirectory"
Const WMI_WA_SERVER = "Select * from Server"
Const WMI_WA_SITE = "Select * from Site"
Dim creator : Set creator = new ApplicationInstanceCreator
HandleError("ApplicationInstanceCreator()")
Dim programmFilesFolder : programmFilesFolder = GetProgrammFilesFolder()
HandleError("GetProgrammFilesFolder()")
Dim AVIcodeInstallPath : AVIcodeInstallPath = programmFilesFolder & "\AVIcode\Intercept\SCOM2007\EnterpriseMP\"
Dim oDiscovery : Set oDiscovery = oAPI.CreateDiscoveryData(SourceType, SourceId, ManagedEntityId)
HandleError("Failed to create discovery data")
If SafeEnable AND IsInstallEnterpriseAgent() Then
Dim getAppListResult
getAppListResult = GetApplicationList()
If getAppListResult = "true" Then
creator.DiscoveryApplications()
End If
End If
Call oAPI.Return(oDiscovery)
Function IsInstallEnterpriseAgent()
On Error Resume Next
Dim s : s = WShell.RegRead("HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Intercept Service\ImagePath")
If Err <> 0 Then
IsInstallEnterpriseAgent = False
Err.Clear()
Else
IsInstallEnterpriseAgent = True
End If
End Function
Function GetApplicationList()
On Error Resume Next
GetApplicationList = ""
Dim sPath : sPath = """" & AVIcodeInstallPath & "GetClientApplicationsList.vbs"""
If CreateFileMutexFile() Then
CreateFileScript(AVIcodeInstallPath & "GetClientApplicationsList.vbs")
GetApplicationList = RunScriptx86(sPath)
CloseFileMutexFile()
Else
LogEvent "Cannot get application list. Object Scripting Library in use.", 2
Call oAPI.Return(oDiscovery)
Wscript.Quit 0
End If
End Function
Function RunScriptx86(scriptName)
On Error Resume Next
Dim WinDir : WinDir = wshell.ExpandEnvironmentStrings("%windir%")
HandleError("Fails ExpandEnvironmentStrings")
Dim cScriptFileName : cScriptFileName = WinDir & "\SysWOW64\cscript.exe"
If NOT FSO.FileExists(cScriptFileName) Then
cScriptFileName = WinDir & "\System32\cscript.exe"
End If
Dim oExec : Set oExec = WShell.Exec(cScriptFileName & " " & scriptName)
HandleError("Cannot start process '" & cScriptFileName & " " & scriptName & "'")
Dim scriptOutput : scriptOutput = ""
Do While oExec.Status = 0
WScript.Sleep 100
Loop
If Not oExec.StdOut.AtEndOfStream Then
'for exclude cscript.exe header
oExec.StdOut.ReadLine()
oExec.StdOut.ReadLine()
oExec.StdOut.ReadLine()
if (oExec.ExitCode = 0) Then
scriptOutput = Trim(scriptOutput & oExec.StdOut.ReadLine())
Else
scriptOutput = Trim(scriptOutput & oExec.StdOut.ReadAll())
LogEvent "Script Failed: " & cScriptFileName & " " & scriptName & "; OutPut:" & scriptOutput, 1
End if
End If
RunScriptx86 = scriptOutput
End Function
Function CreateFileScript(filePath)
Dim f
wshell.CurrentDirectory = AVIcodeInstallPath
set f = FSO.OpenTextFile("GetClientApplicationsList.vbs", 2, True )
f.WriteLine("On Error Resume Next")
f.WriteLine("")
f.WriteLine("SetLocale(""en-us"")")
f.WriteLine("HandleErrorContinue(""Cannot set en-us locale"")")
f.WriteLine("")
f.WriteLine("Const fileDiscoveryContent = ""AvicodeClientApplicationsDiscoveries.tmp""")
f.WriteLine("")
f.WriteLine("Dim FSO : Set FSO = CreateObject(""Scripting.FileSystemObject"")")
f.WriteLine("")
f.WriteLine("Dim Executor : Set Executor = CreateObject(""Agent.CSMScripting.CExecutor"")")
f.WriteLine("HandleError(""Cannot create'Agent.CSMScripting.CExecutor' object."")")
f.WriteLine("")
f.WriteLine("Executor.Init nothing")
f.WriteLine("HandleError(""Cannot initialize 'Agent.CSMScripting.CExecutor' object."")")
f.WriteLine("Dim output")
f.WriteLine("Const ForWriting = 2")
f.WriteLine("Const TemporaryFolder = 2")
f.WriteLine("")
f.WriteLine("Dim UpperLevelProperties : Set UpperLevelProperties = GetUpperLevelProperties()")
f.WriteLine("If UpperLevelProperties(""isDefault"") Then")
f.WriteLine("")
f.WriteLine(" Dim tempFolder : tempFolder = FSO.GetSpecialFolder(TemporaryFolder)")
f.WriteLine(" HandleError (""Cannot get temporary folder."")")
f.WriteLine(" ")
f.WriteLine(" Dim fileContent : Set fileContent = FSO.OpenTextFile(tempFolder & ""\"" & fileDiscoveryContent, ForWriting, True)")
f.WriteLine(" HandleError (""Cannot get file '"" & tempFolder & ""\"" & fileDiscoveryContent & ""'."")")
f.WriteLine("")
f.WriteLine(" Dim Properties : Set Properties = CreateObject(""Agent.CSMScripting.Common.CProperties"")")
f.WriteLine(" HandleError(""Cannot create Agent.CSMScripting.Common.CProperties"")")
f.WriteLine("")
f.WriteLine(" Properties(""applicationType"") = ""webApplication""")
f.WriteLine("")
f.WriteLine(" Dim ApplicationList : Set ApplicationList = Executor.Execute(""GetApplicationList"", Properties)")
f.WriteLine(" HandleError(""Error after Executor.Execute('GetApplicationList')"")")
f.WriteLine(" ")
f.WriteLine(" Dim Application")
f.WriteLine(" For Each Application in ApplicationList")
f.WriteLine(" If Application(""isEnabled"") Then ")
f.WriteLine(" fileContent.WriteLine ""[BEGIN_WEB_APPLICATION]""")
f.WriteLine(" fileContent.WriteLine ""[IIS_NAME]"" & Application(""name"")")
f.WriteLine(" fileContent.WriteLine ""[DISPLAY_NAME]"" & Application(""displayName"") ")
f.WriteLine(" fileContent.WriteLine ""[END_WEB_APPLICATION]"" ")
f.WriteLine(" End If ")
f.WriteLine(" Next")
f.WriteLine(" ")
f.WriteLine(" fileContent.Close()")
f.WriteLine(" output = ""true""")
f.WriteLine("Else")
f.WriteLine(" output = ""false""")
f.WriteLine("End If")
f.WriteLine("WScript.StdOut.Write output")
f.WriteLine("")
f.WriteLine("")
f.WriteLine("Function GetUpperLevelProperties()")
f.WriteLine(" On Error Resume Next ")
f.WriteLine(" Dim UpperLevelProperties : Set UpperLevelProperties = CreateObject(""Agent.CSMScripting.Common.CProperties"")")
f.WriteLine(" HandleError(""Cannot create Agent.CSMScripting.Common.CProperties"")")
f.WriteLine(" UpperLevelProperties(""applicationType"") = ""executable""")
f.WriteLine(" UpperLevelProperties(""displayName"") = ""w3wp.exe""")
f.WriteLine(" Set GetUpperLevelProperties = Executor.Execute(""GetApplicationParameters"", UpperLevelProperties)")
f.WriteLine(" HandleError(""Failed to execute GetApplicationParameters."")")
f.WriteLine("End Function")
f.WriteLine("")
f.WriteLine("Sub HandleError(customMessage)")
f.WriteLine(" If Not (Err.number = 0) Then")
f.WriteLine(" LogError customMessage")
f.WriteLine(" Wscript.Quit 1")
f.WriteLine(" End If ")
f.WriteLine("End Sub")
f.WriteLine("")
f.WriteLine("Function HandleErrorContinue(customMessage)")
f.WriteLine(" HandleErrorContinue = False")
f.WriteLine(" If Not (Err.number = 0) Then")
f.WriteLine(" LogError customMessage")
f.WriteLine(" Err.Clear")
f.WriteLine(" HandleErrorContinue = True")
f.WriteLine(" End If")
f.WriteLine("End Function")
f.WriteLine("")
f.WriteLine("Sub LogError(customMessage)")
f.WriteLine(" Dim msg")
f.WriteLine(" If Not (Err.number = 0) Then")
f.WriteLine(" msg = Replace("" Error: #P1# Description: #P2# "", ""#P1#"", CStr(Err.number) )")
f.WriteLine(" msg = Replace(msg, ""#P2#"", Err.Description )")
f.WriteLine(" msg = customMessage & VbCrLf & msg & VbCrLf")
f.WriteLine(" WScript.StdOut.WriteLine msg ")
f.WriteLine(" End If")
f.WriteLine("End Sub")
f.close
End Function
Dim fileMutex
Function CreateFileMutexFile()
On Error Resume Next
Dim fileName : fileName = AVIcodeInstallPath & "CSMScriptingMutex.tmp"
Dim Counter : Counter = 0
do
Err.Clear()
Set fileMutex = fso.OpenTextFile(FileName, 2 , True)
If NOT (Err = 0) Then
WScript.Sleep Int(300 * Rnd)
Counter = Counter+1
End If
loop While (Err <> 0) AND (Counter < 700)
If Counter < 700 Then
CreateFileMutexFile = True
Else
CreateFileMutexFile = False
End If
End Function
Function CloseFileMutexFile()
On Error Resume Next
if NOT(isEmpty(fileMutex)) AND NOT(isNull(fileMutex)) Then
fileMutex.Close()
If NOT (Err = 0) Then
Err.Clear()
End If
End If
End Function
Function GetProgrammFilesFolder()
GetProgrammFilesFolder = wshell.ExpandEnvironmentStrings("%ProgramFiles(x86)%")
if GetProgrammFilesFolder = "%ProgramFiles(x86)%" Then
GetProgrammFilesFolder = wshell.ExpandEnvironmentStrings("%ProgramFiles%")
End If
End Function
Sub HandleError(customMessage)
If Not (Err.number = 0) Then
LogError customMessage
Wscript.Quit 0
End If
End Sub
Function HandleErrorContinue(customMessage)
HandleErrorContinue = False
If Not (Err.number = 0) Then
LogError customMessage
Err.Clear
HandleErrorContinue = True
End If
End Function
Sub LogError(customMessage)
Dim msg
If Not (Err.number = 0) Then
msg = Replace(" Error: #P1# Description: #P2# ", "#P1#", CStr(Err.number) )
msg = Replace(msg, "#P2#", Err.Description )
msg = customMessage & VbCrLf & msg & VbCrLf
If UCase(Hex(Err.number)) = UCase("80041006") Then
msg = msg & "WMI Error. Not enough memory for the operation." & VbCrLf
End If
WScript.StdOut.WriteLine msg
msg = msg & " [" & ScriptInfo() & "]"
LogEvent msg, 1
End If
End Sub
Function ScriptInfo()
Dim commandLineInfo : commandLineInfo = WScript.ScriptFullName
Dim argument
For Each argument In WScript.Arguments
commandLineInfo = commandLineInfo & " """ & argument & """"
Next
ScriptInfo = commandLineInfo
End Function
Sub LogEvent (message, eventType)
Dim errorEventId : errorEventId = 20000
Dim oAPI0 : Set oAPI0 = CreateObject("MOM.ScriptAPI")
Call oAPI0.LogScriptEvent("AVIcode uX Monitoring Management Pack for OpsMgr 2007", errorEventId, eventType, message)
End Sub
''''''''''''''''''''''''''''''''''''
''' ApplicationInstanceCreator
''''''''''''''''''''''''''''''''''''
Class ApplicationInstanceCreator
Dim BEGIN_WEB_APPLICATION
Dim END_WEB_APPLICATION
Dim APPLICATION_IIS_NAME
Dim APPLICATION_DISPLAY_NAME
Dim APPLICATION_MONITOR
Dim discoveryContent
Dim oInst
Private Sub Class_Initialize()
BEGIN_WEB_APPLICATION = "[BEGIN_WEB_APPLICATION]"
END_WEB_APPLICATION = "[END_WEB_APPLICATION]"
APPLICATION_IIS_NAME = "[IIS_NAME]"
APPLICATION_DISPLAY_NAME = "[DISPLAY_NAME]"
discoveryContent = ""
End Sub
Private Function GetDiscoveryContent()
On Error Resume Next
Const ForReading = 1
Const TemporaryFolder = 2
if discoveryContent = "" Then
Dim tempFolder : tempFolder = FSO.GetSpecialFolder(TemporaryFolder)
HandleError ("Cannot get temporary folder.")
Dim fil : set fil = fso.getFile(tempFolder & "\" & fileDiscoveryContent)
HandleError ("Cannot get file information '" & tempFolder & "\" & fileDiscoveryContent & "'.")
if fil.size > 0 then
Dim fileContent : Set fileContent = FSO.OpenTextFile(tempFolder & "\" & fileDiscoveryContent, ForReading)
HandleError ("Cannot get file '" & tempFolder & "\" & fileDiscoveryContent & "'.")
discoveryContent = fileContent.ReadAll()
HandleError ("Cannot read file '" & tempFolder & "\" & fileDiscoveryContent & "'.")
fileContent.Close()
HandleErrorContinue("Could not close file: " & fileDiscoveryContent)
End If
End if
GetDiscoveryContent = discoveryContent
End Function
Public Function DiscoveryApplications()
On Error Resume Next
Dim outputDiscoveryProcess
outputDiscoveryProcess = Trim(GetDiscoveryContent())
HandleError("Cannot get discovery data for web applications.")
If outputDiscoveryProcess <> "" Then
Dim startPos : startPos = 1
Do While startPos > 0
Dim appContent : appContent = Trim (GetBlockElement(outputDiscoveryProcess, startPos, BEGIN_WEB_APPLICATION, END_WEB_APPLICATION))
HandleError ("Cannot get application block.")
If (appContent <> "") Then
ParseApplication (appContent)
End If
Loop
End if
End Function
Private Function ParseApplication(appContent)
On Error Resume Next
Dim appName : appName = GetValueForElement (appContent, APPLICATION_IIS_NAME)
HandleError ("Cannot parse application IIS name.")
Dim displayName : displayName = GetValueForElement (appContent, APPLICATION_DISPLAY_NAME)
HandleError ("Cannot parse application display name.")
Dim virtualRoot : virtualRoot = GetFullApplicationVRoot(appName)
HandleError ("Cannot get path ")
CreateApplication appName, displayName, virtualRoot
HandleError ("Cannot create web application '" & displayName & "'.")
End Function
Private Function CreateApplication(appName, displayName, virtualRoot)
On Error Resume Next
Set oInst = oDiscovery.CreateClassInstance("$MPElement[Name='AVIcode.DotNet.SystemCenter.Client.WebApplicationEndpoint']$")
Call oInst.AddProperty("$MPElement[Name='Windows!Microsoft.Windows.Computer']/PrincipalName$", ComputerIdentity)
Call oInst.AddProperty("$MPElement[Name='AVIcode.DotNet.SystemCenter.Client.WebApplicationEndpoint']/ApplicationVRoot$", virtualRoot)
Call oInst.AddProperty("$MPElement[Name='AVIcode.DotNet.SystemCenter.Client.WebApplicationEndpoint']/IISApplicationName$", appName)
Call oInst.AddProperty("$MPElement[Name='AVIcode.DotNet.SystemCenter.Client.WebApplicationEndpoint']/DisplayApplicationName$", displayName)
Call oInst.AddProperty("$MPElement[Name='System!System.Entity']/DisplayName$", displayName)
Call oDiscovery.AddInstance(oInst)
HandleError("Failed to add discovered ASP.NET client side application instance " & displayName)
End Function
Private Function GetBlockElement(content, ByRef startIndex, tagStart, tagEnd)
On Error Resume Next
GetBlockElement = ""
If startIndex > 0 Then
Dim startPosition : startPosition = InStr(startIndex, content, tagStart, 1)
If startPosition > 0 Then
Dim endPosition : endPosition = InStr(startPosition, content, tagEnd, 1)
If endPosition > 0 Then
GetBlockElement = Mid(content, startPosition, endPosition + Len(tagEnd) - startPosition)
startIndex = endPosition + Len(tagEnd)
Else
startIndex = 0
End If
Else
startIndex = 0
End If
End If
End Function
Private Function GetValueForElement(content, elementName)
On Error Resume Next
GetValueForElement = ""
Dim startElementName : startElementName = 0
startElementName = InStr(1, content, elementName, 1)
If (startElementName > 0) Then
startElementName = startElementName + Len(elementName)
Dim endElementName : endElementName = InStr(startElementName, content, vbcrlf, 1)
if(endElementName > 0) Then
GetValueForElement = Trim(Mid (content, startElementName, endElementName - startElementName))
End If
Else
Err.Raise 20000, "ASP.NET Client Side Applications discovery.", "Cannot found " & elementName & " in " & content, 0, 0
End If
End Function
Function GetFullApplicationVRoot(ApplicationName)
On Error Resume Next
If IsIIS7() = TRUE Then
If IIS7ScriptingToolsExist() = TRUE Then
GetFullApplicationVRoot = GetApplicationVRootIIS7(ApplicationName)
End If
Else
GetFullApplicationVRoot = GetApplicationVRootIIS6(ApplicationName)
End If
End Function
Function IIS7ScriptingToolsExist()
On Error Resume Next
IIS7ScriptingToolsExist = False
Dim s : s = WShell.RegRead("HKLM\SOFTWARE\Microsoft\InetStp\Components\ManagementScriptingTools")
If Err <> 0 Then
' 0x80070003 - The system cannot find the path specified.
' 0x80070002 - The system cannot find the file specified.
If UCase(Hex(Err.number)) = UCase("80070003") Or UCase(Hex(Err.number)) = UCase("80070002") Then
Err.Clear()
Exit Function
Else
HandleError("HKLM\SOFTWARE\Microsoft\InetStp\Components\ManagementScriptingTools")
End If
End If
If NOT IsEmpty(s) Then
If s = 1 Then
IIS7ScriptingToolsExist = True
End If
End If
End Function
Function IsIIS7()
On Error Resume Next
IsIIS7 = False
Const iisVersionKey = "HKLM\SOFTWARE\Microsoft\InetStp\MajorVersion"
Dim s1 : s1 = WShell.RegRead(iisVersionKey)
If Err <> 0 Then
' 0x80070003 - The system cannot find the path specified.
' 0x80070002 - The system cannot find the file specified.
If UCase(Hex(Err.number)) = UCase("80070003") Or UCase(Hex(Err.number)) = UCase("80070002") Then
Err.Clear()
Exit Function
Else
HandleError("Failed to get HKLM\SOFTWARE\Microsoft\InetStp\MajorVersion")
End If
End If
If NOT IsEmpty(s1) Then
If s1 = "7" Then
'check that ASP.NET component installed
Const aspNetKey = "HKLM\SOFTWARE\Microsoft\InetStp\Components\ASPNET"
Dim s2 : s2 = WShell.RegRead(aspNetKey)
If Err <> 0 Then
' 0x80070003 - The system cannot find the path specified.
' 0x80070002 - The system cannot find the file specified.
If UCase(Hex(Err.number)) = UCase("80070003") Or UCase(Hex(Err.number)) = UCase("80070002") Then
Err.Clear()
Exit Function
Else
HandleError("Failed to get HKLM\SOFTWARE\Microsoft\InetStp\Components\ASPNET")
End If
End If
If NOT IsEmpty(s2) Then
If s2 = "1" Then
IsIIS7 = True
End If
End If
End If
End If
End Function
Function GetApplicationVRootIIS7(ApplicationName)
On Error Resume Next
Dim siteObjs, objWMI
Set objWMI = GetObject(WMI_WA_NAMESPACE)
HandleError("Failed to get WMINameSpace '" & WMI_WA_NAMESPACE & "'")
Dim pos : pos = InStr(ApplicationName, "/")
If pos <> 0 Then
Dim webSiteName : webSiteName = Left(ApplicationName, pos - 1)
Dim appPath : appPath = Right(ApplicationName, Len(ApplicationName) - pos + 1)
Dim vdsObj : Set vdsObj = objWMI.ExecQuery(WMI_WA_DIRECTORY & " WHERE SiteName = '" & webSiteName & "' and ApplicationPath = '" & appPath & "'")
HandleError("Error after execute WMI Query '" & WMI_WA_DIRECTORY & " WHERE SiteName = '" & webSiteName & "' and ApplicationPath = '" & appPath & "'")
Dim badChar : badChar = InStr(webSiteName, "'")
HandleError("Error occured while checking web site name.")
if (badChar <> 0) Then
Set siteObjs = objWMI.ExecQuery(WMI_WA_SITE)
HandleError("Error after execute WMI Query for applications: " & WMI_WA_SITE)
Else
Set siteObjs = objWMI.ExecQuery(WMI_WA_SITE & " WHERE Name = '" & webSiteName & "'")
HandleError("Error after execute WMI Query for applications: " & WMI_WA_SITE & " WHERE Name = '" & webSiteName & "'")
End If
If NOT IsNull(vdsObj) Then
Dim vdObj, siteObj, site
For Each vdObj in vdsObj
HandleError("Cannot run instruction 'For Each vdObj in vdsObj'")
If NOT IsNull(vdObj) AND NOT IsNull(siteObjs) Then
For Each siteObj in siteObjs
HandleError("Cannot run instruction 'For Each siteObj in siteObjs'")
if NOT IsNull(siteObj) Then
site = siteObj.Name
'Exception happens on accessing Name property of site in case if it contains quote. It do not affect future execution
If UCase(Hex(Err.number)) = UCase("80041017") Then
Err.Clear
End If
HandleError("Cannot get site name for application.")
If UCase(site) = UCase(webSiteName) Then
GetApplicationVRootIIS7 = "/LM/W3SVC/" & UCase(siteObj.Id) & "/Root" & appPath
HandleError("Cannot create ApplicationVRoot for application. Site name: " & site)
End If
End If
Next
End If
Next
End If
HandleError("Error occured while iterating throught Virtual Directories.")
Else
Dim badCharWS : badCharWS = InStr(ApplicationName, "'")
HandleError("Error occured while checking web site name.")
if (badCharWS <> 0) Then
Set siteObjs = objWMI.ExecQuery(WMI_WA_SITE)
HandleError("Error after execute WMI Query for web sites: " & WMI_WA_SITE)
Else
Set siteObjs = objWMI.ExecQuery(WMI_WA_SITE & " WHERE Name = '" & ApplicationName & "'")
HandleError("Error after execute WMI Query for sites: " & WMI_WA_SITE & " WHERE Name = '" & ApplicationName & "'")
End If
Dim siteObjWS, siteWS
If NOT IsNull(siteObjs) Then
For Each siteObjWS in siteObjs
HandleError("Cannot run instruction 'For Each siteObjWS in siteObjs'")
if NOT IsNull(siteObjWS) Then
siteWS = siteObjWS.Name
'Exception happens on accessing Name property of site in case if it contains quote. It do not affect future execution
If UCase(Hex(Err.number)) = UCase("80041017") Then
Err.Clear
End If
HandleError("Cannot get site name.")
If UCase(siteWS) = UCase(ApplicationName) Then
GetApplicationVRootIIS7 = "/LM/W3SVC/" & UCase(siteObjWS.Id) & "/Root"
HandleError("Cannot create ApplicationVRoot for site. Site name: " & siteWS)
End If
End If
Next
End If
HandleError("Error occured while iterating throught Web Sites.")
End If
End Function
Function GetApplicationVRootIIS6(ApplicationName)
On Error Resume Next
Dim Obj
Dim IISObjRoot
Dim IISObj : Set IISObj = getobject("IIS://Localhost/W3SVC")
HandleError("Cannot get object IIS://Localhost/W3SVC")
Dim WebSiteName
For Each Obj in IISObj
HandleError("Cannot run instruction 'For Each Obj in IISObj'")
if (Obj.Class = "IIsWebServer") then
Dim Path : Path = "IIS://Localhost/W3SVC/" & Obj.Name & "/Root"
Set IISObjRoot = getobject(path)
HandleError("Cannot get IIS object: " & Path)
Dim isEmptyServerComment : isEmptyServerComment = false
If Trim(Obj.ServerComment) = "" Then
WebSiteName = IISObjRoot.AppFriendlyName
isEmptyServerComment = true
Else
WebSiteName = Obj.ServerComment
End If
If (UCase(WebSiteName) = UCase(ApplicationName)) Then
GetApplicationVRootIIS6 = "/LM/W3SVC/" & Obj.Name & "/Root/"
Exit Function
End If
If (IsContainsSiteName(ApplicationName,WebSiteName,isEmptyServerComment)) Then
GetApplicationVRootIIS6 = GetApplicationVRoot("/LM/W3SVC/" & Obj.Name & "/Root", ApplicationName, WebSiteName, isEmptyServerComment)
Dim appPath : appPath = GetApplicationVRoot(Path, ApplicationName, WebSiteName, isEmptyServerComment)
Dim virDir : Set virDir = GetObject(appPath)
If (Err <> 0) Then
If Err.number = -2147024893 Then 'The system cannot find the path specified.
Err.Clear
Else
HandleError("Error while getting virtual directory: " & ApplicationVRoot)
End If
Else
Exit Function
End If
End If
Set IISObjRoot = Nothing
end if
Next
End Function
Function GetApplicationVRoot(path,iisAppName,siteName,isEmptyServerComment)
On Error Resume Next
Dim ApplicationVRoot
If isEmptyServerComment Then
ApplicationVRoot = path & iisAppName
Else
ApplicationVRoot = path & Mid(iisAppName, Len(siteName) + 1)
End If
GetApplicationVRoot = ApplicationVRoot
End Function
Function IsContainsSiteName(iisAppName,siteName,isEmptyServerComment)
On Error Resume Next
Dim isContains : isContains = False
If isEmptyServerComment And (Left(iisAppName,1)="/") Then
isContains = true
Else
Dim iisAppSite : iisAppSite = Left(iisAppName, Len(siteName))
Dim slash : slash = Mid(iisAppName,Len(iisAppSite)+1,1)
If (UCase(iisAppSite) = UCase(siteName)) And ("/" = slash) Then
isContains = true
End If
End If
IsContainsSiteName = isContains
End Function
End Class </Script></ScriptBody>
<TimeoutSeconds>$Config/TimeoutSeconds$</TimeoutSeconds>
</ProbeAction>
</MemberModules>
<Composition>
<Node ID="DataSource"/>
</Composition>
</Composite>
</ModuleImplementation>
<OutputType>System!System.Discovery.Data</OutputType>
<InputType>System!System.BaseData</InputType>
</ProbeActionModuleType>
Home
Show References: