HEX
Server: Microsoft-IIS/8.5
System: Windows NT YDAWBH120 6.3 build 9600 (Windows Server 2012 R2 Standard Edition) AMD64
User: tentjecom_web (0)
PHP: 7.4.14
Disabled: NONE
Upload Files
File: D:/HostingSpaces/HVliet/thomashuisdeborg.nl/wwwroot/old/navigate/navigate.asp
<%@ LANGUAGE="VBSCRIPT" %>
<%   

Dim aLinkNames, aHREF, Page, intLastLink, aLinksHREF, I, SiteTitle, TargetFrame, strTarget, strLocation

' Title for your navigationpage
  SiteTitle = "Sneeuwberg Appartementen Navigatie"
' Default Target rame to open your pages in
  TargetFrame = "main"
' names on tabs:
  aLinkNames = array("NL","DE")
' Hyperlinks for tabs
  aHREF = array("navigate.asp","navigate.asp")

' Location of the navigation. Only use this when default fails.
'  strLocation = "G:\Inetpub\wwwroot\stintranet_build\navigate"
  strLocation = Server.MapPath(".")

Page = Request.Querystring("Link")
If Request.Querystring("Link") = Empty Then
	Page = 1
End If

Sub DrawNavigation (aLinks,aLinksHREF)
Response.Write "<table class='navigate'> <tr>" &vbNewLine
Response.Write "<tr><td valign='top' COLSPAN=" &Ubound(aLinks)+1 &"><HR></td></tr>" &vbNewLine
 
  intLastLink = 1
    
  If Len(Request.Querystring("Link")) then 
   intLastLink = Request.Querystring("Link") 
  end if  
  
    For I = 0 to uBOUND(aLinks)
      If intLastLink-1 = I then       
       Response.Write "<td class='active'>" &vbNewLine
       Response.Write "<b>" &aLinks(I) &"&nbsp;</td>" &vbNewLine
      else
       Response.Write "<td class='back'>" &vbNewLine
       Response.Write "<b><a class='back' target='_self' href=" &Chr(34) &aLinksHREF(I) &"?link=" &I+1 &Chr(34) &">" &aLinks(I) &"</a>&nbsp;</td>" &vbNewLine
      end if 
    Next
   Response.Write "<tr><td valign='top' COLSPAN=" &Ubound(aLinks)+1 &"><HR></td></tr>" &vbNewLine
   Response.Write "</tr>" &vbNewLine
   Response.Write "</table>" &vbNewLine
End Sub %>


<HTML>
<HEAD>
    <META HTTP-EQUIV="Content-Type" content="text/html; charset=iso-8859-1">
    <LINK HREF='../include/styles.css' REL='stylesheet' TYPE='text/css'>
    <TITLE><% =SiteTitle %></TITLE>
<!-- #include file="../_private/mouseact.asp" -->
</HEAD>

<BODY class='navigate'
      LANGUAGE = "VBScript"
      onClick = clickHandler
      onMouseOver = mouseOverHandler
      onMouseOut = mouseOutHandler
>

<BASE TARGET="<% =TargetFrame %>">

<STYLE>
    IMG  { cursor:hand; }
    SPAN { cursor:hand; }
</STYLE>

<%

    DrawNavigation aLinkNames,aHREF 

    Response.Write buildMenu()

    '== Dynamically build the menu from a database.

    Function buildMenu()

        Dim i               '== Index
        Dim iCurLevel       '== Index of current menu level
        Dim iCurMenu        '== Index of current sub-menu
        Dim iaMarginLeft    '== Left Margin for indenting sub-menus
        Dim sReturn         '== Return value (built menu)
        Dim rsMenu          '== Recordset for the menu data
        Const adOpenKeyset = 1
        Const adLockBatchOptimistic = 4

        '== Types used in menu definition
        Const sNULL = "N"
        Const sLINK = "L"
        Const sEDOC = "D"   '== External Document
        Const sMENU = "M"
        Const sEOM = "E"    '== End of Menu

        '== Initialize data
        iCurLevel = 0
        iCurMenu = 0
        iaMarginLeft = Array(10, 15, 20, 25, 30, 35)

        '== Retrieve data from database
        Set rsMenu = Server.CreateObject("ADODB.Recordset")
        rsMenu.Open "SELECT * from navigate where menu_name='" &Page &"' order by menu_index","driver={Microsoft Access Driver (*.mdb)};DBQ=" &strLocation &"\navigate.mdb", adOpenKeyset, adLockBatchOptimistic

        '== Build the menu
        sReturn = ""
        sReturn = sReturn & "<DIV STYLE=""margin-left:" & iaMarginLeft(iCurLevel) & ";"">" & vbCrLf
        Do While Not rsMenu.EOF
            sReturn = sReturn & String(iCurLevel, vbTab)
                If Trim(rsMenu(5)) <> "default" Then
                  strTarget = " target = " &Chr(34) &Trim(rsMenu(5)) &Chr(34)
                Else
                	strTarget = ""
                End If
            Select Case Trim(rsMenu(2))
                Case sNULL
                    sReturn = sReturn & "<IMG SRC=""leaf.gif"">" & Trim(rsMenu(3)) & "<BR>"
                Case sLINK
                    sReturn = sReturn & "<IMG SRC=""leaf.gif""><A HREF=""" & Trim(rsMenu(4)) & """  TITLE=""" & Trim(rsMenu(4)) & """ " &strTarget &">" & Trim(rsMenu(3)) & "</A><BR>"
                Case sEDOC
                    sReturn = sReturn & "<IMG SRC=""leaf.gif""><A ID=EXTERNAL HREF=""" & Trim(rsMenu(4)) & """ TITLE=""External document - " & Trim(rsMenu(4)) & """>" & Trim(rsMenu(3)) & "</A><BR>"
                Case sMENU
                    iCurLevel = iCurLevel + 1
                    iCurMenu = iCurMenu + 1
                    sReturn = sReturn _
                            & "<IMG SRC=""bookc.gif"" ID=MI-" & iCurMenu & "><SPAN ID=MT-" & iCurMenu & ">" & Trim(rsMenu(3)) & "</SPAN><BR>" _
                            & vbCrLf _
                            & String(iCurLevel, vbTab) _
                            & "<DIV ID=C-" & iCurMenu & " STYLE=""margin-left:" & iaMarginLeft(iCurLevel) & "; display:None;"">"
                Case sEOM
                    sReturn = sReturn & "</DIV>"
                    iCurLevel = iCurLevel - 1
                Case Else
            End Select
            sReturn = sReturn & vbCrLf
            rsMenu.MoveNext
        Loop

        sReturn = sReturn & "</DIV>" & vbCrLf

        '== Return the menu
        buildMenu = sReturn

    End Function

%>
</BODY>
</HTML>