<% Function GetUrlCount() On Error Resume Next dim cmd set cmd = Server.CreateObject("ADODB.Command") set cmd.ActiveConnection = conn cmd.CommandText = "SP_GET_URL_COUNT" cmd.CommandType = adCmdStoredProc cmd.Parameters.Append cmd.CreateParameter("URL_COUNT", adInteger, adParamOutput) cmd.execute If err.number <> 0 Then Call ReportError("GetUrlCount", err.number, err.description) End If GetUrlCount = cmd.Parameters("URL_COUNT") set cmd = nothing On Error Goto 0 End Function Function ManageURLs(intCurrentPage, intUrlsDisplayedPerPage) On Error Resume Next dim strUrlLinks dim rsUrls dim intUrlCount dim intUrlId dim intDisplayTypeId dim strURL dim strSection dim intCounter intUrlCount = GetUrlCount() If intUrlCount = 0 Then Response.Write "

There are currently no URLs.

" Else Set rsUrls = GetUrls() strUrlLinks = "" & vbCRLF intCounter = 0 Do While Not rsUrls.Eof intCounter = intCounter + 1 If intCounter > ((intCurrentPage-1)*intUrlsDisplayedPerPage) And intCounter <= (intCurrentPage*intUrlsDisplayedPerPage) Then intUrlId = rsUrls("URL_ID") strURL = rsUrls("URL_ENG") intDisplayTypeId = rsUrls("DISPLAY_TYPE_ID") strUrlLinks = strUrlLinks & "" & vbCRLF strUrlLinks = strUrlLinks & "" & vbCRLF strUrlLinks = strUrlLinks & "" & vbCRLF strUrlLinks = strUrlLinks & "" & vbCRLF strUrlLinks = strUrlLinks & "" & vbCRLF strUrlLinks = strUrlLinks & "" & vbCRLF strUrlLinks = strUrlLinks & "" & vbCRLF strUrlLinks = strUrlLinks & "" & vbCRLF End If rsUrls.MoveNext Loop rsUrls.Close Set rsUrls = Nothing strUrlLinks = strUrlLinks & "
" & vbCRLF strUrlLinks = strUrlLinks & "" & strURL & "" & vbCRLF strUrlLinks = strUrlLinks & "" & vbCRLF strUrlLinks = strUrlLinks & "Edit" & vbCRLF strUrlLinks = strUrlLinks & "" & vbCRLF strUrlLinks = strUrlLinks & "Delete" & vbCRLF strUrlLinks = strUrlLinks & "
" & vbCRLF strUrlLinks = strUrlLinks & "" & vbCRLF strUrlLinks = strUrlLinks & "
" & vbCRLF End If If err.number <> 0 Then Call ReportError("ManageURLs", err.number, err.description) End If ManageURLs = strUrlLinks On Error Goto 0 End Function Function GetSectionsOptionsForURL(intSectionId) On Error Resume Next dim rsSections dim strSectionsOptionsForURL strSectionsOptionsForURL = "" Set rsSections = GetSections() If Not rsSections.Eof Then Do While Not rsSections.Eof strSectionsOptionsForURL = strSectionsOptionsForURL & "" & vbCRLF rsSections.MoveNext Loop Else strSectionsOptionsForURL = strSectionsOptionsForURL & "" End If rsSections.Close Set rsSections = Nothing GetSectionsOptionsForURL = strSectionsOptionsForURL If err.number <> 0 Then Call ReportError("GetSectionsOptionsForURL", err.number, err.description) End If On Error Goto 0 End Function 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 Sub ModifyUrl(intUrlId, intDisplayTypeId, intPostingTypeId, intDynamicFormId, bolAltTemplate, strUrl, strUrlBody) On Error Resume Next dim cmd set cmd = Server.CreateObject("ADODB.Command") set cmd.ActiveConnection = conn cmd.CommandText = "SP_SET_URL" cmd.CommandType = adCmdStoredProc cmd.Parameters.Append cmd.CreateParameter("URL_ID", adInteger, adParamInput, , intUrlId) cmd.Parameters.Append cmd.CreateParameter("DISPLAY_TYPE_ID", adInteger, adParamInput, , intDisplayTypeId) cmd.Parameters.Append cmd.CreateParameter("POSTING_TYPE_ID", adInteger, adParamInput, , intPostingTypeId) cmd.Parameters.Append cmd.CreateParameter("DYNAMIC_FORM_ID", adInteger, adParamInput, , intDynamicFormId) cmd.Parameters.Append cmd.CreateParameter("URL_USES_ALT_TEMPLATE", adInteger, adParamInput, , Abs(CInt(bolAltTemplate))) cmd.Parameters.Append cmd.CreateParameter("URL_ENG", adVarchar, adParamInput, 250, strUrl) If strUrlBody <> "" Then cmd.Parameters.Append cmd.CreateParameter("URL_BODY_ENG", adLongVarChar, adParamInput, Len(strUrlBody), strUrlBody) End If cmd.execute If err.number <> 0 Then Call ReportError("ModifyUrl", err.number, err.description) End If set cmd = nothing On Error Goto 0 End Sub Function AddUrl(intDisplayTypeId, intPostingTypeId, intDynamicFormId, bolAltTemplate, strUrl, strUrlBody) On Error Resume Next dim cmd set cmd = Server.CreateObject("ADODB.Command") set cmd.ActiveConnection = conn cmd.CommandText = "SP_INSERT_URL" cmd.CommandType = adCmdStoredProc cmd.Parameters.Append cmd.CreateParameter("URL_ID", adInteger, adParamOutput) cmd.Parameters.Append cmd.CreateParameter("DISPLAY_TYPE_ID", adInteger, adParamInput, , intDisplayTypeId) cmd.Parameters.Append cmd.CreateParameter("URL_USES_ALT_TEMPLATE", adInteger, adParamInput, , Abs(CInt(bolAltTemplate))) cmd.Parameters.Append cmd.CreateParameter("URL_ENG", adVarchar, adParamInput, 250, strUrl) cmd.Parameters.Append cmd.CreateParameter("POSTING_TYPE_ID", adInteger, adParamInput, , intPostingTypeId) cmd.Parameters.Append cmd.CreateParameter("DYNAMIC_FORM_ID", adInteger, adParamInput, , intDynamicFormId) If strUrlBody <> "" Then cmd.Parameters.Append cmd.CreateParameter("URL_BODY_ENG", adLongVarChar, adParamInput, Len(strUrlBody), strUrlBody) End If cmd.execute AddUrl = cmd.Parameters("URL_ID") If err.number <> 0 Then Call ReportError("AddUrl", err.number, err.description) End If set cmd = nothing On Error Goto 0 End Function Sub DeleteUrl(intUrlId) On Error Resume Next dim cmd set cmd = Server.CreateObject("ADODB.Command") set cmd.ActiveConnection = conn cmd.CommandText = "SP_DELETE_URL" cmd.CommandType = adCmdStoredProc cmd.Parameters.Append cmd.CreateParameter("URL_ID", adInteger, adParamInput, , intUrlId) cmd.execute If err.number <> 0 Then Call ReportError("DeleteUrl", err.number, err.description) End If set cmd = nothing On Error Goto 0 End Sub Sub DeleteUrlFile(intUrlId) dim strPath dim objFileSystemObject strPath = Server.MapPath(GetUrlFromUrlId(intUrlId)) Set objFileSystemObject = CreateObject("Scripting.FileSystemObject") objFileSystemObject.DeleteFile(strPath) If err.number <> 0 Then Call ReportError("DeleteUrlFile", err.number, err.description) End If Set objFileSystemObject = nothing On Error Goto 0 End Sub Function GetURLjsArray() On Error Resume Next dim strURLjsArray dim rsURLs dim intURLcounter strURLjsArray = "" intURLcounter = 0 Set rsURLs = GetURLs() strURLjsArray = strURLjsArray & "new Array(" Do While Not rsURLs.Eof If intURLcounter <> 0 Then strURLjsArray = strURLjsArray & ", " End If strURLjsArray = strURLjsArray & "'" & rsURLs("URL_ENG") & "'" intURLcounter = intURLcounter + 1 rsURLs.MoveNext Loop strURLjsArray = strURLjsArray & ");" & vbCRLF GetURLjsArray = strURLjsArray If err.number <> 0 Then Call ReportError("GetURLjsArray", err.number, err.description) End If On Error Goto 0 End Function Function GetDisplayTypeOptions(intDisplayTypeId) On Error Resume Next dim strDisplayTypeOptionsList dim rsDisplayTypes dim intTempDisplayTypeId dim strDisplayTypeName strDisplayTypeOptionsList = "" Set rsDisplayTypes = GetDisplayTypes() Do While Not rsDisplayTypes.Eof intTempDisplayTypeId = rsDisplayTypes("DISPLAY_TYPE_ID") strDisplayTypeName = rsDisplayTypes("DISPLAY_TYPE_NAME_ENG") strDisplayTypeOptionsList = strDisplayTypeOptionsList & "" & vbCRLF rsDisplayTypes.MoveNext Loop rsDisplayTypes.Close Set rsDisplayTypes = Nothing GetDisplayTypeOptions = strDisplayTypeOptionsList If err.number <> 0 Then Call ReportError("GetDisplayTypeOptions", err.number, err.description) End If On Error Goto 0 End Function Function GetDisplayTypes() On Error Resume Next dim cmd set cmd = Server.CreateObject("ADODB.Command") set cmd.ActiveConnection = conn cmd.CommandText = "SP_GET_DISPLAY_TYPES" cmd.CommandType = adCmdStoredProc Set GetDisplayTypes = cmd.execute If err.number <> 0 Then Call ReportError("GetDisplayTypes", err.number, err.description) End If set cmd = nothing On Error Goto 0 End Function Function GetDisplayFormPath(intDisplayTypeId) On Error Resume Next dim strDisplayTypeFormPath dim rsDisplayTypes strDisplayTypeFormPath = "" Set rsDisplayTypes = GetDisplayTypes() Do While Not rsDisplayTypes.Eof If ((rsDisplayTypes("DISPLAY_TYPE_ID") = intDisplayTypeId) And (Not IsNull(rsDisplayTypes("DISPLAY_TYPE_FORM_PATH")))) Then strDisplayTypeFormPath = rsDisplayTypes("DISPLAY_TYPE_FORM_PATH") Exit Do End If rsDisplayTypes.MoveNext Loop GetDisplayFormPath = strDisplayTypeFormPath If err.number <> 0 Then Call ReportError("GetDisplayFormPath", err.number, err.description) End If On Error Goto 0 End Function Function GetPostingTypeOptions(intPostingTypeId) On Error Resume Next dim strPostingTypeOptionsList dim rsPostingTypes dim intTempPostingTypeId dim strPostingTypeName strPostingTypeOptionsList = "" Set rsPostingTypes = GetPostingTypes() Do While Not rsPostingTypes.Eof intTempPostingTypeId = rsPostingTypes("POSTING_TYPE_ID") strPostingTypeName = rsPostingTypes("POSTING_TYPE_NAME_ENG") strPostingTypeOptionsList = strPostingTypeOptionsList & "" & vbCRLF rsPostingTypes.MoveNext Loop rsPostingTypes.Close Set rsPostingTypes = Nothing GetPostingTypeOptions = strPostingTypeOptionsList If err.number <> 0 Then Call ReportError("GetPostingTypeOptions", err.number, err.description) End If On Error Goto 0 End Function Function DisplaySiteMap() dim strSiteMap dim intTotalTopLevelSections dim intTopLevelSectionsCounter dim intSectionsPerColumn dim intColumnCounter dim rsLevel1Sections dim rsLevel2Sections dim rsLevel3Sections dim intLevel1SectionId dim intLevel2SectionId dim intLevel3SectionId strSiteMap = "" Set rsLevel1Sections = GetSubsectionsOrderByName(7) intTotalTopLevelSections = 0 intTopLevelSectionsCounter = 0 Do While Not rsLevel1Sections.Eof intTotalTopLevelSections = intTotalTopLevelSections + 1 rsLevel1Sections.MoveNext Loop If (intTotalTopLevelSections Mod 3 = 0) Then intSectionsPerColumn = intTotalTopLevelSections / 3 Else If intTotalTopLevelSections <= 2 Then intSectionsPerColumn = 1 Else intSectionsPerColumn = Int(Int(intTotalTopLevelSections / 3) + (((intTotalTopLevelSections Mod 3) / 3) + 1)) End If End If Set rsLevel1Sections = GetSubsectionsOrderByName(7) If Not rsLevel1Sections.Eof Then strSiteMap = strSiteMap & "" & vbCRLF strSiteMap = strSiteMap & "" & vbCRLF strSiteMap = strSiteMap & "" & vbCRLF strSiteMap = strSiteMap & "" & vbCRLF strSiteMap = strSiteMap & "" & vbCRLF strSiteMap = strSiteMap & "
" & vbCRLF strSiteMap = strSiteMap & "" & vbCRLF Do While Not rsLevel1Sections.Eof intTopLevelSectionsCounter = intTopLevelSectionsCounter + 1 intLevel1SectionId = rsLevel1Sections("SECTION_ID") strSiteMap = strSiteMap & "" & vbCRLF strSiteMap = strSiteMap & "" & vbCRLF strSiteMap = strSiteMap & "" & vbCRLF Set rsLevel2Sections = GetSubsections(intLevel1SectionId) If Not rsLevel2Sections.Eof Then strSiteMap = strSiteMap & "" & vbCRLF strSiteMap = strSiteMap & "" & vbCRLF strSiteMap = strSiteMap & "" & vbCRLF Else strSiteMap = strSiteMap & "" & vbCRLF strSiteMap = strSiteMap & "" & vbCRLF strSiteMap = strSiteMap & "" & vbCRLF End If If (intTopLevelSectionsCounter Mod intSectionsPerColumn = 0) Then strSiteMap = strSiteMap & "
" & vbCRLF strSiteMap = strSiteMap & "" & GetSectionName(intLevel1SectionId) & "" & vbCRLF strSiteMap = strSiteMap & "
" & vbCRLF strSiteMap = strSiteMap & "" & vbCRLF Do While Not rsLevel2Sections.Eof intLevel2SectionId = rsLevel2Sections("SECTION_ID") strSiteMap = strSiteMap & "" & vbCRLF strSiteMap = strSiteMap & "" & vbCRLF strSiteMap = strSiteMap & "" & vbCRLF strSiteMap = strSiteMap & "" & vbCRLF rsLevel2Sections.MoveNext Loop rsLevel2Sections.Close Set rsLevel2Sections = Nothing strSiteMap = strSiteMap & "
" & vbCRLF strSiteMap = strSiteMap & "" & vbCRLF strSiteMap = strSiteMap & "" & vbCRLF strSiteMap = strSiteMap & "" & GetSectionName(intLevel2SectionId) & "" & vbCRLF strSiteMap = strSiteMap & "
" & vbCRLF strSiteMap = strSiteMap & "
" & vbCRLF strSiteMap = strSiteMap & "" & vbCRLF strSiteMap = strSiteMap & "
" & vbCRLF strSiteMap = strSiteMap & "		" & vbCRLF strSiteMap = strSiteMap & "" & vbCRLF End If rsLevel1Sections.MoveNext Loop strSiteMap = strSiteMap & "" & vbCRLF strSiteMap = strSiteMap & "" & vbCRLF strSiteMap = strSiteMap & "
" & vbCRLF strSiteMap = strSiteMap & "
" & vbCRLF End If rsLevel1Sections.Close Set rsLevel1Sections = Nothing DisplaySiteMap = strSiteMap If err.number <> 0 Then Call ReportError("DisplaySiteMap", err.number, err.description) End If On Error Goto 0 End Function Sub SetURLidToNull(intUrlId) On Error Resume Next dim cmd set cmd = Server.CreateObject("ADODB.Command") set cmd.ActiveConnection = conn cmd.CommandText = "SP_SET_URL_ID_TO_NULL" cmd.CommandType = adCmdStoredProc cmd.Parameters.Append cmd.CreateParameter("URL_ID", adInteger, adParamInput, , intUrlId) cmd.execute set cmd = nothing If err.number <> 0 Then Call ReportError("SetURLidToNull", err.number, err.description) End If On Error Goto 0 End Sub Function StripServerName(strHTML) On Error Resume Next dim strServerName dim intServerNameStartPos dim intServerNameEndPos dim intForeSlashPos strServerName = Request.ServerVariables("SERVER_NAME") If InStr(1, strHTML, strServerName) > 0 Then intServerNameStartPos = 1 intServerNameStartPos = InStr(intServerNameStartPos, strHTML, strServerName) intServerNameEndPos = intServerNameStartPos + Len(strServerName) - 1 intForeSlashPos = InStr(intServerNameEndPos, strHTML, "/") strHTML = Replace(strHTML, Mid(strHTML, intServerNameStartPos, intForeSlashPos - intServerNameStartPos), "") End If If InStr(1, strHTML, Request.ServerVariables("LOCAL_ADDR")) > 0 Then strServerName = Request.ServerVariables("LOCAL_ADDR") intServerNameStartPos = 1 intServerNameStartPos = InStr(intServerNameStartPos, strHTML, strServerName) intServerNameEndPos = intServerNameStartPos + Len(strServerName) - 1 intForeSlashPos = InStr(intServerNameEndPos, strHTML, "/") strHTML = Replace(strHTML, Mid(strHTML, intServerNameStartPos, intForeSlashPos - intServerNameStartPos), "") End If StripServerName = strHTML If err.number <> 0 Then Call ReportError("StripServerName", err.number, err.description) End If On Error Goto 0 End Function Function GetStringUrlNames() On Error Resume Next dim strURLjsArray dim rsURLs dim intURLcounter strURLjsArray = "" intURLcounter = 0 Set rsURLs = GetURLs() Do While Not rsURLs.Eof If intURLcounter <> 0 Then strURLjsArray = strURLjsArray & ", " End If strURLjsArray = strURLjsArray & "'" & rsURLs("URL_ID") & "', '" & rsURLs("URL_ENG") & "'" intURLcounter = intURLcounter + 1 rsURLs.MoveNext Loop GetStringUrlNames = strURLjsArray If err.number <> 0 Then Call ReportError("GetStringUrlNames", err.number, err.description) End If On Error Goto 0 End Function Function GetStringRelatedUrlSections() On Error Resume Next dim strURLjsArray dim rsURLs dim intURLcounter strURLjsArray = "" intURLcounter = 0 Set rsURLs = GetRelatedUrlSections() Do While Not rsURLs.Eof If intURLcounter <> 0 Then strURLjsArray = strURLjsArray & ", " End If strURLjsArray = strURLjsArray & """" & rsURLs("URL_ID") & """, """ & rsURLs("SECTION_ID") & """, """ & rsURLs("SECTION_NAME_ENG")& """" intURLcounter = intURLcounter + 1 rsURLs.MoveNext Loop GetStringRelatedUrlSections = strURLjsArray If err.number <> 0 Then Call ReportError("GetStringRelatedUrlSections", err.number, err.description) End If On Error Goto 0 End Function Function GetStringUrlSectionsWithNoChildren() On Error Resume Next dim strURLjsArray dim rsURLs dim intURLcounter strURLjsArray = "" intURLcounter = 0 Set rsURLs = GetUrlSectionsWithNoChildren() Do While Not rsURLs.Eof If intURLcounter <> 0 Then strURLjsArray = strURLjsArray & ", " End If strURLjsArray = strURLjsArray & """" & rsURLs("URL_ID") & """, """ & rsURLs("SECTION_ID") & """" intURLcounter = intURLcounter + 1 rsURLs.MoveNext Loop GetStringUrlSectionsWithNoChildren = strURLjsArray If err.number <> 0 Then Call ReportError("GetStringUrlSectionsWithNoChildren", err.number, err.description) End If On Error Goto 0 End Function Function GetRelatedUrlSections() On Error Resume Next dim cmd set cmd = Server.CreateObject("ADODB.Command") set cmd.ActiveConnection = conn cmd.CommandText = "SP_GET_URLS_IN_MULTIPLE_SECTIONS" cmd.CommandType = adCmdStoredProc Set GetRelatedUrlSections = cmd.execute If err.number <> 0 Then Call ReportError("GetRelatedUrlSections", err.number, err.description) End If set cmd = nothing On Error Goto 0 End Function Function GetUrlSectionsWithNoChildren() 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 GetUrlSectionsWithNoChildren = cmd.execute If err.number <> 0 Then Call ReportError("GetUrlSectionsWithNoChildren", err.number, err.description) End If set cmd = nothing On Error Goto 0 End Function Sub DeleteRelatedSection(intUrlId) On Error Resume Next dim cmd set cmd = Server.CreateObject("ADODB.Command") set cmd.ActiveConnection = conn cmd.CommandText = "SP_DELETE_RELATED_SECTION" cmd.CommandType = adCmdStoredProc cmd.Parameters.Append cmd.CreateParameter("URL_ID", adInteger, adParamInput, , intUrlId) cmd.execute If err.number <> 0 Then Call ReportError("DeleteRelatedSection", err.number, err.description) End If set cmd = nothing On Error Goto 0 End Sub %>