---
title: "Rekursiv function (lite svårare nöt)"
type: "forum-thread"
url: "https://www.webforum.nu/amne/asp/146186-rekursiv-function-lite-svårare-nöt"
topic: "ASP"
topic_url: "https://www.webforum.nu/amne/asp"
author: "Travoni"
published: "2006-04-28T10:00:08.000Z"
updated: "2006-04-28T10:58:59.000Z"
replies: 4
views: 499
page: 1
pages: 1
language: "sv-SE"
site: "webForum — webforum.nu"
rights: "Upphovsrätten till varje inlägg tillhör dess författare."
attribution: "Citera som: webForum, https://www.webforum.nu/amne/asp/146186-rekursiv-function-lite-svårare-nöt"
---
# Rekursiv function (lite svårare nöt)
## #1 — Travoni, 2006-04-28T10:00Z
Jag använder denna rekursiva funktion för att skriva ut en trevlig li/ul - meny.
```
Dim p, cmd, nodes
' Opens Connection
connopen
' Preper command
Set cmd = NewCommand(connection, "SELECT pageid, parent_pageid, linktext FROM pages WHERE pageid = ? ORDER BY parent_pageid")
Set p = cmd.CreateParameter("id", 3, 1, , cLng("0" & page_id))
cmd.Parameters.Append p
Set nodes = Path(cmd, p)
cmd.CommandText = "SELECT pageid, parent_pageid, linktext FROM pages WHERE parent_pageid = ? ORDER BY parent_pageid"
Set rs = Server.CreateObject("ADODB.Recordset")
rs.open sql, connection, 0, 1
Response.Write ""& vbCrLf
'WritePath nodes
WriteMenu rs, rs("pageid"), rs("linktext"), rs("parent_pageid"), nodes, cmd, p
'Close
Set cmd = nothing
Response.Write "
"& vbCrLf
'/// Functions
Function NewCommand(conn,CommandText)
Dim cmd
Set cmd = CreateObject("ADODB.Command")
Set cmd.ActiveConnection = conn
cmd.CommandType = 1
cmd.CommandText = CommandText
cmd.Prepared = true
Set NewCommand = cmd
End function
Sub WriteMenu(rs, fldId, fldText, fldParId, Expanded, cmd, p)
If not rs.EOF Then
Dim rsSub
Set rsSub = Server.CreateObject("ADODB.Recordset")
Do Until rs.EOF
If Expanded.Exists(CStr(fldId.value)) Then
If cLng("0"& fldParId) = 0 then
Response.Write "" & Server.HTMLEncode(fldText.Value) & ""& vbCrLf &""& vbCrLf
Else
Response.Write "- " & Server.HTMLEncode(fldText.Value) & ""& vbCrLf &"
"& vbCrLf
End if
p.Value = fldId.value
rsSub.Open cmd, ,0, 1
WriteMenu rsSub, rsSub(fldId.Name), rsSub(fldText.Name), rsSub(fldParId.Name), Expanded, cmd, p
rsSub.Close
Response.Write "
"& vbCrLf
Else
If cLng("0"& fldParId) = 0 then
Response.Write "- " & Server.HTMLEncode(fldText.Value) & "
"& vbCrLf
Else
Response.Write "- " & Server.HTMLEncode(fldText.Value) & "
"& vbCrLf
End if
End If
rs.MoveNext
Loop
End If
End Sub
```
Resultatet blir då så här:
```
```
Som ni ser så är det en \\ för mycket. (fetmarkerat)Vet inte varför det blir så. Hjälp önskas.
Permalänk: https://www.webforum.nu/p/146186
## #2 — Erik Juhlin, 2006-04-28T10:25Z
Låt WriteMenu spotta ut \ / \. Där i kan du då skippa att göra det om rs.EOF.
Permalänk: https://www.webforum.nu/p/1804665
## #3 — Travoni, 2006-04-28T10:33Z
Ursäkta men jag fattar inte.
Är det inte det jag gör här?
Kan du visa lite är du bussig. :f
Permalänk: https://www.webforum.nu/p/1804669
## #4 — Erik Juhlin, 2006-04-28T10:51Z
Nåt åt det här hållet borde funka.
```
Dim p, cmd, nodes
' Opens Connection
Call connOpen
' Preper command
Set cmd = NewCommand(connection, "SELECT pageid, parent_pageid, linktext FROM pages WHERE pageid = ? ORDER BY parent_pageid")
Set p = cmd.CreateParameter("id", 3, 1, , cLng("0" & page_id))
cmd.Parameters.Append p
Set nodes = Path(cmd, p)
cmd.CommandText = "SELECT pageid, parent_pageid, linktext FROM pages WHERE parent_pageid = ? ORDER BY parent_pageid"
Set rs = Server.CreateObject("ADODB.Recordset")
rs.open sql, connection, 0, 1
'WritePath nodes
WriteMenu rs, rs("pageid"), rs("linktext"), rs("parent_pageid"), nodes, cmd, p
'Close
Set cmd = nothing : rsClose : connClose
'/// Functions
Function NewCommand(conn,CommandText)
Dim cmd
Set cmd = CreateObject("ADODB.Command")
Set cmd.ActiveConnection = conn
cmd.CommandType = 1
cmd.CommandText = CommandText
cmd.Prepared = true
Set NewCommand = cmd
End function
Sub WriteMenu(rs, fldId, fldText, fldParId, Expanded, cmd, p)
If not rs.EOF Then
Response.Write ""
End If
End Sub
Function Path(cmd, p)
Dim node(4)
Dim nodes
' Prepare recordset
Set rs = Server.CreateObject("ADODB.Recordset")
' Prepare nodes dictionary
Set nodes = Server.CreateObject("Scripting.Dictionary")
' Iterate up from the current id
rs.Open cmd
Do Until rs.EOF
node(0) = rs("pageid")
node(1) = rs("parent_pageid")
node(2) = rs("linktext")
' Adds node to list with nodes
nodes.Add CStr(node(0)), node
' Fetch parent node
p.Value = rs("parent_pageid").Value
rs.Close
rs.Open cmd
Loop
rs.Close
'Return value
Set Path = nodes
End Function
```
Permalänk: https://www.webforum.nu/p/1804677
## #5 — Travoni, 2006-04-28T10:58Z
Snyggt (y)
Permalänk: https://www.webforum.nu/p/1804678
---
Tråden på webben: https://www.webforum.nu/amne/asp/146186-rekursiv-function-lite-svårare-nöt