Added: initial (non-working) X2UtHashes implementation
Changed: restructuring of X2UtBinaryTree to abstract data management
This commit is contained in:
parent
02fc3996a7
commit
40d0401c95
37
Test/X2UtHashesTest.cfg
Normal file
37
Test/X2UtHashesTest.cfg
Normal 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
199
Test/X2UtHashesTest.dof
Normal 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
75
Test/X2UtHashesTest.dpr
Normal 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
61
Test/X2UtHashesTest.mes
Normal 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
|
||||
@ -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;
|
||||
|
||||
property NodeSize: Cardinal read FNodeSize;
|
||||
property TotalSize: Cardinal read GetTotalSize;
|
||||
|
||||
//:$ Gets or sets an item.
|
||||
property Items[Index: Cardinal]: Pointer read GetItem
|
||||
write SetItem; default;
|
||||
// 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;
|
||||
procedure TX2UtStringBTree.FreeNode;
|
||||
var
|
||||
pData: PString;
|
||||
|
||||
begin
|
||||
Dispose(PString(ANode^.Value));
|
||||
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.
|
||||
|
||||
336
X2UtHashes.pas
Normal file
336
X2UtHashes.pas
Normal 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.
|
||||
Loading…
Reference in New Issue
Block a user