home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD 45 / SuperCD45.iso / talleres / vbasic / Catalogue.cls < prev    next >
Encoding:
Visual Basic class definition  |  2000-01-30  |  2.7 KB  |  111 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "Catalogue"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
  15. Attribute VB_Ext_KEY = "Member0" ,"FileNames"
  16. Attribute VB_Ext_KEY = "Member1" ,"Generations"
  17. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  18. Option Explicit
  19. Private genlist As Collection
  20. Private t As Token
  21. Private catFileName As String
  22. 'adds a generation to the catalogue
  23. Public Sub Add(nlist As BNodeList)
  24.  
  25. genlist.Add nlist
  26.  
  27. End Sub
  28. ' helper routine for ReadCatalogue
  29. Private Function ReadCatalogue1(t As Token, p As BNode) As BNodeList
  30. Dim list As New BNodeList, n As BNode, curDirLevel As Integer
  31. Dim curGeneration As Integer
  32.  
  33. curDirLevel = t.dirLevel
  34. curGeneration = t.generation
  35.  
  36. Do While Not t.tEOF
  37.     If curGeneration <> t.generation Then
  38.         Exit Do
  39.     ElseIf t.dirLevel < curDirLevel Then
  40.         Exit Do
  41.     ElseIf t.dirLevel > curDirLevel Then
  42.         Set n.nextBNode = ReadCatalogue1(t, n)
  43.     Else    ' just a normal node
  44.         Call list.Add(t.fileName, t.attributes, Nothing, t.fileName)
  45.         Set n = list(t.fileName)
  46.         Set n.prevBNode = p
  47.        t.GetNext
  48.     End If
  49. Loop
  50.  
  51. Set ReadCatalogue1 = list
  52.  
  53. End Function
  54. Public Sub ReadCatalogue(fn As String)
  55. Dim nl As BNodeList
  56. '
  57. ' this is where we initialize everything
  58. '
  59. catFileName = fn
  60. Set genlist = New Collection
  61. Set t = New Token
  62.  
  63. On Error GoTo new_cat
  64. t.Start (fn)
  65. 'read the catalogue in
  66. Do While Not t.tEOF
  67.     Set nl = ReadCatalogue1(t, Nothing)
  68.     genlist.Add nl
  69. Loop
  70. Exit Sub
  71.  
  72. new_cat:
  73.  
  74.     
  75. End Sub
  76. 'writes the catalogue to file
  77. Public Sub WriteCatalogue()
  78. Dim g As BNodeList
  79. Dim gc As Integer, filenum As Integer
  80.  
  81. Set t = Nothing
  82. filenum = FreeFile
  83. Open catFileName For Output As #filenum
  84. gc = 0
  85. For Each g In genlist
  86.     Call WriteCatalogue1(g, filenum, gc, 0)
  87.     gc = gc + 1
  88. Next
  89. Close #filenum
  90.  
  91. End Sub
  92. 'helper routine for WriteCatalogue
  93. Private Sub WriteCatalogue1(nlist As BNodeList, filenum As Integer, generation As Integer, dirLevel As Integer)
  94. Dim n As BNode, p As BNodeList, dirFlag As Boolean
  95.  
  96. For Each n In nlist
  97.     Set p = n.nextBNode
  98.     dirFlag = Not p Is Nothing
  99.     If dirFlag Then
  100.         Write #filenum, generation, dirLevel, n.attributes, n.fileName, dirFlag
  101.         Call WriteCatalogue1(p, filenum, generation, dirLevel + 1)
  102.     Else
  103.         Write #filenum, generation, dirLevel, n.attributes, n.fileName, dirFlag
  104.     End If
  105. Next
  106.  
  107. End Sub
  108.  
  109.  
  110.  
  111.