home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / Balanced_B1875434112005.psc / SatAVL.cls < prev   
Text File  |  2005-04-11  |  13KB  |  294 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 = "SatAVL"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = True
  14. Option Explicit
  15. '_______________________________________________________________________________
  16. '
  17. 'ABSTRACT
  18. '   Provides any amount of requested memory (as long as there is available RAM)
  19. '   and associates that memory with a user-defined alphanumeric key. Features
  20. '   very fast retrieval in sorted order, even faster sequential access (in
  21. '   the chronological order the requests were made).
  22. '_______________________________________________________________________________
  23. '
  24. 'DESCRIPTION
  25. '   The alphanumeric keys are associated with a certain quantity of bytes located
  26. '   at a designated position in RAM. That RAM is and remains exclusively reserved
  27. '   for that Key. Via the key the address can be returned, and also the reserved
  28. '   bytes at that address. Keys are internally managed with a balanced binary AVL
  29. '   tree. It is possible to iterate through the whole collection of keys in the
  30. '   order in which these keys were created (and the memory allocated), returning
  31. '   the Key, the Address and the Size. It is also possible to access all the
  32. '   Keys in sorted order (ascending as well as descending). All operations are
  33. '   considerabily faster than VB's Collection object (as far as provided by the
  34. '   Collection).
  35. '_______________________________________________________________________________
  36. '
  37. 'USAGE
  38. '   What you do with the provided memory is up to you; however this is optimal
  39. '   to store objects' addresses (available via ObjPtr) to circumvent the slow
  40. '   COM mechanisms.
  41. '_______________________________________________________________________________
  42. '
  43. 'WARNINGS
  44. '   * Whatever you do with the allocated memory, do not forget to free it
  45. '     ("Set ThisClassesObject = Nothing" will do), or you soon end up with a lot
  46. '     of blocked RAM which won't be freed until a restart.
  47. '   * Do not attempt to write data beyond the end of the requested and allocated
  48. '     memory fragment! Chances are you get a crash if you do.
  49. '_______________________________________________________________________________
  50. '
  51. 'AUTHOR
  52. '   This software is (c) 2005 by Herbert Glarner.
  53. '   The used TypeLib for the IMalloc interface is (c) by Brad Martinez.
  54. '_______________________________________________________________________________
  55. '
  56. 'HISTORY
  57. '   04 Apr 2005    1.0          Creation and Access functionality
  58. '   05 Apr 2005    1.1          Replaced StrComp, Keys stored as Byte Arrays
  59. '   07 Apr 2005                 Fixed a bug in IStrComp
  60. '_______________________________________________________________________________
  61. '
  62. 'PROJECT FILES
  63. '   SatAVL.cls                  (This file)
  64. '_______________________________________________________________________________
  65. '
  66. 'USED TEST FORM
  67. '   SatAVLTest.frm (Test scenarioes and parallel comparison with VB Collection)
  68. '_______________________________________________________________________________
  69. '
  70. 'REQUIRED TYPE LIBRARIES
  71. '   ISHF_Ex.tlb                 "IShellFolder Extended type Library v1.2"
  72. '                               (The TypeLib is (c) by Brad Martinez)
  73. '_______________________________________________________________________________
  74. '
  75. 'REQUIRED DLLS
  76. '   shell32                     (for "SHGetMalloc")
  77. '_______________________________________________________________________________
  78. '
  79. 'REQUIRED CONTROLS
  80. '   -
  81. '_______________________________________________________________________________
  82. '
  83. 'EVENTS
  84. '   -
  85. '
  86. 'PUBLIC PROPERTIES
  87. '   R           Nodes =     Count               Use to traverse by index 0...n-1
  88. '
  89. 'PUBLIC METHODS
  90. '   Address =   Add (Key, Bytes)                already existing: 0, else RAM
  91. '
  92. 'LEXICAL ACCESS (SORTED BY KEY)
  93. '   Index =     Lowest/Higher                   ascending, No more items: -1
  94. '   Index =     Highest/Lower                   descending, No more items: -1
  95. '
  96. 'DIRECT ACCESS (with result, use sequential access methods "Address" etc.)
  97. '   Index =     Item (Key)                      not existing returns -1
  98. '
  99. 'SEQUENTIAL ACCESS (IN APPENDING ORDER), ALSO DIRECT ACCESS WITH KNOWN INDEX
  100. '   Key =       Key (Index)                     Index=0...n-1, n.ex. returns ""
  101. '   Address =   Address (Index)                 Index=0...n-1, n.ex. returns 0
  102. '   Bytes =     Size (Index)                    Index=0...n-1, n.ex. returns 0
  103. '_______________________________________________________________________________
  104. '
  105. 'EXTERNAL DLL METHODS
  106.  
  107. 'IMalloc is available via the type library "ISHF_Ex.tlb" which has to be
  108. 'included into the project's references when used in the IDE.
  109. Private Const NOERROR = 0
  110. Private Declare Function SHGetMalloc Lib "shell32" _
  111.     (ppMalloc As IMalloc) As Long
  112. '_______________________________________________________________________________
  113. '
  114. 'ERRORS (Base Number for this class: 4k)
  115. '(Dont't forget to initialize descriptions in the Constructor)
  116. Private Const ErrClass As String = "SatAVL"
  117. Private Enum ErrNumber
  118.     ErrBase = 4& * 1024&                            'Raised in:
  119.     ErrNoMallocInterface = ErrBase + 0              'Initialize
  120.     ErrFatalAdd = ErrBase + 1                       'Add
  121.     ErrFatalItem = ErrBase + 2                      'Item
  122.     'Always leave as the last entry:
  123.     ErrAutoMax
  124. End Enum
  125. 'Descriptions initialized on Construction
  126. Private ErrDesc(ErrBase + 0 To ErrAutoMax - 1) As String
  127. '_______________________________________________________________________________
  128. '
  129. 'CONSTANTS
  130.  
  131. 'Increasing elements vPath() if neccessary.
  132. Private Const NEWELEMENTS As Long = 10
  133.  
  134. 'Elements in rNode having no pointer to another index.
  135. Private Const sstNoChild As Long = -1
  136. Private Const sstNoParent As Long = -1
  137.  
  138. 'StrComp results.
  139. Private Const sstKeyIsSmaller As Long = -1
  140. Private Const sstKeyIsEqual As Long = 0
  141. Private Const sstKeyIsLarger As Long = 1
  142.  
  143. 'Used in Balance calculation for Height fields of the UDT "rChunk".
  144. Private Const ssmbLeftHeavy As Integer = -2
  145. Private Const ssmbLeftBalanced As Integer = -1
  146. Private Const ssmbBalanced As Integer = 0
  147. Private Const ssmbRightBalanced As Integer = 1
  148. Private Const ssmbRightHeavy As Integer = 2
  149. '_______________________________________________________________________________
  150. '
  151. 'ENUMS
  152.  
  153. 'Used in the Direction field of the UDT rPath (see below).
  154. Private Enum ssmDirection
  155.     ssmdLeft
  156.     ssmdRight
  157. End Enum
  158. '_______________________________________________________________________________
  159. '
  160. 'UDTS
  161.  
  162. 'Able to handle up to 2G nodes (signed Long referring to indices).
  163. Private Type rNode
  164.     'The key and a reference to it's content. (I've tested Key being an
  165.     'Integer() array, converted into a such from an ordinary key via mapping
  166.     'in Add(), so that only new keys needed to be mapped and the existing ones
  167.     'were in Integer() format. However, key comparison takes up to 50% longer
  168.     'time than the already slow string comparison, so it's strings again.)
  169.     
  170.     '(Seems that I could manage a slightly faster string comparison with
  171.     'Byte arrays.)
  172.     ByteKey() As Byte
  173.     'Key As String                       'Provided by user, must be unique
  174.     
  175.     Address As Long                     'Memory allocated via Malloc
  176.     Bytes As Long                       'As per user request, any number
  177.     'Some links regarding the balanced binary tree ("Index" is the index of an
  178.     'array in which this rChunk record is held among all relatives). Here we
  179.     'definitely need Longs to care for more than 2^15 nodes.
  180.     LeftTree As Long                    'Index of left subtree
  181.     RightTree As Long                   'Index of right subtree
  182.     Parent As Long                      'Index of the parent entry
  183.     '(Integers rather Longs here to save 4 bytes; Integers with 2^15 entries for
  184.     'the height should do the job: never encontered something such high due to
  185.     'tree balancing. Approx. 1 million nodes need height < 40. Still I feel
  186.     'that a byte is a risk, and there's also no need to save 2 bytes, since
  187.     'alignment will use them anyway. I've also tested Long'anyway with writing and
  188.     'accessing 1 million nodes: The time difference is not noticeable (once more,
  189.     'once less time).
  190.     LeftHeight As Integer               'This node's left height (excl. this node)
  191.     RightHeight As Integer              'This node's right height (excl. this node)
  192. End Type
  193.  
  194. 'Detailled description see VARIABLES for "vPath()".
  195. Private Type rPath
  196.     Index As Long
  197.     Direction As ssmDirection           'Left or right Path
  198. End Type
  199. '_______________________________________________________________________________
  200. '
  201. 'EVENTS
  202. '   None
  203. '_______________________________________________________________________________
  204. '
  205. 'VARIABLES
  206.  
  207. 'Holds a reference to the IMalloc Interface, available via the type library
  208. 'ISHF_Ex.tlb to which a VB Project reference must be set to use it. Set on
  209. 'object construction, and destroyed on object destruction. The pointer is not
  210. 'made available to the external world; it is used object internally only to
  211. 'allocate resp. free memory.
  212. Private ifMalloc As IMalloc
  213.  
  214. 'This vector holds the balanced binary tree. In case that no "Alloc" was made
  215. 'so far, it is completely empty. With the first "Alloc" a first element (the
  216. 'root) is allocated.
  217. Private vBinTree() As rNode
  218. Private lBinTreeMax As Long     'The same as UBound(vBinTree)
  219. Private lBinTreeNext As Long    '0=empty, 1=only 0 exists etc.
  220. Private lBinTreeRoot As Long    'Initially 0, later anywhere (due to balancing)
  221.  
  222. 'When adding a node, we need to keep track of the visited path, because we do
  223. 'not know before the very insertion if a tree grows higher or not. If it does,
  224. 'this may affect some or all nodes back up to the root, which we do not want to
  225. 'track again when we already have visted them: Instead their indices and also
  226. 'the direction we took (left/right) is held in this vector.
  227. Private vPath() As rPath        'Never shrinks
  228. Private lPathMax As Long        'The same as UBound(vPath)
  229. Private lPathAct As Long        'Current pointer (0=start)
  230.  
  231. 'Last accessed node via "Item", store the continuation points for some public
  232. 'methods like "Higher", "Lower" etc.
  233. Private bLastAcc() As Byte      'Last searched Key via "Item".
  234. Private lLastAcc As Long        'It's index; any "Add" invalidates this (-1).
  235. '_______________________________________________________________________________
  236.  
  237.  
  238.  
  239. 'CONSTRUCTION AND DESTRUCTION
  240. '
  241. Private Sub Class_Initialize()
  242.     'Load error messages
  243.     ErrDesc(ErrNoMallocInterface) = "Creation of a reference to the IMalloc interface failed."
  244.     ErrDesc(ErrFatalAdd) = "Fatal Error in Add"
  245.     ErrDesc(ErrFatalItem) = "Fatal Error in Item"
  246.  
  247.     'Returns a reference to the IMalloc interface. With it we can create and
  248.     'destroy memory. Destroyed on object destruction.
  249.     If Not (SHGetMalloc(ifMalloc) = NOERROR) Then
  250.         'We could not obtain a refernce to the interface.
  251.         Err.Raise ErrNoMallocInterface, ErrClass, ErrDesc(ErrNoMallocInterface)
  252.     End If
  253.  
  254.     'Create some initial nodes for the binary tree. Note, that we are going to
  255.     '*double* this as soon as it does not suffice anymore (adding a constant
  256.     'number *always* becomes a bottleneck at some point of time (when adding lots
  257.     'of elements), even if it's 10000).
  258.     lBinTreeMax = 2&
  259.     ReDim vBinTree(0& To lBinTreeMax) As rNode
  260.     lBinTreeNext = 0&
  261.     lBinTreeRoot = 0&
  262.  
  263.     'Initial vPath() dimensioning to avoid testing for an empty vector.
  264.     lPathMax = NEWELEMENTS - 1&
  265.     ReDim vPath(0& To lPathMax) As rPath
  266. End Sub
  267.  
  268. Private Sub Class_rrDesl',c0ruHF_PrivatelefGhhhhhc DB_Exposed =l',c0ruHF_P___________aovBil"the height sWterxposedNoMall=lPave ag llefGhhheight (SHGetMEt we  (e
  269.   ions in
  270. Private
  271.  
  272. Pe. Inc. Int (SHGetMEt we  (ei
  273.     ReDM
  274.  
  275.     'polrd i
  276. Pwe  (ewe  (see i
  277. Pwe in
  278. PlS=ype)  'polrd i
  279. Pwe  (eweM,moMall=lPlots
  280. DINFM
  281.  
  282.   de  (ewe b*'We=lPlots
  283. DeParet (SHGe0 Suser re tree. moMall=l'cing)
  284. (P., rased reaeique
  285. End n
  286. e treis ___cd Ludl backallocInteru su(sctorBimeioniaaeneck cess  ReDMeuhat RAs vector  'ThishishsEPsn
  287. Pelocate res fac'*dany,shsETea i
  288. +nTr a ip to t'add) = "Fatal mt,M.lewe  ___ anb*'WTd Ludl backalRAsnd =hCdAs 'e to t'add) = "Fatall mt,M.leweck ces(frtole idex)  oole idex) i"i   es(frt
  289.     lBinTrt
  290.    u0nlna.sath(EaoE moMalh(EaoE moMalh(Eaa.sa = ErrBase + 1                   2" _
  291.   'alhckallSIrwall=lPlots
  292. DINFM
  293.  
  294.   the vpoirrBa___ErrorT__Erro= "Fatao"i   Pempty. lNever I=l',c0ruHF_P___________aovBil"the height sWterxposedNoMall=lPave ag llefGhhheight (SHGetMf.2