<% '==================================================
' Microsoft Server Appliance
'
' Copyright (c) Microsoft Corporation. All rights reserved.
'================================================== %>
<%
'
' The tab container
'
Public Const TAB_CONTAINER = "TABS"
Dim strSourceNameLoc
Dim g_iNextTabId
g_iNextTabId = 0
strSourceNameLoc = "sakitmsg.dll"
Set objLocMgr = Server.CreateObject("ServerAppliance.LocalizationManager")
if Err.number <> 0 then
Response.Write "Error in localizing the web content "
Response.End
end if
'-----------------------------------------------------
'START of localization content
dim L_HELPTOOLTIP_TEXT
dim L_ABOUTLABEL_TEXT
L_HELPTOOLTIP_TEXT = objLocMgr.GetString(strSourceNameLoc,"&H40010023", varReplacementStrings)
L_ABOUTLABEL_TEXT = objLocMgr.GetString(strSourceNameLoc,"&H40010025", varReplacementStrings)
'End of localization content
'-----------------------------------------------------
Set ObjLocMgr = nothing
'
' Outputs the tab bar
'
Public Function ServeTabBar()
SA_ServeTabBar(TAB_CONTAINER)
End Function
' --------------------------------------------------------------
'
' Function: SA_ServeEmptyTabBar
'
' Synopsis: Serve an empty tab bar
'
' Arguments: None
'
' Returns: Nothing
'
' --------------------------------------------------------------
Public Function SA_ServeEmptyTabBar()
SA_ClearError()
Call EmitTabPageHeader()
'
' First level tabs
'
rw ""
rw ""
' This sets the height of the table
rw "| "
rw " |
"
'
' Second level tabs
rw ""
rw ""
' this sets the height of the second-level tabs
rw "| "
' close table
rw " |
"
Call SA_SetLastError(gc_ERR_SUCCESS, "TABS.SA_ServeEmptyTabBar")
SA_ServeEmptyTabBar = gc_ERR_SUCCESS
End Function
Public Function SA_ServeTabBar(ByVal strTabContainer)
Dim colTabs
Call EmitTabPageHeader()
Set colTabs = GetElements(strTabContainer)
Call Assert(colTabs.Count > 0, "No tabs found in container " + strTabContainer)
' the selected tab of interest
Dim sSelectedID
sSelectedID = GetTab1()
' the element we're currently at
Dim sElementID
' the IWebElement object
Dim objElement
' the secondLevelContainer
Dim sSecondLevelContainer
sSecondLevelContainer = ""
'
' First level tabs
'
rw ""
rw ""
For Each objElement In colTabs
sElementID = objElement.GetProperty("ElementID")
rw GetTabLink(objElement, sElementID, IsSameElementID(sElementID, sSelectedID))
If IsSameElementID(sElementID, sSelectedID) Then
sSecondLevelContainer = GetLinksContainer(objElement)
End If
Next ' objElement
Set colTabs = Nothing
' This sets the height of the table
rw "| "
' this is the help link (or menu)
Call ServeContextHelp()
rw " | "
rw "
"
If sSecondLevelContainer = "" Then
' nothing was selected and we can't display the next menu
' set up the table
rw ""
rw ""
' this sets the height of the second-level tabs
rw "| "
' close table
rw " |
"
Exit Function
End If
' now look in this collection
Set colTabs = GetElements(sSecondLevelContainer)
' get the selected tab
sSelectedID = GetTab2()
' set up the table
rw ""
rw ""
' go through the collection, output as a TaskLink
For Each objElement In colTabs
sElementID = objElement.GetProperty("ElementID")
rw GetTaskLink(objElement, sElementID, IsSameElementID(sElementID, sSelectedID))
' don't check to see if it's selected because we don't care (only 2 levels deep)
Next 'objElement
Set colTabs = Nothing
' this sets the height of the second-level tabs
rw "| | "
' close table
rw "
"
Call EmitTabPageFooter()
End Function
Private Function ServeContextHelp()
Dim objContextHelp
Dim objElement
Set objContextHelp = GetElements("ContextHelpLink")
For each objElement in objContextHelp
Dim strCaption
Dim strDescription
Dim strLongDescription
Dim strURL
Dim strResourceDLL
strResourceDLL = objElement.GetProperty("Source")
strCaption = GetLocalized(strResourceDLL, objElement.GetProperty("CaptionRID"))
If ( Len( objElement.GetProperty("DescriptionRID") ) > 0 ) Then
strDescription = GetLocalized(strResourceDLL, objElement.GetProperty("DescriptionRID"))
Else
strDescription = ""
End If
If ( Len( objElement.GetProperty("LongDescriptionRID") ) > 0 ) Then
'strLongDescription = SA_EncodeQuotes(GetLocalized(strResourceDLL, objElement.GetProperty("LongDescriptionRID")))
strLongDescription = GetLocalized(strResourceDLL, objElement.GetProperty("LongDescriptionRID"))
Else
strLongDescription = ""
End If
strURL = objElement.GetProperty("URL")
strURL = strURL & "?" & SAI_FLD_PAGEKEY & "=" & SAI_GetPageKey() & _
"&URL=" & Server.URLEncode(Request.ServerVariables("URL") & _
"?" & Request.ServerVariables("QUERY_STRING"))
Response.Write(" ")
Response.Write("?")
Response.Write(" ")
Exit For
Next
End Function
Function GetElements(container)
'Return collection of IWebElement objects based on the Container parm.
Dim objRetriever
Dim objElements
Set objRetriever = Server.CreateObject("Elementmgr.ElementRetriever")
Set objElements = objRetriever.GetElements(1, container)
Set GetElements = objElements
Set objElements = Nothing
Set objRetriever = Nothing
End Function
Function IsRawURLPage(ByVal pageType)
On Error Resume Next
IsRawURLPage = FALSE
If ( UCase(pageType) = "RAW" ) Then
IsRawURLPage = TRUE
End If
Err.Clear
End Function
'
'' Wrapper for Response.Write
'
Function rw(v)
Response.Write v
Response.Write vbCrLf
End Function
'
'' Gets the first level tab, always a string
'
Function GetTab1()
Dim strTab
strTab = Request.QueryString("tab1")
if strTab = "" then
strTab = Request.Form("tab1")
end if
GetTab1 = strTab
End Function
'
'' Gets the second level tab, always a string
'
Function GetTab2()
Dim strTab
strTab = Request.QueryString("tab2")
if strTab = "" then
strTab = Request.Form("tab2")
end if
GetTab2 = strTab
End Function
'
''Get the URL for the current Primary Tab
'
Private Function SAI_GetCurrentPrimaryTabURL(ByVal bIncludeVirtualRoot)
Dim strLink
Dim colTabs
Set colTabs = GetElements(TAB_CONTAINER)
' the selected tab of interest
Dim sSelectedID
sSelectedID = GetTab1()
' the element we're currently at
Dim sElementID
' the IWebElement object
Dim objElement
' go through each element and find the current one
For Each objElement In colTabs
sElementID = objElement.GetProperty("ElementID")
If IsSameElementID(sElementID, sSelectedID) Then
strLink = objElement.GetProperty("URL")
If InStr(strLink, "?") = 0 Then
strLink = strLink & "?tab1=" & sElementID
else
strLink = strLink & "&tab1=" & sElementID
end if
Exit For
End If
Next ' objElement
Set colTabs = Nothing
If ( TRUE = bIncludeVirtualRoot ) Then
strLink = GetVirtualDirectory() & strLink
End If
If (0 = InStr(1, strLink, ":")) Then
Call SA_MungeURL(strLink, SAI_FLD_PAGEKEY, SAI_GetPageKey())
End If
SAI_GetCurrentPrimaryTabURL = strLink
End Function
Public Function GetCurrentPrimaryTabURL()
GetCurrentPrimaryTabURL = SAI_GetCurrentPrimaryTabURL(TRUE)
End Function
'
'' Asserts that bCondition is true
'
Function Assert(ByVal bCondition, ByVal sText)
If Not bCondition Then
Err.Raise 1, sText
Response.End
End If
End Function
'
'' Returns the Container that should be used to find children elements
'' (was the Source and CaptionRID, now it's the ElementID)
'
Function GetLinksContainer(objElement)
Dim s
' s = objElement.GetProperty("Source")
' s = s & objElement.GetProperty("CaptionRID")
s = objElement.GetProperty("ElementID")
GetLinksContainer = s
End Function
'
'' Returns the title and onmouseover encoding for inside any html element.
'
Function GetHoverText(ByVal sText, ByVal sClassName)
on error goto 0
Dim s
Dim sStatusText
sStatusText = sText
sStatusText = SA_EncodeQuotes(sStatusText)
s = " title=""" + Server.HTMLEncode(sText) + """ "
s = s & " onmouseout=""window.status=''; this.className='" & sClassName & "NoBorder';return true;"" "
s = s & " onmouseover=""window.status='" + sStatusText + "'; this.className='" + sClassName + "NoBorderHover" + "'; return true;"" "
GetHoverText = s
End Function
'
'' Returns the localized string (should use LocMan)
'
Function GetLocalized(sSourceDLL, sHex)
dim varReplacementStrings
' GetLocalized = sSourceDLL & sHex
GetLocalized = getLocString(sSourceDLL, sHex, varReplacementStrings)
If GetLocalized = "" then
GetLocalized = sSourceDLL & sHex
End If
End Function
Function GetLink(objElement, sHref, sClassName, sClassName2, bAddReturnURL)
on error resume next
Dim s
Dim strURL
Dim strTitle
Dim strTaskTitle
Dim strPageType
Dim strWindowFeatures
Dim sReturnURL
Dim sOpenPageURL
strTitle = GetLocalized(objElement.GetProperty("Source"), objElement.GetProperty("CaptionRID"))
strTaskTitle = strTitle
strPageType = objElement.GetProperty("PageType")
strWindowFeatures = objElement.GetProperty("WindowFeatures")
'make the href
s = " "
if objElement.GetProperty("IsEmbedded") = 1 then
s = s & " 0) Then
Select Case UCase(Trim(strPageType))
Case "NORMAL"
sOpenPageURL = sHref
If ( TRUE = bAddReturnURL ) Then
sReturnURL = SAI_GetCurrentPrimaryTabURL(FALSE)
Call SA_MungeURL(sOpenPageURL, "ReturnURL", sReturnURL)
End If
strURL = "javascript:OpenNormalPage('" & m_VirtualRoot & "', '" & sOpenPageURL & "');"
Case "FRAMESET"
strURL = "javascript:OpenPage('" & m_VirtualRoot & "', '" & sHref & "', '"+GetCurrentPrimaryTabURL()+"', '" & SA_EncodeQuotes(strTaskTitle) & "');"
Case "NEW"
strURL = "javascript:OpenNewPage('" & m_VirtualRoot & "', '" & sHref & "', '" & strWindowFeatures & "');"
Case "RAW"
strURL = "javascript:OpenRawPageEx('" & sHref & "', '" & strWindowFeatures & "');"
Case Else
SA_TraceOut "TABS", "Invalid Task PageType: " + strPageType
sOpenPageURL = sHref
If ( TRUE = bAddReturnURL ) Then
sReturnURL = SAI_GetCurrentPrimaryTabURL(FALSE)
Call SA_MungeURL(sOpenPageURL, "ReturnURL", sReturnURL)
End If
strURL = "javascript:OpenNormalPage('" & m_VirtualRoot & "', '" & sOpenPageURL & "');"
End Select
s = s + " 0 ) Then
s = s & GetHoverText(GetLocString(objElement.GetProperty("Source"), objElement.GetProperty("DescriptionRID"), ""), sClassName)
Else
s = s & GetHoverText("", sClassName)
End If
'build link content from the CaptionRID
s = s & ">" & strTitle
'close link
s = s & " | "
s = s & ""
s = s & "![](" + m_VirtualRoot + "images/TabSeparator.gif) "
s = s & " | "
GetLink = s
End Function
'
'' Adds i s to both sides of v
'
Function GetPadded(v, i)
Dim s
s = Replace(String(i, " "), " ", " ")
GetPadded = s & v & s
End Function
'
'' This is an equivalent of VB's IIf function. Both vIfTrue and vIfFalse are evaluated,
'' unlike the ternary ? : operator (watch for side effects [div 0, etc.]).
'
Function IIf(bCondition, vIfTrue, vIfFalse)
If bCondition Then
IIf = vIfTrue
Else
IIf = vIfFalse
End If
End Function
'
'' Formats the tab link, differently if bIsSelected
'
Function GetTabLink(objElement, sElementID, bIsSelected)
on error resume next
Dim strLink
Dim pageType
pageType = objElement.GetProperty("PageType")
'
' We do not alter RAW URL's
If ( IsRawURLPage(pageType) ) Then
strLink = objElement.GetProperty("URL")
'
' All other PageTypes have the current tab selections appended to the URL
Else
strLink = objElement.GetProperty("URL")
If InStr(strLink, "?") = 0 Then
strLink = strLink & "?tab1=" & objElement.GetProperty("ElementID") 'Server.URLEncode(GetTab1())
else
strLink = strLink & "&tab1=" & objElement.GetProperty("ElementID") 'Server.URLEncode(GetTab1())
end if
End If
If (0 = InStr(1, strLink, ":")) Then
Call SA_MungeURL(strLink, SAI_FLD_PAGEKEY, SAI_GetPageKey())
End If
'response.write "URL is " & strLink & ""
GetTabLink = GetLink(objElement, strLink, IIf(bIsSelected, "ActiveTab", "InActiveTab"), "InActiveTab", FALSE)
End Function
'
'' Formats the task link, differently if bIsSelected
'
Function GetTaskLink(objElement, sElementID, bIsSelected)
on error resume next
Dim strLink
Dim pageType
pageType = objElement.GetProperty("PageType")
'
' We do not alter RAW URL's
If ( IsRawURLPage(pageType) ) Then
strLink = objElement.GetProperty("URL")
'
' All other PageTypes have the current tab selections appended to the URL
Else
strLink = objElement.GetProperty("URL")
If InStr(strLink, "?") = 0 Then
strLink = strLink & "?tab1=" & Server.URLEncode(GetTab1())
else
strLink = strLink & "&tab1=" & Server.URLEncode(GetTab1())
end if
strLink = strLink & "&tab2=" & Server.URLEncode(sElementID)
End If
If (0 = InStr(1, strLink, ":")) Then
Call SA_MungeURL(strLink, SAI_FLD_PAGEKEY, SAI_GetPageKey())
End If
GetTaskLink = GetLink(objElement, strLink, IIf(bIsSelected, "ActiveTab2", "InActiveTab2"), "InActiveTab2", TRUE)
End Function
'
'' Returns true if these are the same element ID. Mainly for capitalization
'' and or/charset issues. Uses case-insensitive, space-trimmed comparison.
'' Has issues with unicode registry keys.
'
Function IsSameElementID(ByVal sElementID1, ByVal sElementID2)
Dim s1, s2
s1 = LCase(Trim(sElementID1))
s2 = LCase(Trim(sElementID2))
IsSameElementID = CBool(s1 = s2)
End Function
Private Function GetNextTabId()
GetNextTabId = g_iNextTabId
g_iNextTabId = g_iNextTabId + 1
End Function
Private Function EmitTabPageHeader()
%>
<%
Call SA_EmitAdditionalStyleSheetReferences("")
%>
<%
End Function
Private Function EmitTabPageFooter()
%>
<%
End Function
%>