From 40d0401c954a4f5a657f3c5a33eb06b74042201e Mon Sep 17 00:00:00 2001 From: Mark van Renswoude Date: Thu, 29 Jul 2004 06:33:18 +0000 Subject: [PATCH] Added: initial (non-working) X2UtHashes implementation Changed: restructuring of X2UtBinaryTree to abstract data management --- Test/X2UtHashesTest.cfg | 37 +++++ Test/X2UtHashesTest.dof | 199 ++++++++++++++++++++++++ Test/X2UtHashesTest.dpr | 75 +++++++++ Test/X2UtHashesTest.mes | 61 ++++++++ X2UtBinaryTree.pas | 330 ++++++++++++++++++++++----------------- X2UtHashes.pas | 336 ++++++++++++++++++++++++++++++++++++++++ 6 files changed, 898 insertions(+), 140 deletions(-) create mode 100644 Test/X2UtHashesTest.cfg create mode 100644 Test/X2UtHashesTest.dof create mode 100644 Test/X2UtHashesTest.dpr create mode 100644 Test/X2UtHashesTest.mes create mode 100644 X2UtHashes.pas diff --git a/Test/X2UtHashesTest.cfg b/Test/X2UtHashesTest.cfg new file mode 100644 index 0000000..18d2c3d --- /dev/null +++ b/Test/X2UtHashesTest.cfg @@ -0,0 +1,37 @@ +-$A8 +-$B- +-$C+ +-$D+ +-$E- +-$F- +-$G+ +-$H+ +-$I+ +-$J+ +-$K- +-$L+ +-$M- +-$N+ +-$O+ +-$P+ +-$Q- +-$R+ +-$S- +-$T- +-$U- +-$V+ +-$W- +-$X+ +-$YD +-$Z1 +-GD +-cg +-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +-H+ +-W+ +-M +-$M16384,1048576 +-K$00400000 +-LE"c:\program files\borland\delphi6\Projects\Bpl" +-LN"c:\program files\borland\delphi6\Projects\Bpl" +-DmadExcept diff --git a/Test/X2UtHashesTest.dof b/Test/X2UtHashesTest.dof new file mode 100644 index 0000000..19f8e48 --- /dev/null +++ b/Test/X2UtHashesTest.dof @@ -0,0 +1,199 @@ +[FileVersion] +Version=6.0 +[Compiler] +A=8 +B=0 +C=1 +D=1 +E=0 +F=0 +G=1 +H=1 +I=1 +J=1 +K=0 +L=1 +M=0 +N=1 +O=1 +P=1 +Q=0 +R=1 +S=0 +T=0 +U=0 +V=1 +W=0 +X=1 +Y=1 +Z=1 +ShowHints=1 +ShowWarnings=1 +UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[Linker] +MapFile=3 +OutputObjs=0 +ConsoleApp=1 +DebugInfo=0 +RemoteSymbols=0 +MinStackSize=16384 +MaxStackSize=1048576 +ImageBase=4194304 +ExeDescription=IconXP +[Directories] +OutputDir= +UnitOutputDir= +PackageDLLOutputDir= +PackageDCPOutputDir= +SearchPath= +Packages=vcl;rtl;dbrtl;vcldb;vclx;dss;dsnapcrba;dsnapcon;inetdb;webdsnap;websnap;dbxcds;Irc;parsdpk;hotspotter +Conditionals=madExcept +DebugSourceDirs= +UsePackages=0 +[Parameters] +RunParams= +HostApplication= +Launcher= +UseLauncher=0 +DebugCWD= +[Version Info] +IncludeVerInfo=0 +AutoIncBuild=0 +MajorVer=1 +MinorVer=0 +Release=0 +Build=0 +Debug=0 +PreRelease=0 +Special=0 +Private=0 +DLL=0 +Locale=1043 +CodePage=1252 +[Version Info Keys] +CompanyName= +FileDescription= +FileVersion=1.0.0.0 +InternalName= +LegalCopyright= +LegalTrademarks= +OriginalFilename= +ProductName= +ProductVersion=1.0.0.0 +Comments= +[Excluded Packages] +c:\program files\borland\delphi6\Projects\Bpl\dclIndyCore60.bpl=Indy 10 Core Design Time +c:\program files\borland\delphi6\Projects\Bpl\dclIndyProtocols60.bpl=Indy 10 Protocols Design Time +c:\program files\borland\delphi6\Projects\Bpl\P164_D60.bpl=TurboPower OfficePartner 1.64 Design-time package - VCL60 +c:\program files\borland\delphi6\Projects\Bpl\VirtualTreesD6D.bpl=Virtual Treeview +c:\program files\borland\delphi6\Projects\Bpl\BalloonD6.bpl=Balloon 2.0 +c:\program files\borland\delphi6\Projects\Bpl\SysILS.bpl=(untitled) +c:\program files\borland\delphi6\Projects\Bpl\DragDropD6.bpl=Drag and Drop Component Suite +C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\JvCoreD6D.bpl=JVCL Core Components +C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\JvStdCtrlsD6D.bpl=JVCL Standard Controls +C:\Program Files\Borland\Delphi6\Projects\Bpl\JvCustomD6D.bpl=JVCL Custom Controls +C:\Program Files\Borland\Delphi6\Projects\Bpl\JvCtrlsD6D.bpl=JVCL Visual Controls +C:\Program Files\Borland\Delphi6\Projects\Bpl\JvWizardD6D.bpl=JVCL Wizard Design Time Package +c:\program files\borland\delphi6\Projects\Bpl\dclIndy60.bpl=Internet Direct (Indy) for D6 Property and Component Editors +c:\program files\borland\delphi6\Bin\dclnet60.bpl=Borland Internet Components +c:\program files\borland\delphi6\Bin\dclsoap60.bpl=Borland SOAP Components +c:\program files\borland\delphi6\Projects\Bpl\ColorPickerButtonD6.bpl=ColorPickerButton +C:\Program Files\Borland\Delphi6\Projects\Bpl\ThreadNameExpert60.bpl=JCL Thread Name IDE expert for Delphi 6 +C:\Program Files\Borland\Delphi6\Projects\Bpl\JvDlgsD6D.bpl=JVCL Dialog Components +c:\program files\borland\delphi6\Projects\Bpl\asqlite.bpl=Aducom Software -- SQLite Design Time Components +C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\aSQLitepkg.bpl=Aducom Software -- SQLite RunTime Components +C:\Program Files\Borland\Delphi6\Projects\Bpl\JvAppFrmD6D.bpl=JVCL Application and Form Components +C:\Program Files\Borland\Delphi6\Projects\Bpl\JvBandsD6D.bpl=JVCL Band Objects +C:\Program Files\Borland\Delphi6\Projects\Bpl\JvCmpD6D.bpl=JVCL Non-Visual Components +C:\Program Files\Borland\Delphi6\Projects\Bpl\JvCryptD6D.bpl=JVCL Encryption and Compression Components +C:\Program Files\Borland\Delphi6\Projects\Bpl\JvDockingD6D.bpl=JVCL Docking Components +C:\Program Files\Borland\Delphi6\Projects\Bpl\JvDotNetCtrlsD6D.bpl=JVCL DotNet Controls +C:\Program Files\Borland\Delphi6\Projects\Bpl\JvGlobusD6D.bpl=JVCL Globus Components +C:\Program Files\Borland\Delphi6\Projects\Bpl\JvHMID6D.bpl=JVCL HMI Controls design time unit +C:\Program Files\Borland\Delphi6\Projects\Bpl\JvInterpreterD6D.bpl=JVCL Interpreter Components +C:\Program Files\Borland\Delphi6\Projects\Bpl\JvJansD6D.bpl=JVCL Jans Components +C:\Program Files\Borland\Delphi6\Projects\Bpl\JvManagedThreadsD6D.bpl=JVCL Managed Threads +C:\Program Files\Borland\Delphi6\Projects\Bpl\JvMMD6D.bpl=JVCL Multimedia and Image Components +C:\Program Files\Borland\Delphi6\Projects\Bpl\JvNetD6D.bpl=JVCL Network Components +C:\Program Files\Borland\Delphi6\Projects\Bpl\JvPageCompsD6D.bpl=JVCL Page Style Components +C:\Program Files\Borland\Delphi6\Projects\Bpl\JvPluginD6D.bpl=JVCL Plugin Components +C:\Program Files\Borland\Delphi6\Projects\Bpl\JvPrintPreviewD6D.bpl=JVCL Print Preview Components +C:\Program Files\Borland\Delphi6\Projects\Bpl\JvSystemD6D.bpl=JVCL System Components +C:\Program Files\Borland\Delphi6\Projects\Bpl\JvTimeFrameworkD6D.bpl=JVCL Time Framework +C:\Program Files\Borland\Delphi6\Projects\Bpl\JvValidatorsD6D.bpl=JVCL Validators and Error Provider Components +C:\Program Files\Borland\Delphi6\Projects\Bpl\JvXPCtrlsD6D.bpl=JVCL XP Controls +c:\program files\borland\delphi6\Projects\Bpl\GJLSoftwareD5.bpl=GJL Software ExDBGrid Components +c:\program files\borland\delphi6\Projects\Bpl\FREEREP6.bpl=FreeReport 2.32 Components +c:\program files\borland\delphi6\Projects\Bpl\PageControlExD6.bpl=PageControlEx +F:\Delphi\Components\madCollection\madExcept\Delphi 6\madExceptIde_.bpl=madExceptIde 1.0b · www.madshi.net +c:\program files\borland\delphi6\Projects\Bpl\ZCore.bpl=Zeos Core Classes and Intefaces +c:\program files\borland\delphi6\Projects\Bpl\ZParse.bpl=Zeos Parsing Classes and Intefaces +c:\program files\borland\delphi6\Projects\Bpl\ZParseSql.bpl=Zeos SQL Parsing Classes and Intefaces +c:\program files\borland\delphi6\Projects\Bpl\ZPlain.bpl=Zeos Plain Database API +c:\program files\borland\delphi6\Projects\Bpl\ZDbc.bpl=Zeos Low Level Database API +c:\program files\borland\delphi6\Projects\Bpl\ZComponent.bpl=Zeos Database Components +c:\program files\borland\delphi6\Projects\Bpl\IconXPD6.bpl=IconXP +c:\program files\borland\delphi6\Projects\Bpl\NLDVDBT_D6D.bpl=NLDVirtualDBTree +c:\program files\borland\delphi6\Projects\Bpl\ff2_d60.bpl=TurboPower FlashFiler Designtime Package - VCL60 +C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\GR32_D6.bpl=Graphics32 +c:\program files\borland\delphi6\Projects\Bpl\GR32_DSGN_D6.bpl=Graphics32 Design Time Package +c:\program files\borland\delphi6\Projects\Bpl\PNGImage_D6.bpl=PNGImage +C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\tbx_d6.bpl=Toolbar2000 -- TBX Extensions (Alex Denisov) +C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\tb2k_d6.bpl=Toolbar2000 Components (Jordan Russell) +c:\program files\borland\delphi6\Projects\Bpl\tbxdsgn_d6.bpl=Toolbar2000 -- TBX Extensions Design Package (Alex Denisov) +C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\tb2kdsgn_d6.bpl=Toolbar2000 Design Package (Jordan Russell) +c:\program files\borland\delphi6\Projects\Bpl\SynEdit_D6.bpl=SynEdit component suite +c:\program files\borland\delphi6\Projects\Bpl\DelphiX_for5.bpl=DelphiX - DirectX components for Delphi +c:\program files\borland\delphi6\Projects\Bpl\NLDMBD6D.bpl=NLDMessageBox +c:\program files\borland\delphi6\Bin\dcl31w60.bpl=Delphi 1.0 Compatibility Components +c:\program files\borland\delphi6\Projects\Bpl\NLDTrayIconD6.bpl=NLDTrayIcon donated by SVG_1986 +c:\program files\borland\delphi6\Projects\Bpl\ServerListD6D.bpl=SOF2Manager - Server List Designtime +C:\WINDOWS\System32\ibevnt60.bpl=Borland Interbase Event Alerter Component +F:\Delphi\Components\madCollection\madBasic\Delphi 6\madHelp_.bpl=madHelp 1.1 · www.madshi.net +F:\Delphi\Components\madCollection\madRemote\Delphi 6\madRemote_.bpl=madRemote 1.1a · www.madshi.net +F:\Delphi\Components\madCollection\madKernel\Delphi 6\madKernel_.bpl=madKernel 1.2z · www.madshi.net +F:\Delphi\Components\madCollection\madCodeHook\Delphi 6\madCodeHook_.bpl=madCodeHook 2.0a · www.madshi.net +F:\Delphi\Components\madCollection\madSecurity\Delphi 6\madSecurity_.bpl=madSecurity 1.1n · www.madshi.net +F:\Delphi\Components\madCollection\madShell\Delphi 6\madShell_.bpl=madShell 1.3i · www.madshi.net +c:\program files\borland\delphi6\Projects\Bpl\BMSpinEditD6.bpl=BMSpinEdit +c:\program files\borland\delphi6\Projects\Bpl\GLScene6.bpl=GLScene - OpenGL 3D library +c:\program files\borland\delphi6\Projects\Bpl\TntUnicodeVcl_D60.bpl=Tnt Unicode Controls +c:\program files\borland\delphi6\Bin\dclsmp60.bpl=Borland Sample Components +c:\program files\borland\delphi6\Projects\Bpl\X2MultiMon_D6D.bpl=X2MultiMon Designtime Package +F:\Delphi\Components\ZipForge\Lib\Delphi 6\dclZipForged6.bpl=ZipForge Package +c:\program files\borland\delphi6\Bin\dclado60.bpl=Borland ADO DB Components +c:\program files\borland\delphi6\Bin\dclbde60.bpl=Borland BDE DB Components +C:\Program Files\Borland\Delphi6\Bin\dbx60.bpl=Borland SQL Explorer UI Package +c:\program files\borland\delphi6\Bin\DCLIB60.bpl=InterBase Data Access Components +c:\program files\borland\delphi6\Bin\dclbdecds60.bpl=Borland Local BDE ClientDataset Components +c:\program files\borland\delphi6\Bin\dclqrt60.bpl=QuickReport Components +c:\program files\borland\delphi6\Bin\dcltee60.bpl=TeeChart Components +c:\program files\borland\delphi6\Bin\dcldss60.bpl=Borland Decision Cube Components +c:\program files\borland\delphi6\Bin\dcltqr60.bpl=TeeChart for QuickReport Components +c:\program files\borland\delphi6\Bin\dclclxdb60.bpl=Borland CLX Database Components +C:\Program Files\Borland\Delphi6\Bin\dclclxstd60.bpl=Borland CLX Standard Components +c:\program files\borland\delphi6\Bin\dclmcn60.bpl=Borland DataSnap Connection Components +c:\program files\borland\delphi6\Bin\applet60.bpl=Borland Control Panel Applet Package +c:\program files\borland\delphi6\Bin\dclemacsedit60.bpl=Borland Editor Emacs Enhancements +c:\program files\borland\delphi6\Bin\dclshlctrls60.bpl=Shell Control Property and Component Editors +c:\program files\borland\delphi6\Bin\DBWEBXPRT.BPL=Borland Web Wizard Package +c:\program files\borland\delphi6\Bin\dclwbm60.bpl=Borland InternetExpress Components +c:\program files\borland\delphi6\Bin\dclie60.bpl=Internet Explorer Components +c:\program files\borland\delphi6\Bin\dclwebsnap60.bpl=Borland WebSnap Components +c:\program files\borland\delphi6\Bin\dclite60.bpl=Borland Integrated Translation Environment +c:\program files\borland\delphi6\Bin\dcldbx60.bpl=Borland dbExpress Components +c:\program files\borland\delphi6\Bin\dcldbxcds60.bpl=Borland Local DBX ClientDataset Components +c:\program files\borland\delphi6\Projects\Bpl\v103_d60.bpl=TurboPower VisualPlanIt 1.03 designtime package - VCL60 +[Included Packages] +C:\Program Files\Borland\Delphi6\Bin\dclstd60.bpl=Borland Standard Components +c:\program files\borland\delphi6\Bin\dclsmpedit60.bpl=Borland Editor Script Enhancements +C:\Program Files\Borland\Delphi6\Bin\dcldb60.bpl=Borland Database Components +C:\Program Files\Borland\Delphi6\Bin\dclact60.bpl=Borland ActionBar Components +F:\Delphi\Components\madCollection\madBasic\Delphi 6\madBasic_.bpl=madBasic 1.1f · www.madshi.net +F:\Delphi\Components\madCollection\madDisAsm\Delphi 6\madDisAsm_.bpl=madDisAsm 2.0a · www.madshi.net +F:\Delphi\Components\madCollection\madExcept\Delphi 6\madExcept_.bpl=madExcept 2.6a · www.madshi.net +F:\Delphi\Components\madCollection\madExcept\Delphi 6\madExceptWizard_.bpl=madExceptWizard 2.6 · www.madshi.net +c:\program files\borland\delphi6\Bin\dclcds60.bpl=Borland Base Cached ClientDataset Component +C:\Program Files\Borland\Delphi6\Bin\dclmid60.bpl=Borland MyBase DataAccess Components +H:\Downloads\commentexpert.bpl=Comment Expert v1.0 Alpha +C:\PROGRA~1\Borland\Delphi6\Projects\Bpl\ThemeManager6.bpl=Windows XP Theme Manager diff --git a/Test/X2UtHashesTest.dpr b/Test/X2UtHashesTest.dpr new file mode 100644 index 0000000..05c0c06 --- /dev/null +++ b/Test/X2UtHashesTest.dpr @@ -0,0 +1,75 @@ +program X2UtHashesTest; + +{$APPTYPE CONSOLE} + +uses + madExcept, + madLinkDisAsm, + SysUtils, + X2UtHashes, + X2UtBinaryTree; + + +procedure DebugBTree(const ANode: PX2UtBTreeNode; const AIndent: Integer = 0); +begin + WriteLn(StringOfChar(' ', AIndent), ANode^.Index); + + if Assigned(ANode^.Left) then + DebugBTree(ANode^.Left, AIndent + 2); + + if Assigned(ANode^.Right) then + DebugBTree(ANode^.Right, AIndent + 2); +end; + + +type + THackBTree = class(TX2UtCustomBTree); + +var + shData: TX2UtStringHash; + btTest: TX2UtStringBTree; + iItem: Integer; + pItem: PX2UtBTreeNode; + +begin + // Test binary tree + { + btTest := TX2UtStringBTree.Create(); + try + Randomize(); + for iItem := 0 to 31 do + btTest[Random(500)] := 'bla'; + + btTest[300] := 'bla'; + btTest.Delete(300); + + // Heh, hacking my own class. This is just for debugging the tree, + // there should never be any need to access the root node outside of the + // class otherwise, so I made it protected. + pItem := THackBTree(btTest).Root; + DebugBTree(pItem); + + WriteLn; + btTest.Reset(); + while btTest.Next() do + WriteLn(btTest.CurrentIndex, ' - ', btTest.CurrentValue); + finally + FreeAndNil(btTest); + ReadLn; + end; + } + + shData := TX2UtStringHash.Create(); + try + shData['this'] := 'is'; + shData['a'] := 'test'; + + shData.Reset(); + while shData.Next() do + Write(shData.CurrentKey, ': ', shData.CurrentValue, ' (', + shData[shData.CurrentKey], ')'); + finally + FreeAndNil(shData); + ReadLn; + end; +end. diff --git a/Test/X2UtHashesTest.mes b/Test/X2UtHashesTest.mes new file mode 100644 index 0000000..ea7e070 --- /dev/null +++ b/Test/X2UtHashesTest.mes @@ -0,0 +1,61 @@ +[GeneralSettings] +AppendMapFileToBinary=1 +HandleExceptions=1 +CheckForFrozenMainThread=0 +FreezeTimeout=60000 +ShowExceptionBox=1 +SuspendAllRunningThreads=1 +AutomaticallySaveBugReport=0 +AutomaticallyMailBugReport=0 +CopyBugReportToClipboard=0 +AutomaticallyContinueApplication=0 +AutomaticallyRestartApplication=0 +AutomaticallyCloseApplication=0 +MailAddress=team@x2software.net +MailSubject=Bug Report +AttachBugReportFile=0 +DeleteBugReportFile=0 +MailAsSmtpServer=1 +MailAsSmtpClient=0 +MailViaMapi=1 +MailViaMailto=1 +SmtpServer= +SmtpPort=25 +SmtpAccount= +SmtpPassword= +MailSuccessMsg=The mail was sent successfully. +MailFailureMsg=Sorry, sending the mail didn't work. +BugReportFile=bugreport.txt +AppendBugReports=1 +BugReportFileSize=50000 +VersionVariable= +[ExceptionBox] +TitleBar=%appname% +ExceptionMessage=An error occurred in the application. +FrozenMessage=The application seems to be frozen. +ShowButtonMailBugReport=1 +ShowButtonSaveBugReport=0 +ShowButtonPrintBugReport=0 +ShowButtonShowBugReport=1 +ShowButtonContinueApplication=1 +ShowButtonRestartApplication=1 +ShowButtonCloseApplication=1 +MailBugReportText=mail bug report +SaveBugReportText=save bug report +PrintBugReportText=print bug report +ShowBugReportText=show bug report +ContinueApplicationText=continue application +RestartApplicationText=restart application +CloseApplicationText=close application +FocusedButton=0 +AutomaticallyShowBugReport=0 +[BugReport] +ListThreads=1 +ListModules=1 +Disassembly=1 +HideUglyItems=0 +ShowRelativeAddrs=0 +FormatDisassembly=1 +LimitDisassembly=5 +[UnitInitOrder] +UnitInitOrder=ShareMem, HPMM, MultiMM, nxllMemoryManager, nxReplacementMemoryManager diff --git a/X2UtBinaryTree.pas b/X2UtBinaryTree.pas index e621773..a35c68a 100644 --- a/X2UtBinaryTree.pas +++ b/X2UtBinaryTree.pas @@ -1,9 +1,9 @@ { :: X2UtBinaryTree contains an implementation of the binary tree algorithm, :: along with various descendants which implement support for a range of value - :: types other than the default pointers (such as integers or strings). This - :: effectively makes it an associative array based on an integer key. - :: For a hash implementation based on string keys use the X2UtHashes unit. + :: types (such as pointers, integers and strings). This effectively makes it + :: an associative array based on an integer key. For a hash implementation + :: based on string keys use the X2UtHashes unit. :: :: P.S. I realise that a "B-Tree" is different from a binary tree. For :: convenience reasons I will however ignore your ranting and call my @@ -17,7 +17,8 @@ unit X2UtBinaryTree; interface uses - SysUtils; + SysUtils, + VirtualTrees; type //:$ Raised when the cursor is invalid. @@ -30,10 +31,10 @@ type PX2UtBTreeNode = ^TX2UtBTreeNode; TX2UtBTreeNode = record Index: Cardinal; - Value: Pointer; Parent: PX2UtBTreeNode; Left: PX2UtBTreeNode; Right: PX2UtBTreeNode; + Data: record end; end; { @@ -57,7 +58,8 @@ type { :$ Binary tree implementation - :: This class implements a binary tree of pointer values. + :: This class implements a binary tree without knowing anything about + :: the data it contains. } TX2UtCustomBTree = class(TObject) private @@ -65,41 +67,41 @@ type FCursor: PX2UtBTreeNode; FIsReset: Boolean; FParent: TX2UtBTreeStack; + + FNodeSize: Cardinal; + FDataSize: Cardinal; + + function GetTotalSize(): Cardinal; protected - function GetItem(Index: Cardinal): Pointer; - procedure SetItem(Index: Cardinal; const Value: Pointer); function GetCurrentIndex(): Cardinal; - function GetCurrentValue(): Pointer; + function GetNodeData(const ANode: PX2UtBTreeNode): Pointer; virtual; function LookupNode(const AIndex: Cardinal; - const ACreate: Boolean = False; - const ACursor: Boolean = False): PX2UtBTreeNode; virtual; + const ACanCreate: Boolean = False; + const ASetCursor: Boolean = False): PX2UtBTreeNode; - procedure NewNode(const AParent: PX2UtBTreeNode; - var ANode: PX2UtBTreeNode; - const AAutoInit: Boolean = True); virtual; procedure InitNode(var ANode: PX2UtBTreeNode); virtual; - procedure DeleteNode(var ANode: PX2UtBTreeNode); virtual; + procedure FreeNode(var ANode: PX2UtBTreeNode); virtual; procedure ClearCursor(); virtual; + function ValidCursor(const ARaiseError: Boolean = True): Boolean; virtual; - property Cursor: PX2UtBTreeNode read FCursor write FCursor; - property Root: PX2UtBTreeNode read FRoot; - property IsReset: Boolean read FIsReset write FIsReset; - property Parent: TX2UtBTreeStack read FParent; + property Cursor: PX2UtBTreeNode read FCursor write FCursor; + property Root: PX2UtBTreeNode read FRoot; + property IsReset: Boolean read FIsReset write FIsReset; + property Parent: TX2UtBTreeStack read FParent; - - //:$ Gets or sets an item. - property Items[Index: Cardinal]: Pointer read GetItem - write SetItem; default; + property NodeSize: Cardinal read FNodeSize; + property TotalSize: Cardinal read GetTotalSize; + + // Note: do NOT change DataSize after the first node has + // been created! This will result in an Access Violation! + property DataSize: Cardinal read FDataSize write FDataSize; //:$ Returns the index at the current cursor location. property CurrentIndex: Cardinal read GetCurrentIndex; - - //:$ Returns the value at the current cursor location. - property CurrentValue: Pointer read GetCurrentValue; public - constructor Create(); + constructor Create(); virtual; destructor Destroy(); override; //:$ Clears the tree. @@ -120,24 +122,33 @@ type //:: CurrentValue properties will only be valid within the traversal. //:! Adding or removing items will result in a loss of the current cursor //:! until the next Reset call. - procedure Reset(); + procedure Reset(); virtual; //:$ Moves the node cursor to the next node. //:! The order in which nodes are traversed is from top to bottom, left //:! to right. Do not depend on the binary tree to sort the output. - function Next(): Boolean; + function Next(): Boolean; virtual; end; { - :$ Binary tree implementation - - :: This class exposes TX2UtCustomBTree's properties + :$ Binary tree implementation for pointer values } TX2UtBTree = class(TX2UtCustomBTree) + private + function GetItem(Index: Cardinal): Pointer; + procedure SetItem(Index: Cardinal; const Value: Pointer); + + function GetCurrentValue(): Pointer; public - property Items; + constructor Create(); override; property CurrentIndex; - property CurrentValue; + + //:$ Gets or sets an item. + property Items[Index: Cardinal]: Pointer read GetItem + write SetItem; default; + + //:$ Returns the value at the current cursor location + property CurrentValue: Pointer read GetCurrentValue; end; { @@ -160,15 +171,19 @@ type { :$ Binary tree implementation for string values } - TX2UtStringBTree = class(TX2UtBTree) + TX2UtStringBTree = class(TX2UtCustomBTree) protected function GetItem(Index: Cardinal): String; procedure SetItem(Index: Cardinal; const Value: String); + function GetCurrentValue(): String; protected procedure InitNode(var ANode: PX2UtBTreeNode); override; - procedure DeleteNode(var ANode: PX2UtBTreeNode); override; + procedure FreeNode(var ANode: PX2UtBTreeNode); override; public + constructor Create(); override; + property CurrentIndex; + //:$ Gets or sets an item. property Items[Index: Cardinal]: String read GetItem write SetItem; default; @@ -179,16 +194,14 @@ type implementation resourcestring - RSOrphanNode = 'Node does not seem to belong to it''s parent!'; - RSInvalidCursor = 'Cursor is invalid!'; - RSTooManyPops = 'More Pops than Pushes!'; + RSOrphanNode = 'BUG: Node does not seem to belong to it''s parent!'; + RSInvalidCursor = 'Cursor is invalid!'; + RSTooManyPops = 'More Pops than Pushes!'; + RSInvalidDataSize = 'Invalid data size!'; const CStackSize = 32; -type - PString = ^String; - {======================== TX2UtBTreeStack Item Management @@ -260,14 +273,16 @@ constructor TX2UtCustomBTree.Create; begin inherited; - NewNode(nil, FRoot, False); - FParent := TX2UtBTreeStack.Create(); + FParent := TX2UtBTreeStack.Create(); + FNodeSize := SizeOf(TX2UtBTreeNode); end; destructor TX2UtCustomBTree.Destroy; begin FreeAndNil(FParent); - DeleteNode(FRoot); + + if Assigned(FRoot) then + FreeNode(FRoot); inherited; end; @@ -276,30 +291,37 @@ end; {======================= TX2UtCustomBTree Tree Management ========================================} +function TX2UtCustomBTree.GetNodeData; +begin + Assert(DataSize > 0, RSInvalidDataSize); + Result := Pointer(Cardinal(ANode) + NodeSize); +end; + function TX2UtCustomBTree.LookupNode; var - pNode: PX2UtBTreeNode; + pNode: PX2UtBTreeNode; begin Result := nil; - pNode := Root; - if not Assigned(pNode^.Value) then + if not Assigned(FRoot) then begin - InitNode(pNode); - pNode^.Index := AIndex; - Result := pNode; - - if ACursor then + if ACanCreate then begin - Parent.Clear(); - IsReset := False; - Cursor := pNode; + InitNode(FRoot); + Result := FRoot; + + if ASetCursor then + begin + Parent.Clear(); + Cursor := FRoot; + end; end; exit; end; + pNode := Root; while Assigned(pNode) do begin if AIndex = pNode^.Index then @@ -312,11 +334,12 @@ begin pNode := pNode^.Left else begin - if ACreate then + if ACanCreate then begin - NewNode(pNode, pNode^.Left); - Result := pNode^.Left; - Result^.Index := AIndex; + InitNode(pNode^.Left); + Result := pNode^.Left; + Result^.Index := AIndex; + Result^.Parent := pNode; end; break; @@ -327,11 +350,12 @@ begin pNode := pNode^.Right else begin - if ACreate then + if ACanCreate then begin - NewNode(pNode, pNode^.Right); - Result := pNode^.Right; - Result^.Index := AIndex; + InitNode(pNode^.Right); + Result := pNode^.Right; + Result^.Index := AIndex; + Result^.Parent := pNode; end; break; @@ -339,9 +363,10 @@ begin end; end; - if ACursor and Assigned(Result) then + if ASetCursor and Assigned(Result) then begin // Trace parents + Parent.Clear(); pNode := Result^.Parent; while Assigned(pNode) do begin @@ -355,29 +380,20 @@ begin end; -procedure TX2UtCustomBTree.NewNode; -begin - New(ANode); - FillChar(ANode^, SizeOf(TX2UtBTreeNode), #0); - ANode^.Parent := AParent; - ClearCursor(); - - if AAutoInit then - InitNode(ANode); -end; - procedure TX2UtCustomBTree.InitNode; begin - // Reserved for descendants + Assert(DataSize > 0, RSInvalidDataSize); + GetMem(ANode, TotalSize); + FillChar(ANode^, TotalSize, #0); end; -procedure TX2UtCustomBTree.DeleteNode; +procedure TX2UtCustomBTree.FreeNode; begin if Assigned(ANode^.Left) then - DeleteNode(ANode^.Left); + FreeNode(ANode^.Left); if Assigned(ANode^.Right) then - DeleteNode(ANode^.Right); + FreeNode(ANode^.Right); if Assigned(ANode^.Parent) then if ANode^.Parent^.Left = ANode then @@ -387,15 +403,17 @@ begin else Assert(False, RSOrphanNode); - Dispose(ANode); + FreeMem(ANode, TotalSize); ClearCursor(); + + ANode := nil; end; procedure TX2UtCustomBTree.Clear; begin - DeleteNode(FRoot); - NewNode(nil, FRoot, False); + if Assigned(FRoot) then + FreeNode(FRoot); end; procedure TX2UtCustomBTree.Delete; @@ -405,7 +423,7 @@ var begin pItem := LookupNode(AIndex); if Assigned(pItem) then - DeleteNode(pItem); + FreeNode(pItem); end; function TX2UtCustomBTree.Exists; @@ -418,6 +436,14 @@ end; {======================= TX2UtCustomBTree Tree Traversing ========================================} +function TX2UtCustomBTree.ValidCursor; +begin + Result := (Assigned(Cursor) and (not IsReset)); + + if (not Result) and (ARaiseError) then + raise EX2UtBTreeInvalidCursor.Create(RSInvalidCursor); +end; + procedure TX2UtCustomBTree.ClearCursor; begin Cursor := nil; @@ -436,10 +462,14 @@ var pCurrent: PX2UtBTreeNode; begin - if not Assigned(Cursor) then - raise EX2UtBTreeInvalidCursor.Create(RSInvalidCursor); - Result := False; + + if not Assigned(Cursor) then + begin + IsReset := False; + exit; + end; + if not IsReset then begin if Assigned(Cursor^.Left) then @@ -486,43 +516,53 @@ end; function TX2UtCustomBTree.GetCurrentIndex; begin - if Assigned(Cursor) and (not IsReset) then - Result := Cursor^.Index - else - raise EX2UtBTreeInvalidCursor.Create(RSInvalidCursor); + Result := 0; + if ValidCursor(True) then + Result := Cursor^.Index; end; -function TX2UtCustomBTree.GetCurrentValue; +function TX2UtCustomBTree.GetTotalSize; begin - if Assigned(Cursor) and (not IsReset) then - Result := Cursor^.Value - else - raise EX2UtBTreeInvalidCursor.Create(RSInvalidCursor); + Result := FNodeSize + FDataSize; end; -{======================= TX2UtCustomBTree - Items +{============================= TX2UtBTree + Item Management ========================================} -function TX2UtCustomBTree.GetItem; +constructor TX2UtBTree.Create; +begin + inherited; + + DataSize := SizeOf(Pointer); +end; + +function TX2UtBTree.GetItem; var - pItem: PX2UtBTreeNode; + pNode: PX2UtBTreeNode; begin Result := nil; - pItem := LookupNode(Index); - if Assigned(pItem) then - Result := pItem^.Value; + pNode := LookupNode(Index); + if Assigned(pNode) then + Result := PPointer(GetNodeData(pNode))^; end; -procedure TX2UtCustomBTree.SetItem; +procedure TX2UtBTree.SetItem; var - pItem: PX2UtBTreeNode; + pNode: PX2UtBTreeNode; begin - pItem := LookupNode(Index, True); - if Assigned(pItem) then - pItem^.Value := Value; + pNode := LookupNode(Index, True); + if Assigned(pNode) then + PPointer(GetNodeData(pNode))^ := Value; +end; + +function TX2UtBTree.GetCurrentValue; +begin + Result := nil; + if ValidCursor(True) then + Result := PPointer(GetNodeData(Cursor))^; end; @@ -548,51 +588,61 @@ end; {======================= TX2UtStringBTree Item Management ========================================} -function TX2UtStringBTree.GetItem; -var - pItem: PX2UtBTreeNode; - +constructor TX2UtStringBTree.Create; begin - Result := ''; - pItem := LookupNode(Index); - if Assigned(pItem) then - Result := PString(pItem^.Value)^; -end; + inherited; -procedure TX2UtStringBTree.SetItem; -var - pItem: PX2UtBTreeNode; - -begin - pItem := LookupNode(Index, True); - if Assigned(pItem) then - PString(pItem^.Value)^ := Value; -end; - -function TX2UtStringBTree.GetCurrentValue; -var - pValue: PString; - -begin - Result := ''; - pValue := inherited GetCurrentValue(); - if Assigned(pValue) then - Result := pValue^; + DataSize := SizeOf(PString); end; procedure TX2UtStringBTree.InitNode; +var + pData: PString; + begin inherited; - New(PString(ANode^.Value)); + pData := GetNodeData(ANode); + Initialize(pData^); end; -procedure TX2UtStringBTree.DeleteNode; -begin - Dispose(PString(ANode^.Value)); +procedure TX2UtStringBTree.FreeNode; +var + pData: PString; +begin + pData := GetNodeData(ANode); + Finalize(pData^); + inherited; end; + +function TX2UtStringBTree.GetItem; +var + pNode: PX2UtBTreeNode; + +begin + pNode := LookupNode(Index); + if Assigned(pNode) then + Result := PString(GetNodeData(pNode))^; +end; + +procedure TX2UtStringBTree.SetItem; +var + pNode: PX2UtBTreeNode; + +begin + pNode := LookupNode(Index, True); + if Assigned(pNode) then + PString(GetNodeData(pNode))^ := Value; +end; + +function TX2UtStringBTree.GetCurrentValue; +begin + if ValidCursor(True) then + Result := PString(GetNodeData(Cursor))^; +end; + end. diff --git a/X2UtHashes.pas b/X2UtHashes.pas new file mode 100644 index 0000000..d3a0f5e --- /dev/null +++ b/X2UtHashes.pas @@ -0,0 +1,336 @@ +{ + :: X2UtHashes contains a base class for hashes (also known as associative + :: arrays), as well as various default implementations. + :: + :: This unit contains code based on Bob Jenkins' optimized hashing algorithm: + :: http://burtleburtle.net/bob/hash/doobs.html + :: + :: Last changed: $Date$ + :: Revision: $Rev$ + :: Author: $Author$ +} +unit X2UtHashes; + +interface +uses + SysUtils, + X2UtBinaryTree; + +type + { + :$ Internal representation of a hash node + } + PX2UtHashNode = ^TX2UtHashNode; + TX2UtHashNode = record + Prev: PX2UtHashNode; + Next: PX2UtHashNode; + Key: String; + Value: record end; + end; + + { + :$ Hash implementation + + :: This class implements a hash without knowing anything about + :: the data it contains. + } + TX2UtCustomHash = class(TX2UtCustomBTree) + private + FHashCursor: PX2UtHashNode; + FHashDataSize: Cardinal; + + function GetCurrentKey(): String; + protected + function Hash(const AValue: String): Cardinal; virtual; + + function LookupNode(const AKey: String; + const ACanCreate: Boolean = False; + const ASetCursor: Boolean = False): PX2UtBTreeNode; + + procedure InitNode(var ANode: PX2UtBTreeNode); override; + procedure FreeNode(var ANode: PX2UtBTreeNode); override; + + procedure ClearCursor(); override; + function ValidCursor(const ARaiseError: Boolean = True): Boolean; override; + + procedure InitHashNode(var ANode: PX2UtHashNode); virtual; + procedure FreeHashNode(var ANode: PX2UtHashNode); virtual; + + property HashDataSize: Cardinal read FHashDataSize write FHashDataSize; + + //:$ Returns the key at the current cursor location. + property CurrentKey: String read GetCurrentKey; + public + //:$ Deletes an item from the hash. + procedure Delete(const AKey: String); + + function Next(): Boolean; override; + + //:$ Checks if a key exists in the hash. + //:: If the ASetCursor parameter is set to True, the cursor will be + //:: positioned at the item if it is found. + function Exists(const AKey: String; const ASetCursor: Boolean = False): Boolean; + end; + + { + :$ Hash implementation for pointer values + } + (* + TX2UtHash = class(TX2UtCustomHash) + private + function GetItem(Key: String): Pointer; + procedure SetItem(Key: String; const Value: Pointer); + + function GetCurrentValue(): Pointer; + public + constructor Create(); override; + property CurrentKey; + + //:$ Gets or sets an item. + property Items[Key: String]: Pointer read GetItem + write SetItem; default; + + //:$ Returns the value at the current cursor location. + property CurrentValue: Pointer read GetCurrentValue; + end; + + { + :$ Hash implementation for string values + } + TX2UtStringHash = class(TX2UtCustomHash) + private + function GetItem(Key: String): String; + procedure SetItem(Key: String; const Value: String); + + function GetCurrentValue(): String; + protected + procedure InitNode(var ANode: PX2UtBTreeNode); override; + procedure FreeNode(var ANode: PX2UtBTreeNode); override; + public + constructor Create(); override; + property CurrentKey; + + //:$ Gets or sets an item. + property Items[Key: String]: String read GetItem + write SetItem; default; + + //:$ Returns the value at the current cursor location. + property CurrentValue: String read GetCurrentValue; + end; + *) + +implementation + +{======================== TX2UtCustomHash + Hashing +========================================} +function TX2UtCustomHash.Hash; +begin + Result := 0; +end; + + + +{======================== TX2UtCustomHash + Tree Traversing +========================================} +function TX2UtCustomHash.ValidCursor; +begin + Result := inherited ValidCursor(ARaiseError); + if Result then + begin + end; +end; + +procedure TX2UtCustomHash.ClearCursor; +begin + inherited; + + FHashCursor := nil; +end; + +function TX2UtCustomHash.Next; +begin + if Assigned(FHashCursor) then + FHashCursor := FHashCursor^.Next; + + if not Assigned(FHashCursor) then + begin + Result := inherited Next(); + if Result then + FHashCursor := GetNodeData(Cursor); + end else + Result := True; +end; + + +{======================== TX2UtCustomHash + Item Management +========================================} +function TX2UtCustomHash.LookupNode; +var + iIndex: Integer; + pNode: PX2UtBTreeNode; + +begin + iIndex := Hash(AKey); + pNode := inherited LookupNode(iIndex, ACanCreate, ASetCursor); +end; + + +procedure TX2UtCustomHash.Delete; +begin + inherited Delete(Hash(AKey)); +end; + +function TX2UtCustomHash.Exists; +begin + Result := inherited Exists(Hash(AKey), ASetCursor); +end; + + +function TX2UtCustomHash.GetCurrentKey; +var + pKey: PString; + +begin + Result := ''; + if ValidCursor(True) then + begin + { + pKey := GetNodeInternal(Cursor); + Result := pKey^; + } + end; +end; + + +procedure TX2UtCustomHash.InitNode; +var + pData: PString; + +begin + inherited; + + { + pData := GetNodeInternal(ANode); + Initialize(pData^); + } +end; + +procedure TX2UtCustomHash.FreeNode; +var + pData: PString; + +begin + { + pData := GetNodeInternal(ANode); + Finalize(pData^); + } + + inherited; +end; + + +{============================== TX2UtHash + Item Management +========================================} +constructor TX2UtHash.Create; +begin + inherited; + + DataSize := SizeOf(Pointer); +end; + +function TX2UtHash.GetItem; +var + pNode: PX2UtBTreeNode; + +begin + pNode := LookupNode(Key); + if Assigned(pNode) then + Result := PPointer(GetNodeData(pNode))^; +end; + +procedure TX2UtHash.SetItem; +var + pNode: PX2UtBTreeNode; + +begin + pNode := LookupNode(Key, True); + if Assigned(pNode) then + PPointer(GetNodeData(pNode))^ := Value; +end; + +function TX2UtHash.GetCurrentValue; +begin + Result := nil; + if ValidCursor(True) then + Result := PPointer(GetNodeData(Cursor))^; +end; + + +{======================== TX2UtStringHash + Item Management +========================================} +constructor TX2UtStringHash.Create; +begin + inherited; + + DataSize := SizeOf(PString); +end; + +function TX2UtStringHash.GetItem; +var + pNode: PX2UtBTreeNode; + +begin + pNode := LookupNode(Key); + if Assigned(pNode) then + Result := PString(GetNodeData(pNode))^; +end; + +procedure TX2UtStringHash.SetItem; +var + pNode: PX2UtBTreeNode; + +begin + pNode := LookupNode(Key, True); + if Assigned(pNode) then + PString(GetNodeData(pNode))^ := Value; +end; + + +procedure TX2UtStringHash.InitNode; +var + pData: PString; + +begin + inherited; + + pData := GetNodeData(ANode); + Initialize(pData^); +end; + +procedure TX2UtStringHash.FreeNode; +var + pData: PString; + +begin + pData := GetNodeData(ANode); + Finalize(pData^); + + inherited; +end; + + +function TX2UtStringHash.GetCurrentValue; +var + pData: PString; + +begin + if ValidCursor() then + Result := PString(GetNodeData(Cursor))^; +end; + +end.