GitHub-Mirror/x2utils
1
0
Fork 0
mirror of synced 2024-12-22 17:23:07 +01:00
Code Issues Projects Releases Wiki Activity

Added: initial (non-working) X2UtHashes implementation

Browse Source 
Changed: restructuring of X2UtBinaryTree to abstract data management
This commit is contained in:
Mark van Renswoude 2004-07-29 06:33:18 +00:00
parent 02fc3996a7
commit 40d0401c95
6 changed files with 898 additions and 140 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
Test/X2UtHashesTest.cfg Normal file
View File

@ -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

199
Test/X2UtHashesTest.dof Normal file
View File

@ -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

75
Test/X2UtHashesTest.dpr Normal file
View File

@ -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.

61
Test/X2UtHashesTest.mes Normal file
View File

@ -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

298
X2UtBinaryTree.pas
View File

@ -1,9 +1,9 @@
{ {
:: X2UtBinaryTree contains an implementation of the binary tree algorithm, :: X2UtBinaryTree contains an implementation of the binary tree algorithm,
:: along with various descendants which implement support for a range of value :: along with various descendants which implement support for a range of value
:: types other than the default pointers (such as integers or strings). This :: types (such as pointers, integers and strings). This effectively makes it
:: effectively makes it an associative array based on an integer key. :: an associative array based on an integer key. For a hash implementation
:: For a hash implementation based on string keys use the X2UtHashes unit. :: based on string keys use the X2UtHashes unit.
:: ::
:: P.S. I realise that a "B-Tree" is different from a binary tree. For :: 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 :: convenience reasons I will however ignore your ranting and call my
@ -17,7 +17,8 @@ unit X2UtBinaryTree;
interface interface
uses uses
SysUtils; SysUtils,
VirtualTrees;
type type
//:$ Raised when the cursor is invalid. //:$ Raised when the cursor is invalid.
@ -30,10 +31,10 @@ type
PX2UtBTreeNode = ^TX2UtBTreeNode; PX2UtBTreeNode = ^TX2UtBTreeNode;
TX2UtBTreeNode = record TX2UtBTreeNode = record
Index: Cardinal; Index: Cardinal;
Value: Pointer;
Parent: PX2UtBTreeNode; Parent: PX2UtBTreeNode;
Left: PX2UtBTreeNode; Left: PX2UtBTreeNode;
Right: PX2UtBTreeNode; Right: PX2UtBTreeNode;
Data: record end;
end; end;
{ {
@ -57,7 +58,8 @@ type
{ {
:$ Binary tree implementation :$ 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) TX2UtCustomBTree = class(TObject)
private private
@ -65,41 +67,41 @@ type
FCursor: PX2UtBTreeNode; FCursor: PX2UtBTreeNode;
FIsReset: Boolean; FIsReset: Boolean;
FParent: TX2UtBTreeStack; FParent: TX2UtBTreeStack;
FNodeSize: Cardinal;
FDataSize: Cardinal;
function GetTotalSize(): Cardinal;
protected protected
function GetItem(Index: Cardinal): Pointer;
procedure SetItem(Index: Cardinal; const Value: Pointer);
function GetCurrentIndex(): Cardinal; function GetCurrentIndex(): Cardinal;
function GetCurrentValue(): Pointer;
function GetNodeData(const ANode: PX2UtBTreeNode): Pointer; virtual;
function LookupNode(const AIndex: Cardinal; function LookupNode(const AIndex: Cardinal;
const ACreate: Boolean = False; const ACanCreate: Boolean = False;
const ACursor: Boolean = False): PX2UtBTreeNode; virtual; 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 InitNode(var ANode: PX2UtBTreeNode); virtual;
procedure DeleteNode(var ANode: PX2UtBTreeNode); virtual; procedure FreeNode(var ANode: PX2UtBTreeNode); virtual;
procedure ClearCursor(); virtual; procedure ClearCursor(); virtual;
function ValidCursor(const ARaiseError: Boolean = True): Boolean; virtual;
property Cursor: PX2UtBTreeNode read FCursor write FCursor; property Cursor: PX2UtBTreeNode read FCursor write FCursor;
property Root: PX2UtBTreeNode read FRoot; property Root: PX2UtBTreeNode read FRoot;
property IsReset: Boolean read FIsReset write FIsReset; property IsReset: Boolean read FIsReset write FIsReset;
property Parent: TX2UtBTreeStack read FParent; property Parent: TX2UtBTreeStack read FParent;
property NodeSize: Cardinal read FNodeSize;
property TotalSize: Cardinal read GetTotalSize;
//:$ Gets or sets an item. // Note: do NOT change DataSize after the first node has
property Items[Index: Cardinal]: Pointer read GetItem // been created! This will result in an Access Violation!
write SetItem; default; property DataSize: Cardinal read FDataSize write FDataSize;
//:$ Returns the index at the current cursor location. //:$ Returns the index at the current cursor location.
property CurrentIndex: Cardinal read GetCurrentIndex; property CurrentIndex: Cardinal read GetCurrentIndex;
//:$ Returns the value at the current cursor location.
property CurrentValue: Pointer read GetCurrentValue;
public public
constructor Create(); constructor Create(); virtual;
destructor Destroy(); override; destructor Destroy(); override;
//:$ Clears the tree. //:$ Clears the tree.
@ -120,24 +122,33 @@ type
//:: CurrentValue properties will only be valid within the traversal. //:: CurrentValue properties will only be valid within the traversal.
//:! Adding or removing items will result in a loss of the current cursor //:! Adding or removing items will result in a loss of the current cursor
//:! until the next Reset call. //:! until the next Reset call.
procedure Reset(); procedure Reset(); virtual;
//:$ Moves the node cursor to the next node. //:$ Moves the node cursor to the next node.
//:! The order in which nodes are traversed is from top to bottom, left //:! 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. //:! to right. Do not depend on the binary tree to sort the output.
function Next(): Boolean; function Next(): Boolean; virtual;
end; end;
{ {
:$ Binary tree implementation :$ Binary tree implementation for pointer values
:: This class exposes TX2UtCustomBTree's properties
} }
TX2UtBTree = class(TX2UtCustomBTree) TX2UtBTree = class(TX2UtCustomBTree)
private
function GetItem(Index: Cardinal): Pointer;
procedure SetItem(Index: Cardinal; const Value: Pointer);
function GetCurrentValue(): Pointer;
public public
property Items; constructor Create(); override;
property CurrentIndex; 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; end;
{ {
@ -160,15 +171,19 @@ type
{ {
:$ Binary tree implementation for string values :$ Binary tree implementation for string values
} }
TX2UtStringBTree = class(TX2UtBTree) TX2UtStringBTree = class(TX2UtCustomBTree)
protected protected
function GetItem(Index: Cardinal): String; function GetItem(Index: Cardinal): String;
procedure SetItem(Index: Cardinal; const Value: String); procedure SetItem(Index: Cardinal; const Value: String);
function GetCurrentValue(): String; function GetCurrentValue(): String;
protected protected
procedure InitNode(var ANode: PX2UtBTreeNode); override; procedure InitNode(var ANode: PX2UtBTreeNode); override;
procedure DeleteNode(var ANode: PX2UtBTreeNode); override; procedure FreeNode(var ANode: PX2UtBTreeNode); override;
public public
constructor Create(); override;
property CurrentIndex;
//:$ Gets or sets an item. //:$ Gets or sets an item.
property Items[Index: Cardinal]: String read GetItem property Items[Index: Cardinal]: String read GetItem
write SetItem; default; write SetItem; default;
@ -179,16 +194,14 @@ type
implementation implementation
resourcestring resourcestring
RSOrphanNode = 'Node does not seem to belong to it''s parent!'; RSOrphanNode = 'BUG: Node does not seem to belong to it''s parent!';
RSInvalidCursor = 'Cursor is invalid!'; RSInvalidCursor = 'Cursor is invalid!';
RSTooManyPops = 'More Pops than Pushes!'; RSTooManyPops = 'More Pops than Pushes!';
RSInvalidDataSize = 'Invalid data size!';
const const
CStackSize = 32; CStackSize = 32;
type
PString = ^String;
{======================== TX2UtBTreeStack {======================== TX2UtBTreeStack
Item Management Item Management
@ -260,14 +273,16 @@ constructor TX2UtCustomBTree.Create;
begin begin
inherited; inherited;
NewNode(nil, FRoot, False);
FParent := TX2UtBTreeStack.Create(); FParent := TX2UtBTreeStack.Create();
FNodeSize := SizeOf(TX2UtBTreeNode);
end; end;
destructor TX2UtCustomBTree.Destroy; destructor TX2UtCustomBTree.Destroy;
begin begin
FreeAndNil(FParent); FreeAndNil(FParent);
DeleteNode(FRoot);
if Assigned(FRoot) then
FreeNode(FRoot);
inherited; inherited;
end; end;
@ -276,30 +291,37 @@ end;
{======================= TX2UtCustomBTree {======================= TX2UtCustomBTree
Tree Management Tree Management
========================================} ========================================}
function TX2UtCustomBTree.GetNodeData;
begin
Assert(DataSize > 0, RSInvalidDataSize);
Result := Pointer(Cardinal(ANode) + NodeSize);
end;
function TX2UtCustomBTree.LookupNode; function TX2UtCustomBTree.LookupNode;
var var
pNode: PX2UtBTreeNode; pNode: PX2UtBTreeNode;
begin begin
Result := nil; Result := nil;
pNode := Root;
if not Assigned(pNode^.Value) then if not Assigned(FRoot) then
begin begin
InitNode(pNode); if ACanCreate then
pNode^.Index := AIndex; begin
Result := pNode; InitNode(FRoot);
Result := FRoot;
if ACursor then if ASetCursor then
begin begin
Parent.Clear(); Parent.Clear();
IsReset := False; Cursor := FRoot;
Cursor := pNode; end;
end; end;
exit; exit;
end; end;
pNode := Root;
while Assigned(pNode) do while Assigned(pNode) do
begin begin
if AIndex = pNode^.Index then if AIndex = pNode^.Index then
@ -312,11 +334,12 @@ begin
pNode := pNode^.Left pNode := pNode^.Left
else else
begin begin
if ACreate then if ACanCreate then
begin begin
NewNode(pNode, pNode^.Left); InitNode(pNode^.Left);
Result := pNode^.Left; Result := pNode^.Left;
Result^.Index := AIndex; Result^.Index := AIndex;
Result^.Parent := pNode;
end; end;
break; break;
@ -327,11 +350,12 @@ begin
pNode := pNode^.Right pNode := pNode^.Right
else else
begin begin
if ACreate then if ACanCreate then
begin begin
NewNode(pNode, pNode^.Right); InitNode(pNode^.Right);
Result := pNode^.Right; Result := pNode^.Right;
Result^.Index := AIndex; Result^.Index := AIndex;
Result^.Parent := pNode;
end; end;
break; break;
@ -339,9 +363,10 @@ begin
end; end;
end; end;
if ACursor and Assigned(Result) then if ASetCursor and Assigned(Result) then
begin begin
// Trace parents // Trace parents
Parent.Clear();
pNode := Result^.Parent; pNode := Result^.Parent;
while Assigned(pNode) do while Assigned(pNode) do
begin begin
@ -355,29 +380,20 @@ begin
end; 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; procedure TX2UtCustomBTree.InitNode;
begin begin
// Reserved for descendants Assert(DataSize > 0, RSInvalidDataSize);
GetMem(ANode, TotalSize);
FillChar(ANode^, TotalSize, #0);
end; end;
procedure TX2UtCustomBTree.DeleteNode; procedure TX2UtCustomBTree.FreeNode;
begin begin
if Assigned(ANode^.Left) then if Assigned(ANode^.Left) then
DeleteNode(ANode^.Left); FreeNode(ANode^.Left);
if Assigned(ANode^.Right) then if Assigned(ANode^.Right) then
DeleteNode(ANode^.Right); FreeNode(ANode^.Right);
if Assigned(ANode^.Parent) then if Assigned(ANode^.Parent) then
if ANode^.Parent^.Left = ANode then if ANode^.Parent^.Left = ANode then
@ -387,15 +403,17 @@ begin
else else
Assert(False, RSOrphanNode); Assert(False, RSOrphanNode);
Dispose(ANode); FreeMem(ANode, TotalSize);
ClearCursor(); ClearCursor();
ANode := nil;
end; end;
procedure TX2UtCustomBTree.Clear; procedure TX2UtCustomBTree.Clear;
begin begin
DeleteNode(FRoot); if Assigned(FRoot) then
NewNode(nil, FRoot, False); FreeNode(FRoot);
end; end;
procedure TX2UtCustomBTree.Delete; procedure TX2UtCustomBTree.Delete;
@ -405,7 +423,7 @@ var
begin begin
pItem := LookupNode(AIndex); pItem := LookupNode(AIndex);
if Assigned(pItem) then if Assigned(pItem) then
DeleteNode(pItem); FreeNode(pItem);
end; end;
function TX2UtCustomBTree.Exists; function TX2UtCustomBTree.Exists;
@ -418,6 +436,14 @@ end;
{======================= TX2UtCustomBTree {======================= TX2UtCustomBTree
Tree Traversing 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; procedure TX2UtCustomBTree.ClearCursor;
begin begin
Cursor := nil; Cursor := nil;
@ -436,10 +462,14 @@ var
pCurrent: PX2UtBTreeNode; pCurrent: PX2UtBTreeNode;
begin begin
if not Assigned(Cursor) then
raise EX2UtBTreeInvalidCursor.Create(RSInvalidCursor);
Result := False; Result := False;
if not Assigned(Cursor) then
begin
IsReset := False;
exit;
end;
if not IsReset then if not IsReset then
begin begin
if Assigned(Cursor^.Left) then if Assigned(Cursor^.Left) then
@ -486,43 +516,53 @@ end;
function TX2UtCustomBTree.GetCurrentIndex; function TX2UtCustomBTree.GetCurrentIndex;
begin begin
if Assigned(Cursor) and (not IsReset) then Result := 0;
Result := Cursor^.Index if ValidCursor(True) then
else Result := Cursor^.Index;
raise EX2UtBTreeInvalidCursor.Create(RSInvalidCursor);
end; end;
function TX2UtCustomBTree.GetCurrentValue; function TX2UtCustomBTree.GetTotalSize;
begin begin
if Assigned(Cursor) and (not IsReset) then Result := FNodeSize + FDataSize;
Result := Cursor^.Value
else
raise EX2UtBTreeInvalidCursor.Create(RSInvalidCursor);
end; end;
{======================= TX2UtCustomBTree {============================= TX2UtBTree
Items Item Management
========================================} ========================================}
function TX2UtCustomBTree.GetItem; constructor TX2UtBTree.Create;
begin
inherited;
DataSize := SizeOf(Pointer);
end;
function TX2UtBTree.GetItem;
var var
pItem: PX2UtBTreeNode; pNode: PX2UtBTreeNode;
begin begin
Result := nil; Result := nil;
pItem := LookupNode(Index); pNode := LookupNode(Index);
if Assigned(pItem) then if Assigned(pNode) then
Result := pItem^.Value; Result := PPointer(GetNodeData(pNode))^;
end; end;
procedure TX2UtCustomBTree.SetItem; procedure TX2UtBTree.SetItem;
var var
pItem: PX2UtBTreeNode; pNode: PX2UtBTreeNode;
begin begin
pItem := LookupNode(Index, True); pNode := LookupNode(Index, True);
if Assigned(pItem) then if Assigned(pNode) then
pItem^.Value := Value; PPointer(GetNodeData(pNode))^ := Value;
end;
function TX2UtBTree.GetCurrentValue;
begin
Result := nil;
if ValidCursor(True) then
Result := PPointer(GetNodeData(Cursor))^;
end; end;
@ -548,51 +588,61 @@ end;
{======================= TX2UtStringBTree {======================= TX2UtStringBTree
Item Management Item Management
========================================} ========================================}
function TX2UtStringBTree.GetItem; constructor TX2UtStringBTree.Create;
var
pItem: PX2UtBTreeNode;
begin begin
Result := ''; inherited;
pItem := LookupNode(Index);
if Assigned(pItem) then
Result := PString(pItem^.Value)^;
end;
procedure TX2UtStringBTree.SetItem; DataSize := SizeOf(PString);
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^;
end; end;
procedure TX2UtStringBTree.InitNode; procedure TX2UtStringBTree.InitNode;
var
pData: PString;
begin begin
inherited; inherited;
New(PString(ANode^.Value)); pData := GetNodeData(ANode);
Initialize(pData^);
end; end;
procedure TX2UtStringBTree.DeleteNode; procedure TX2UtStringBTree.FreeNode;
var
pData: PString;
begin begin
Dispose(PString(ANode^.Value)); pData := GetNodeData(ANode);
Finalize(pData^);
inherited; inherited;
end; 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. end.

336
X2UtHashes.pas Normal file
View File

@ -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.