From:
Code: Select all
/path1/path2/itemA
/path1/path2/itemB
/path3/itemC
/itemD
Code: Select all
root
+ itemD (items before paths)
+ path1
+ path2
+ itemA
+ itemB
+ path3
+ itemC
Code: Select all
/path1/path2/itemA
/path1/path2/itemB
/path3/itemC
/itemD
Code: Select all
root
+ itemD (items before paths)
+ path1
+ path2
+ itemA
+ itemB
+ path3
+ itemC
Code: Select all
Function Remove(Byval Text As String,Char As String) As String
Dim As Long i
For n As Long = 0 To Len(Text)-1
If Text[n]<> Asc(char) Then Text[i]= Text[n]:i+=1
Next
Return Left(Text,i)
End Function
Function FindAndReplace(InString As String,Find As String,Replace As String) As String
Dim s As String=InString
var position=Instr(s,Find)
While position>0
s=Mid(s,1,position-1) & Replace & Mid(s,position+Len(Find))
position=Instr(position+Len(Replace),s,Find)
Wend
return s
End Function
Function pipeout(Byval s As String="") Byref As String
Var f=Freefile
Dim As String tmp
Open Pipe s For Input As #f
s=""
Do Until Eof(f)
Line Input #f,tmp
s+=tmp+Chr(10)
Loop
Close #f
Return s
End Function
var path="C:\fb17_32"
var s=pipeout("tree /A /F "+path)
'to suit windows
s=remove(s,"|")
s=FindAndReplace(s,"---"," ")
print s
print
sleep
#macro FLAGS_For_Windows
TREE [drive:][path] [/F] [/A]
/F Display the names of the files in each folder.
/A Use ASCII instead of extended characters.
#endmacro
To clarify, the list that I want to parse (and the output) is not an actual filesystem on my system, but a virtual filesystem in a database. But I will look at the tTreeNode class and see how I can use this.grindstone wrote:Something like this ?
Code: Select all
#Include Once "dir.bi"
Type tDirTreeNode
As String fName 'name of the current subfolder
As UInteger attr 'attributes
As Integer depth 'tree depth of the current folder
As boolean deflate = TRUE 'deflation flag (for folder)
As tDirTreeNode Ptr parent 'pointer to parent node
As tDirTreeNode Ptr child(Any) 'dynamic array of child nodes (sorted by fname)
Declare Property total() As Integer 'get the total number of tree nodes
Declare Function doTotal(p As tDirTreeNode Ptr) As Integer
Declare Property path() As String 'complete directory path corresponding to the current tree node
Declare Property noChild As boolean
Declare Property noSubfolder As boolean
Declare Function newChild(fn As String, att As Integer, sort As Integer = 0) As tDirTreeNode Ptr
Declare Function childExists(fn As String) As tDirTreeNode Ptr
Declare Constructor()
Declare Destructor()
End Type
Constructor tDirTreeNode
ReDim child(0) 'initialize child array
End Constructor
Destructor tDirTreeNode
'deletes the node and the whole following branch
For x As Integer = 0 To UBound(child) 'delete all child nodes
If child(x) <> 0 Then
Delete child(x)
EndIf
Next
End Destructor
Property tDirTreeNode.total() As Integer
Dim As Integer ret
Dim As tDirTreeNode Ptr p = @This
Do While p->parent <> 0 'get root node
p = p->parent
Loop
For x As Integer = 0 To UBound(p->child) 'all drives
ret += this.doTotal(p->child(x))
Next
Return ret
End Property
Function tDirTreeNode.doTotal(p As tDirTreeNode Ptr) As Integer
Dim As Integer ret = 1
If p->noChild Then 'no subnodes --> don't traverse
Return ret
EndIf
For x As Integer = 0 To UBound(p->child) 'all subnodes
If p->child(x) <> 0 Then
ret += this.doTotal(p->child(x)) 'traverse subnode (recursive)
EndIf
Next
Return ret
End Function
Property tDirTreeNode.path() As String
Dim As String ret
Dim As tDirTreeNode Ptr p = @This
If p->attr And fbDirectory Then
ret = p->fName
EndIf
Do While p->parent <> 0
p = p->parent
ret = p->fName + "\" + ret
Loop
Return Trim(ret, "\")
End Property
Property tDirTreeNode.noChild As boolean
If (UBound(this.child) = 0) And (this.child(0)->fName = "") Then
Return TRUE
Else
Return FALSE
EndIf
End Property
Property tDirTreeNode.noSubfolder As boolean
If this.noChild Then
Return TRUE
Else
For x As Integer = 0 To UBound(This.child)
If (this.child(x)->attr And fbDirectory) Then
Return FALSE
EndIf
Next
Return TRUE
EndIf
End Property
Function tDirTreeNode.newChild(fn As String, att As Integer, mode As Integer = 0) As tDirTreeNode Ptr
Dim As Integer x, y
Dim As String fnl = LCase(fn)
Dim As tDirTreeNode Ptr ret
'mode:
' bit 0 set (1) --> sort alphabetical
' bit 1 set (2) --> check if already child exists
With This
If .noChild Then
x = 0
Else
If mode And 2 Then 'check if subnode already exists
For y = 0 To UBound(.child)
If LCase(.child(y)->fName) = fnl Then 'subnode already exists
Return .child(y)
EndIf
Next
EndIf
x = UBound(.child) + 1
EndIf
ReDim Preserve .child(x)
.child(x) = New tDirTreeNode 'create new node
ret = .child(x)
.child(x)->parent = @This
.child(x)->depth = .depth + 1
.child(x)->fName = fn 'subfolder name
.child(x)->attr = att
.child(x)->deflate = TRUE
If mode And 1 Then 'sort entries alphabetical
For y = x To 1 Step -1
If LCase(.child(y)->fName) < LCase(.child(y - 1)->fName) Then
Swap .child(y), .child(y - 1)
Else
Exit For
EndIf
Next
EndIf
Return ret
End With
End Function
Function tDirTreeNode.childExists(fn As String) As tDirTreeNode Ptr
If this.noChild Then
Return 0
EndIf
For x As Integer = 0 To UBound(this.child)
If LCase(fn) = LCase(this.child(x)->fName) Then
Return child(x)
EndIf
Next
Return 0
End Function
Function getFolderEntryList(p As tDirTreeNode Ptr) As Integer
Dim As Integer i, x, y, out_attr, fileindex, ret
Dim As String g
ReDim p->child(0) 'initialize child array
g = Dir(p->path + "\*", -1, @out_attr) '1st dir entry
Do While Len(g) 'dir entry found
Select Case g
Case ".",".."
'ignore
Case Else
p->newChild(g, out_attr)
ret += 1
End Select
g = Dir("", -1, @out_attr) 'next dir entry
Loop
Return ret
End Function
Code: Select all
#Include "dirTree.bi"
Dim As tDirTreeNode root 'create the tree's root node
Dim As tDirTreeNode Ptr rp = @root
Dim As Integer numberOfEntries, x
root.fName = "C:" 'name of the folder whose contents you want to add to the tree
root.attr Or= fbDirectory 'set attribute
numberOfEntries = getFolderEntryList(rp) 'put the contents of the folder into the tree
Print numberOfEntries
For x = 0 To numberOfEntries - 1 'print the entries
Print x;" ";rp->child(x)->fname
Next
Sleep
Code: Select all
#Define LF Chr(10)
#Define CRLF Chr(13) & Chr(10)
Dim Shared As String * 255 u
For n As Long=0 To 255
u[n]=Iif(n<91 Andalso n>64,n+32,n) 'lookup string
Next
Sub Quicksortup(low As String Ptr,high As String Ptr) 'by dodicat
If (high - low <= 1) Then Return
Var J = low + 1, I = J, lenb = Cast(Integer Ptr, low)[1], lena=0
While J <= high
lena = Cast(Integer Ptr, J)[1] '=Len(*a)
If lena > lenb Then lena = lenb
For n As Long = 0 To lena - 1
If u[(J)[0][n]] < u[(low)[0][n]] Then Swap *J, *I : I += 1 : Exit For
If u[(J)[0][n]] > u[(low)[0][n]] Then Exit For
Next
J + =1
Wend
J = I - 1 : Swap *low, *J
quicksortup(low, J)
quicksortup(I, high)
End Sub
Sub StringSplit(sString As String, aResult() As String, sDelimiter As String = "/")
Dim As Uinteger j = 0, i, ii = 1
If Left(sString, 1) = sDelimiter Then sString = Ltrim(sString, "/")
For i = 1 To Len(sString)
If Mid(sString, i, 1) = sDelimiter Then
Redim Preserve aResult(Ubound(aResult) + 1)
aResult(j) = Mid(sString, ii, i - ii)
j += 1
i += 1
ii = i
End If
Next
If ii < i Then
aResult(j) = Mid(sString, ii, i - ii)
Else
Redim Preserve aResult(j - 1)
End If
End Sub
Sub PrintDirStructure(sPathes As String)
ReDim As String aPathes(1000)
Dim As String char
Dim As Uinteger i = 1, ii = 1, c = 0, d = 0, x, y, dimx = 0
While i <= Len(sPathes)
char = Mid(sPathes, i, 1)
If char = "/" Then d+= 1
If Asc(char) = 10 Then
aPathes(c) = Mid(sPathes, ii, i - ii)
c += 1
i += 1
ii = i
If dimx < d Then dimx = d
d = 0
Else
i += 1
End If
Wend
If ii < i Then
aPathes(c) = Mid(sPathes, ii, i - ii)
Else
c -= 1
End If
Redim Preserve aPathes(c)
Quicksortup(@aPathes(0), @aPathes(c))
? "Input pathes sorted:" : ?
For i = 0 To Ubound(aPathes)
? aPathes(i)
Next
? : ?
? "Formatted (parsed):" : ?
? "root"
Dim As String aTree(dimx * c, dimx - 1), aLine()
Dim As Integer px, py, found
For i = 0 To Ubound(aPathes)
Redim aLine(0)
StringSplit(aPathes(i), aLine())
px = 0
For x = 0 To Ubound(aLine)
y = 0
found = 0
While y < py
If aLine(x) = aTree(y, x) Then
found = 1
Exit While
End If
y += 1
Wend
If found = 1 Then
px += 1
Else
aTree(py, px) = aLine(x)
px += 1
py += 1
End if
Next
Next
Dim As String sOutput, tc, tn
For y = 0 To py
For x = 0 To Ubound(aTree, 2)
sOutput &= Iif(aTree(y, x) <> "", "+" + aTree(y, x), "") + Chr(9)
Next
sOutput &= CRLF
Next
? sOutput
End Sub
Dim As String sPathes = "/path1/path2/itemB" & LF & _
"/path2/itemC" & LF & _
"/path1/path2/itemA" & LF & _
"/zitemA" & LF & _
"/path1/path2/path3/itemA" & LF & _
"/path2/itemA" & LF & _
"/itemD"
PrintDirStructure(sPathes)
Sleep
Thanks, totally different than the code I was making, but it seems to do the job.UEZ wrote:I don't know if this is usable
Code: Select all
#Define LF Chr(10)
#Define CRLF Chr(13) & Chr(10)
#Define INDENT " "
#Define PREFIX "+ "
Dim Shared As String * 255 u
For n As Long=0 To 255
u[n]=Iif(n<91 Andalso n>64,n+32,n) 'lookup string
Next
Sub quicksortup(low As String Ptr,high As String Ptr) 'by dodicat
If (high - low <= 1) Then Return
Var J = low + 1, I = J, lenb = Cast(Integer Ptr, low)[1], lena=0
While J <= high
lena = Cast(Integer Ptr, J)[1] '=Len(*a)
If lena > lenb Then lena = lenb
For n As Long = 0 To lena - 1
If u[(J)[0][n]] < u[(low)[0][n]] Then Swap *J, *I : I += 1 : Exit For
If u[(J)[0][n]] > u[(low)[0][n]] Then Exit For
Next
J + =1
Wend
J = I - 1 : Swap *low, *J
quicksortup(low, J)
quicksortup(I, high)
End Sub
Sub StringSplit(sString As String, aResult() As String, sDelimiter As String = "/")
Dim As Uinteger j = 0, i, ii = 1
If Left(sString, 1) = sDelimiter Then sString = Ltrim(sString, "/")
For i = 1 To Len(sString)
If Mid(sString, i, 1) = sDelimiter Then
Redim Preserve aResult(Ubound(aResult) + 1)
aResult(j) = Mid(sString, ii, i - ii)
j += 1
i += 1
ii = i
End If
Next
If ii < i Then
aResult(j) = Mid(sString, ii, i - ii)
Else
Redim Preserve aResult(j - 1)
End If
End Sub
Sub PrintDirStructur(sPathes As String, sepChar As String)
ReDim As String aPathes(1000)
Dim As String char
Dim As Uinteger i = 1, ii = 1, c = 0, d = 0, x, y, dimx = 0
While i <= Len(sPathes) 'loop all characters
char = Mid(sPathes, i, 1)
If char = sepChar Then d+= 1 'current depth
If Asc(char) = 10 Then 'LF
aPathes(c) = Mid(sPathes, ii, i - ii) 'one complete line
c += 1 'line count
i += 1 'input iterator
ii = i 'previous
If dimx < d Then dimx = d 'increase max depth
d = 0 'reset current depth
Else
i += 1 'No LF
End If
Wend
If ii < i Then 'add the last line
aPathes(c) = Mid(sPathes, ii, i - ii)
Else
c -= 1 'correct line count
End If
Redim Preserve aPathes(c) 'shrink array size
quicksortup(@aPathes(0), @aPathes(c))
? "Input pathes sorted:"
For i = 0 To Ubound(aPathes)
? aPathes(i)
Next
'?
?
? "Formatted:"
'? "root"
Dim As String aTree(dimx * c, dimx - 1) 'allocate for worst case
Dim As String aLine()
Dim As Integer px, py, found
For i = 0 To Ubound(aPathes) 'loop all full paths
Redim aLine(0)
StringSplit(aPathes(i), aLine(), sepChar) 'split path into segments
px = 0
For x = 0 To Ubound(aLine) 'loop path segments
y = 0
found = 0
While y < py
If aLine(x) = aTree(y, x) Then
found = 1
Exit While
End If
y += 1
Wend
If found = 1 Then
px += 1
Else
aTree(py, px) = aLine(x)
px += 1
py += 1
End if
Next
Next
Dim As String sOutput, tc, tn
For y = 0 To py
For x = 0 To Ubound(aTree, 2)
sOutput &= Iif(aTree(y, x) <> "", PREFIX + aTree(y, x), "") + INDENT
Next
sOutput &= CRLF
Next
? sOutput
End Sub
Dim As String sPathes = _
"/path1/xxxx/itemB" & LF & _
"/path2/itemC" & LF & _
"/path2/xxxx/itemA" & LF & _
"/itemA" & LF & _
"/path1/path2/path3/itemA" & LF & _
"/path2/itemA" & LF & _
"/itemD"
PrintDirStructur(sPathes, "/")
Sleep
Code: Select all
#Include once "F:\Basic\LZLE.bi"
Dim MyList As List
' MyList.HashTag("path1") : MyList.HashTag("path1/path2") : MyList.HashTag("path3")'?
MyList.HashTag("path1/path2/itemA")
MyList.HashTag("path1/path2/itemB")
MyList.HashTag("path3/itemC")
MyList.HashTag("itemD")
MyList.HashTag("->Root")
MyList.Root
While MyList.KeyStep
Print MyList.HashTag
Wend
Sleep
Code: Select all
#Include once "F:\Basic\LZLE.bi"
Dim MyList As List
MyList.HashLen(6)
MyList.HashTag("path1/path2/itemA")
MyList.HashTag("path1/path2/itemB")
MyList.HashTag("path3/itemC")
MyList.HashTag("itemD")
MyList.HashTag("->Root")
MyList.Root
While MyList.HashStep
Print MyList.Tag
Wend
Sleep
I don't know how your list engine works.Lost Zergling wrote:Suggest this one ...
or that one ...
Code: Select all
->Root
itemD
path1/path2/itemA
path1/path2/itemB
path3/itemC
Code: Select all
->Root
itemD
path1/
path2/
itemA
itemB
path3/
itemC
Code: Select all
#include "crt.bi"
const MAX_FILES = 10 ' <--- change it if you like
function getDepth(path as string) as integer
var c=0,n = instr(path,"/")
while n
c+=1
n = instr(n+1,path,"/")
wend
return c
end function
sub SortFS(FS() as string)
dim as boolean flag=true
while flag
flag=false
for i as integer = 0 to ubound(FS)-1
if getDepth(FS(i)) > getDepth(FS(i+1)) then
swap FS(i),FS(i+1)
flag=true
end if
next
wend
end sub
dim as string VirtualFS(MAX_FILES-1)
' create input data (your virtual file system)
for i as integer = 0 to ubound(VirtualFS)
dim as integer depth = rnd*4
dim as string path
while depth>1
path &= "/path" & chr(asc("0")+rnd*9)
depth-=1
wend
VirtualFS(i) = path & "/item" & chr(asc("A")+i)
next
print "virtual file system"
for i as integer = 0 to ubound(VirtualFS)
print VirtualFS(i)
next
print
' sort the FS.
SortFS(VirtualFS())
print "sorted:"
for i as integer = 0 to ubound(VirtualFS)
print VirtualFS(i)
next
print
print "root"
for i as integer = 0 to ubound(VirtualFS)
var c=0,depth = getDepth(VirtualFS(i))
dim as string splitted(depth-1)
var path = VirtualFS(i) & "/"
var p = strtok(strptr(path),strptr("/"))
while (p<>NULL) : splitted(c) = *p : c+=1 : p = strtok(NULL,strptr("/")) : wend
for j as integer = 0 to c-1
print space(j*2) & "+ " & splitted(j)
next
next
sleep
Thanks, but not perfect, a different random run gave me this (see remark "<--------- path3"):D.J.Peters wrote:You can use strtok() to split the path in folders and items !
...
Code: Select all
virtual file system
/path8/path7/path3/itemA
/path7/path3/itemB
/path4/path9/path7/itemC
/path6/itemD
/itemE
/path3/path5/path7/itemF
/path6/path3/itemG
/path3/itemH
/itemI
/path3/path3/itemJ
sorted:
/itemE
/itemI
/path6/itemD
/path3/itemH
/path7/path3/itemB
/path6/path3/itemG
/path3/path3/itemJ
/path8/path7/path3/itemA
/path4/path9/path7/itemC
/path3/path5/path7/itemF
root
+ itemE
+ itemI
+ path6
+ itemD
+ path3
+ itemH
+ path7
+ path3
+ itemB
+ path6
+ path3
+ itemG
+ path3 <--------- path3
+ path3
+ itemJ
+ path8
+ path7
+ path3
+ itemA
+ path4
+ path9
+ path7
+ itemC
+ path3 <--------- path3
+ path5
+ path7
+ itemF
I never sayed I made your homework !badidea wrote:For my purpose, these to paths need to be merged.
Code: Select all
function countInStr(text as string, char as string) as integer
dim as integer count = 0
for i as integer = 0 to len(text) - 1
if text[i] = asc(char) then count += 1
next
return count
end function
function findInList(list() as string, find as string) as integer
for i as integer = 0 to ubound(list)
if list(i) = find then return i
next
return -1
end function
sub bubbleSort(list() as string)
for i as integer = 0 to ubound(list)
for j as integer = 0 to i - 1
if list(i) < list(j) then
swap list(i), list(j)
end if
next
next
end sub
'-------------------------------------------------------------------------------
type tree_type
dim as string item(any)
dim as string path(any)
dim as tree_type ptr pSubTree(any)
declare sub addItem(objectStr as string, sepChar as string)
declare sub show(depth as integer = 0)
declare sub cleanup()
end type
'object = item or tree
sub tree_type.addItem(objectStr as string, sepChar as string)
if objectStr[0] <> asc(sepChar) then
print "Fail: Bad input"
exit sub
end if
if countInStr(objectStr, sepChar) = 1 then
dim as integer ub = ubound(item)
redim preserve item(ub + 1)
item(ub + 1) = mid(objectStr, 2) 'note mid starts at 1
bubbleSort(item())
else
dim as integer nextSepPos = instr(2, objectStr, sepChar)
dim as string pathStr = mid(objectStr, 2, nextSepPos - 2)
dim as string remObjStr = mid(objectStr, nextSepPos)
dim as integer index = findInList(path(), pathStr)
if index >= 0 then
pSubTree(index)->addItem(remObjStr, sepChar)
else
'add sub tree
dim as integer ub = ubound(pSubTree)
redim preserve path(ub + 1)
path(ub + 1) = pathStr
redim preserve pSubTree(ub + 1)
pSubTree(ub + 1) = allocate(sizeof(tree_type))
pSubTree(ub + 1)->addItem(remObjStr, sepChar)
'bubble sort with 2nd array
for i as integer = 0 to ubound(path)
for j as integer = 0 to i - 1
if path(i) < path(j) then
swap path(i), path(j)
swap pSubTree(i), pSubTree(j)
end if
next
next
end if
end if
end sub
sub tree_type.show(depth as integer = 0)
dim as string indentStr = string(depth * 2, " ") + "+ "
for i as integer = 0 to ubound(item)
color 14, 0 'item in yellow
print indentStr & item(i)
color 15, 0
next
for i as integer = 0 to ubound(path)
color 10, 0 'path in green
print indentStr & path(i)
color 15, 0
pSubTree(i)->show(depth + 1)
next
end sub
sub tree_type.cleanup()
for i as integer = 0 to ubound(pSubTree)
pSubTree(i)->cleanup()
deallocate(pSubTree(i))
next
erase item, path, pSubTree
end sub
'-------------------------------------------------------------------------------
dim as string inputStr(...) = { _
"/itemE",_
"/path1/path2/itemA", _
"/path1/path2/itemC", _
"/path1/path2/itemB", _
"/path2/path2/itemX", _
"/path4/path5/path6/path7/itemQ", _
"/path4/path5/path8/path7/itemR", _
"/path4/path5/path6/path7/itemP", _
"/path3/itemC", _
"/path3/itemC", _
"/itemD"}
dim as tree_type tree
for i as integer = 0 to ubound(inputStr)
tree.addItem(inputStr(i), "/")
next
tree.show()
tree.cleanup()
print "end"
sleep