<%
Function GetSections()
On Error Resume Next
dim cmd
set cmd = Server.CreateObject("ADODB.Command")
set cmd.ActiveConnection = conn
cmd.CommandText = "SP_GET_SECTIONS"
cmd.CommandType = adCmdStoredProc
Set GetSections = cmd.execute
If err.number <> 0 Then
Call ReportError("GetSections", err.number, err.description)
End If
set cmd = nothing
On Error Goto 0
End Function
Function GetSelectedSection(intSectionId)
On Error Resume Next
dim cmd
set cmd = Server.CreateObject("ADODB.Command")
set cmd.ActiveConnection = conn
cmd.CommandText = "SP_GET_SELECTED_SECTION"
cmd.CommandType = adCmdStoredProc
cmd.Parameters.Append cmd.CreateParameter("SECTION_ID", adInteger, adParamInput, , intSectionId)
Set GetSelectedSection = cmd.execute
If err.number <> 0 Then
Call ReportError("GetSelectedSection", err.number, err.description)
End If
set cmd = nothing
On Error Goto 0
End Function
Function GetURLsOptions(intUrlId)
On Error Resume Next
dim rsOptions
dim strURLsOptions
Set rsOptions = GetURLs()
strURLsOptions = ""
If Not rsOptions.Eof Then
Do While Not rsOptions.Eof
strURLsOptions = strURLsOptions & "" & vbCRLF
rsOptions.MoveNext
Loop
End If
If err.number <> 0 Then
Call ReportError("GetURLsOptions(intSection)", err.number, err.description)
End If
rsOptions.Close
set rsOptions = Nothing
GetURLsOptions = strURLsOptions
On Error Goto 0
End Function
Sub ModifySection(intSectionId, strSectionName, intUrlId)
On Error Resume Next
dim cmd
If intUrlId = "" Then
intUrlId = Null
End If
set cmd = Server.CreateObject("ADODB.Command")
set cmd.ActiveConnection = conn
cmd.CommandText = "SP_SET_SECTION"
cmd.CommandType = adCmdStoredProc
cmd.Parameters.Append cmd.CreateParameter("SECTION_ID", adInteger, adParamInput, , intSectionId)
cmd.Parameters.Append cmd.CreateParameter("URL_ID", adInteger, adParamInput, , intUrlId)
cmd.Parameters.Append cmd.CreateParameter("SECTION_NAME_ENG", adVarchar, adParamInput, 100, strSectionName)
cmd.execute
If err.number <> 0 Then
Call ReportError("ModifySection", err.number, err.description)
End If
set cmd = nothing
On Error Goto 0
End Sub
Sub AddSection(strSectionName, intPositionId, intUrlId, intParentId)
dim cmd
dim bolSectionCanHaveMoreChildren
dim intMaximumNumberOfLevels
If intUrlId = "" Then
intUrlId = Null
End If
intMaximumNumberOfLevels = 5
bolSectionCanHaveMoreChildren = SectionCanHaveMoreChildren(intParentId, intMaximumNumberOfLevels)
set cmd = Server.CreateObject("ADODB.Command")
set cmd.ActiveConnection = conn
cmd.CommandText = "SP_INSERT_SECTION"
cmd.CommandType = adCmdStoredProc
cmd.Parameters.Append cmd.CreateParameter("SECTION_CAN_HAVE_MORE_CHILDREN", adInteger, adParamInput, , bolSectionCanHaveMoreChildren)
cmd.Parameters.Append cmd.CreateParameter("SECTION_ORDER", adInteger, adParamInput, , intPositionId)
cmd.Parameters.Append cmd.CreateParameter("PARENT_ID", adInteger, adParamInput, , intParentId)
cmd.Parameters.Append cmd.CreateParameter("URL_ID", adInteger, adParamInput, , intUrlId)
cmd.Parameters.Append cmd.CreateParameter("SECTION_NAME_ENG", adVarchar, adParamInput, 100, strSectionName)
cmd.execute
If err.number <> 0 Then
Call ReportError("AddSection", err.number, err.description)
End If
set cmd = nothing
On Error Goto 0
End Sub
Sub DeleteSection(intSectionId)
On Error Resume Next
dim cmd
set cmd = Server.CreateObject("ADODB.Command")
set cmd.ActiveConnection = conn
cmd.CommandText = "SP_DELETE_SECTION"
cmd.CommandType = adCmdStoredProc
cmd.Parameters.Append cmd.CreateParameter("SECTION_ID", adInteger, adParamInput, , intSectionId)
cmd.execute
If err.number <> 0 Then
Call ReportError("DeleteSection", err.number, err.description)
End If
set cmd = nothing
On Error Goto 0
End Sub
Function SectionCanHaveMoreChildren(intParentId, intMaximumNumberOfLevels)
On Error Resume Next
dim intTopSectionId
intTopSectionId = 7
SectionCanHaveMoreChildren = CBool((GetSectionLevel(intParentId, intTopSectionId) + 1) < intMaximumNumberOfLevels)
On Error Goto 0
End Function
Function GetSectionLevel(byVal intSectionId, intTopSectionId)
On Error Resume Next
dim intParentId
dim intSectionLevel
intParentId = 0
intSectionLevel = 0
Do While Not (intParentId = intTopSectionId)
intParentId = GetParent(intSectionId)
intSectionId = intParentId
intSectionLevel = intSectionLevel + 1
Loop
GetSectionLevel = intSectionLevel
On Error Goto 0
End Function
Function GetSectionsOptionsList(intParentId)
dim rsSections
dim strOptionsList
Set rsSections = GetSubsections(intParentId)
strOptionsList = ""
Do While Not rsSections.EOF
strOptionsList = strOptionsList & ""
rsSections.MoveNext
Loop
rsSections.Close
Set rsSections = Nothing
If err.number <> 0 Then
Call ReportError("GetSectionsOptionsList", err.number, err.description)
End If
GetSectionsOptionsList = strOptionsList
End Function
Function GetSubsectionCount(intParentId)
On Error Resume Next
dim cmd
set cmd = Server.CreateObject("ADODB.Command")
set cmd.ActiveConnection = conn
cmd.CommandText = "SP_GET_SUBSECTION_COUNT"
cmd.CommandType = adCmdStoredProc
cmd.Parameters.Append cmd.CreateParameter("SECTION_COUNT", adInteger, adParamOutput)
cmd.Parameters.Append cmd.CreateParameter("PARENT_ID", adInteger, adParamInput, , intParentId)
cmd.execute
GetSubsectionCount = cmd.Parameters("SECTION_COUNT")
If err.number <> 0 Then
Call ReportError("GetSubsectionCount", err.number, err.description)
End If
set cmd = nothing
On Error Goto 0
End Function
Sub ModifySectionSortOrder(strSectionList, strDelimiter)
On Error Resume Next
dim arSections
dim intArrayCounter
dim intSectionCounter
arSections = Split(strSectionList, strDelimiter)
intSectionCounter = 0
For intArrayCounter = LBound(arSections) To UBound(arSections)
If Trim(arSections(intArrayCounter)) <> "" Then
intSectionCounter = intSectionCounter + 1
Call SetSectionSortOrder(CInt(arSections(intArrayCounter)), CInt(intSectionCounter))
intArrayCounter = intArrayCounter + 1
End If
Next
If err.number <> 0 Then
Call ReportError("ModifySectionSortOrder", err.number, err.description)
End If
On Error Goto 0
End Sub
Sub SetSectionSortOrder(intSectionId, intPositionId)
On Error Resume Next
dim cmd
set cmd = Server.CreateObject("ADODB.Command")
set cmd.ActiveConnection = conn
cmd.CommandText = "SP_SET_SECTION_ORDER"
cmd.CommandType = adCmdStoredProc
cmd.Parameters.Append cmd.CreateParameter("SECTION_ID", adInteger, adParamInput, , intSectionId)
cmd.Parameters.Append cmd.CreateParameter("SECTION_ORDER", adInteger, adParamInput, , intPositionId)
cmd.execute
If err.number <> 0 Then
Call ReportError("SetSectionSortOrder", err.number, err.description)
End If
set cmd = nothing
On Error Goto 0
End Sub
Function ManageDHTMLNav(intNumberOfFirstLineMenuItems, level1)
dim strDHTMLNav
dim rsLevel1, rsLevel2
dim intLevel1ItemId, intLevel2ItemId
dim strLevel1ItemName, strLevel2ItemName
dim strLevel1ItemURL, strLevel2ItemURL
dim intLevel1MenuItemCounter
dim intLevel2MenuItemCounter
dim intSelected1stLevelId
dim intSelected2ndLevelId
dim intLevel2ItemCount
strDHTMLNav = ""
intLevel1MenuItemCounter = 0
Set rsLevel1 = GetSubsections(7)
If Not rsLevel1.Eof Then
Do While Not rsLevel1.Eof
intLevel1MenuItemCounter = intLevel1MenuItemCounter + 1
If intLevel1MenuItemCounter > intNumberOfFirstLineMenuItems Then
Exit Do
End If
intLevel1ItemId = rsLevel1("SECTION_ID")
strLevel1ItemName = rsLevel1("SECTION_NAME_ENG")
strLevel1ItemURL = rsLevel1("URL_ENG")
intLevel2ItemCount = GetSubsectionCount(intLevel1ItemId)
strDHTMLNav = strDHTMLNav & "Menu" & intLevel1MenuItemCounter & "=new Array(""" & LCase(strLevel1ItemName) & """,""" & strLevel1ItemURL & """,""""," & intLevel2ItemCount & ",16,1,"""","""","""","""","""","""",-1,-1,-1,"""","""");" & vbCRLF
Set rsLevel2 = GetSubsections(intLevel1ItemId)
If Not rsLevel2.Eof Then
intLevel2MenuItemCounter = 0
Do While Not rsLevel2.Eof
intLevel2MenuItemCounter = intLevel2MenuItemCounter + 1
intLevel2ItemId = rsLevel2("SECTION_ID")
strLevel2ItemName = rsLevel2("SECTION_NAME_ENG")
strLevel2ItemURL = rsLevel2("URL_ENG")
strDHTMLNav = strDHTMLNav & "Menu" & intLevel1MenuItemCounter & "_" & intLevel2MenuItemCounter & "=new Array(""" & strLevel2ItemName & """,""" & strLevel2ItemURL & ""","""",0,15,150,""#C89328"",""#FFFFFF"",""#000000"",""#000000"",""#FFFFFF"",""arial,verdana,sans-serif"",8,-1,-1,"""","""");" & vbCRLF
rsLevel2.MoveNext
Loop
End If
rsLevel1.MoveNext
Loop
End If
rsLevel1.Close
Set rsLevel1 = Nothing
If IsObject(rsLevel2) Then
rsLevel2.Close
Set rsLevel2 = Nothing
End If
ManageDHTMLNav = strDHTMLNav
If err.number <> 0 Then
Call ReportError("ManageDHTMLNav", err.number, err.description)
End If
On Error Goto 0
End Function
Function ManageDHTMLNav2(intNumberOfFirstLineMenuItems, level1)
dim strDHTMLNav
dim rsLevel1, rsLevel2
dim intLevel1ItemId, intLevel2ItemId
dim strLevel1ItemName, strLevel2ItemName
dim strLevel1ItemURL, strLevel2ItemURL
dim intLevel1MenuItemCounter
dim intLevel2MenuItemCounter
dim intSelected1stLevelId
dim intSelected2ndLevelId
dim intLevel2ItemCount
dim intLevel1ColWidth
strDHTMLNav = ""
intLevel1MenuItemCounter = 0
Set rsLevel1 = GetSubsections(7)
If Not rsLevel1.Eof Then
Do While Not rsLevel1.Eof
intLevel1MenuItemCounter = intLevel1MenuItemCounter + 1
If intLevel1MenuItemCounter > intNumberOfFirstLineMenuItems Then
Exit Do
End If
intLevel1ItemId = rsLevel1("SECTION_ID")
strLevel1ItemName = rsLevel1("SECTION_NAME_ENG")
strLevel1ItemURL = rsLevel1("URL_ENG")
strLevel1ItemClass = "firstlevel"
bolSubsectionIsCurrentURL = SubsectionIsCurrentURL(intLevel1ItemId, strCurrentURL)
intLevel2ItemCount = GetSubsectionCount(intLevel1ItemId)
Select Case LCase(strLevel1ItemName)
Case "about us"
intLevel1ColWidth = 60
Case "programs"
intLevel1ColWidth = 65
Case "professionals"
intLevel1ColWidth = 90
Case "employers"
intLevel1ColWidth = 75
Case "academic partners"
intLevel1ColWidth = 115
Case "organization & government partners"
intLevel1ColWidth = 215
End Select
strDHTMLNav = strDHTMLNav & "addMainItem(""" & strLevel1ItemURL & """,""" & LCase(strLevel1ItemName) & """," & intLevel1ColWidth & ",""center"","""","""",0,0,""u"");" & vbCRLF
Set rsLevel2 = GetSubsections(intLevel1ItemId)
If Not rsLevel2.Eof Then
strDHTMLNav = strDHTMLNav & "defineSubmenuProperties(100,""left"",""left"",0,0,"""");"
intLevel2MenuItemCounter = 0
Do While Not rsLevel2.Eof
intLevel2MenuItemCounter = intLevel2MenuItemCounter + 1
intLevel2ItemId = rsLevel2("SECTION_ID")
strLevel2ItemName = rsLevel2("SECTION_NAME_ENG")
strLevel2ItemURL = rsLevel2("URL_ENG")
strLevel2ItemClass = "secondlevel"
bolSubsectionIsCurrentURL = SubsectionIsCurrentURL(intLevel2ItemId, strCurrentURL)
strDHTMLNav = strDHTMLNav & "addSubmenuItem(""" & strLevel2ItemURL & """,""" & strLevel2ItemName & ""","""","""");" & vbCRLF
rsLevel2.MoveNext
Loop
End If
rsLevel1.MoveNext
Loop
End If
rsLevel1.Close
Set rsLevel1 = Nothing
If IsObject(rsLevel2) Then
rsLevel2.Close
Set rsLevel2 = Nothing
End If
ManageDHTMLNav2 = strDHTMLNav
If err.number <> 0 Then
Call ReportError("ManageDHTMLNav2", err.number, err.description)
End If
On Error Goto 0
End Function
Function GetStringSectionsWithNoChildren()
On Error Resume Next
dim strURLjsArray
dim rsURLs
dim intURLcounter
strURLjsArray = ""
intURLcounter = 0
Set rsURLs = GetSectionsWithNoChildren()
Do While Not rsURLs.Eof
If intURLcounter <> 0 Then
strURLjsArray = strURLjsArray & ", "
End If
strURLjsArray = strURLjsArray & """" & rsURLs("SECTION_ID") & """"
intURLcounter = intURLcounter + 1
rsURLs.MoveNext
Loop
GetStringSectionsWithNoChildren = strURLjsArray
If err.number <> 0 Then
Call ReportError("GetStringSectionsWithNoChildren", err.number, err.description)
End If
On Error Goto 0
End Function
Function GetSectionsWithNoChildren()
On Error Resume Next
dim cmd
set cmd = Server.CreateObject("ADODB.Command")
set cmd.ActiveConnection = conn
cmd.CommandText = "SP_GET_URLS_WITH_NO_CHILDREN"
cmd.CommandType = adCmdStoredProc
Set GetSectionsWithNoChildren = cmd.execute
If err.number <> 0 Then
Call ReportError("GetSectionsWithNoChildren", err.number, err.description)
End If
set cmd = nothing
On Error Goto 0
End Function
%>