SQL 和 Delphi：从表中创建树的递归机制
Posted
技术标签:
【中文标题】SQL 和 Delphi：从表中创建树的递归机制【英文标题】：SQL and Delphi: recursive mechanism for creating a tree from a table 【发布时间】：2013-03-31 23:22:36 【问题描述】：我正在使用的 DBMS 是 mysql，编程环境是 Delphi 7（这对于本示例并不重要）。
我有一个名为“主题”的表，我将所有书籍主题存储在系统中。科目可以有亲子关系，比如科学可以分为数学和物理，而数学可以细分为微积分、代数、几何等等。
我想要的是创建一个填充了该表中日期的树。请帮我这样做。甚至你使用什么语言来进行说明都无关紧要，它可以是伪代码。
Subject 表的数据库图如下所示：
主题表定义：
DROP TABLE IF EXISTS subject;
CREATE TABLE IF NOT EXISTS subject ( # Comment
subject_id INT UNSIGNED NOT NULL AUTO_INCREMENT, # Subject ID
subject VARCHAR(25) NOT NULL, # Subject name
parent_id INT UNSIGNED NULL DEFAULT NULL, # Parent ID as seen from
PRIMARY KEY (subject_id), # the diagram refers to
UNIQUE (subject), # the subject_id field
INDEX (parent_id),
CONSTRAINT fk_subject_parent
FOREIGN KEY (parent_id)
REFERENCES subject (subject_id)
ON DELETE RESTRICT
ON UPDATE CASCADE
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
用一些虚拟数据填充主题表：
INSERT INTO subject (subject, parent_id) VALUES
('Science', NULL),
('Mathematics', 1),
('Calculus', 2),
('Algebra', 2),
('Geometry', 2),
('Languages', NULL),
('English', 6),
('Latin', 6);
SELECT 语句返回这个：
SELECT * FROM subject;
╔════════════╦═════════════╦═══════════╗
║ subject_id ║ subject ║ parent_id ║
╠════════════╬═════════════╬═══════════╣
║ 1 ║ Science ║ NULL ║
║ 2 ║ Mathematics ║ 1 ║
║ 3 ║ Calculus ║ 2 ║
║ 4 ║ Algebra ║ 2 ║
║ 5 ║ Geometry ║ 2 ║
║ 6 ║ Languages ║ NULL ║
║ 7 ║ English ║ 6 ║
║ 8 ║ Latin ║ 6 ║
╚════════════╩═════════════╩═══════════╝
存储过程：
DELIMITER$$
DROP PROCEDURE IF EXISTS get_parent_subject_list;
CREATE PROCEDURE get_parent_subject_list ()
BEGIN
SELECT subject_id, subject
FROM subject
WHERE parent_id IS NULL
ORDER BY subject ASC;
END$$
DROP PROCEDURE IF EXISTS get_child_subject_list;
CREATE PROCEDURE get_child_subject_list (IN parentID INT)
BEGIN
SELECT subject_id, subject
FROM subject
WHERE parent_id = parentID
ORDER BY subject ASC;
END$$
DELIMITER ;
接下来是我的 Delphi 程序，它试图用数据填充树视图，但可以进一步看出，它不能比第二层更深：
procedure TForm1.CreateSubjectTreeView(Sender: TObject);
var
i : integer;
begin
i := 0;
q1.SQL.Clear;
q1.SQL.Add('CALL get_parent_subject_list()');
q1.Open;
q1.First;
while not q1.EOF do
begin
TreeView.Items.Add(nil, q1.Fields[1].Value);
q2.SQL.Clear;
q2.SQL.Add('CALL get_child_subject_list(' +
VarToStr(q1.Fields[0].Value) + ')');
q2.Open;
q2.First;
while not q2.EOF do
begin
TreeView.Items.AddChild(TreeView.Items.Item[i], q2.Fields[1].Value);
q2.Next;
end;
i := TreeView.Items.Count;
q1.Next;
end;
end;
这就是这段 sn-p 代码的作用：
+- Science
| |
| +- Mathematics
|
+- Languages
|
+- English
+- Latin
但我希望它看起来像这样：
+- Science
| |
| +- Mathematics
| |
| +- Calculus
| +- Algebra
| +- Geometry
|
+- Languages
|
+- English
+- Latin
【问题讨论】：
+1 表示格式正确的问题 mysql 解决方案我帮不了你，但你要找的是分层查询，可以在这里找到一个例子：explainextended.com/2009/03/17/hierarchical-queries-in-mysqlmysql 没有 connect by 子句，所以你必须手动完成。 【参考方案1】：我建议你不要一次加载整棵树，为什么要加载？目前没有人可以查看一千个项目。它可能很长，您的程序看起来会冻结。而且它会在网络和服务器上产生巨大的负载。
您最好使用VirtualTreeView 方法，其中每个项目都根据请求加载其子项目。这将需要一个参数化的准备查询，例如
Select ID, Title, This, That from TREE where Parent_ID = :ID
是的，不要为每个项目都创建新的 SQL 文本。它既危险又缓慢（您需要删除为旧请求收集的所有数据并解析新请求）
您应该进行一个参数化查询，Prepare 它，然后关闭/更改参数值/打开。
在http://bobby-tables.com/查看原因和Delphi示例
“一次全部加载”rush 的一个例子是 dynamically create popup menu tree from sql server table in Delphi - 虽然我不认为 rush 对于或多或少的大树来说是个好方法。
注意这种方法：您填充根元素，然后找到一种或另一种方法来填充尚未填充但已被其他人引用的元素直到终于没有这样的元素了。
当然，您可以递归地执行此操作，将树遍历到其末端 - 但这需要许多嵌套的数据库查询。
您可以发出递归 SQL 请求，但它可能非常依赖服务器，并且 RDBMS 引擎通常会限制递归深度。
一种方法可能在树控制上稍差一些，但在 RDBMS 上更简洁、更容易，那就是为刚刚添加的树项创建一个专用的TQueue。在你加载了一些元素之后——最初都是根元素——你在队列中记住了它。然后你从队列中一个接一个地删除并填充（加载和入队）它的孩子。直到队列变空。
【讨论】：
【参考方案2】：我喜欢使用哈希表来创建由 keyID 索引的所有节点的索引，并使用它来构建树。 它需要 2 次通过表。第一遍为每条记录创建一个根树节点 并针对树节点添加 keyID 的哈希条目。第二遍遍历表，在哈希中查找 parentId。如果找到它，则将当前节点移动到父节点下，否则忽略它。在第二遍结束时，您已经构建了完整的树。
var i,imax,ikey,iParent : integer;
aNode,aParentNode : TTreeNode;
aData : TMyData;
aContainer : TSparseObjectArray; // cDataStructs , delphi fundamentals
aNodeIndex : TSparseObjectArray; // delphi 7
begin
try
aContainer := TSparseObjectArray.Create(true);
aNodeIndex := TSparseObjectArray.Create(False);
imax := 10000;
// create test data;
for i := 1 to imax do
begin
aData := TMyData.Create;
aData.iKey := i;
aData.iParent := Random(imax); // random parent
aData.Data := 'I:' + IntToStr(aData.iKey);
aContainer.Item[i] := aData;
end;
tv1.Items.Clear;
tv1.Items.BeginUpdate;
// build tree
// First Pass - build root tree nodes and create cross ref. index
for i := 1 to imax do
begin
aData := TMYData(aContainer.Item[i]);
aNode := tv1.Items.AddChild(nil,aData.Data);
aNodeIndex.Item[aData.iKey] := aNode;
end;
// Second Pass - find parent node using index and move node
for i := 1 to imax do
begin
aData := TMYData(aContainer.Item[i]);
aNode := TTreeNode(aNodeIndex.Item[aData.iKey]);
if aNodeIndex.HasItem(aData.iparent)
then begin
aParentNode := TTreeNode(aNodeIndex.Item[aData.iparent]);
aNode.MoveTo(aParentNode,naAddChild);
end;
end;
tv1.Items.EndUpdate;
tv1.Select( tv1.Items.GetFirstNode);
finally
aContainer.Free;
aNodeIndex.free;
end;
end;
【讨论】：
Windows 内置树控件中的“移动”有多快？ 由于控件想要滚动到当前节点，一旦树节点超出窗口区域，MoveTo 就会很慢。我通常使用这种方法在自定义数据库中构建数据树。使用我构建的名为 getTreeBranch 的例程在较小的集合中公开实际的树视图，该例程已经构建了树结构，但只是遍历所有元素的当前分支。 我同意对于一些自定义的指针链接树数据结构，您的方法可能很容易成为最快的方法。但是 TS 想使用股票 TTreeView 并且您触摸它的次数越少，它的效果就越好；） 我使用我的方法和默认的 TTreeView 实现了一个包含 10000 个随机树元素的测试程序。在windows 7、Intel i5-2500 cpu下完成耗时8s或0.8ms/node。这还不错，但使用 VirtualTreeView 会快得多。有趣的是，将元素添加为根节点只需要 8 秒中的 0.5 秒，所以如果我可以先遍历内存树并将树节点添加到 TTreeView，理论上应该不到一秒。【参考方案3】：procedure TdfmMed.Button1Click(Sender: TObject);
var
NodePai : TTreeNode;
procedure MontaFilho(Node : TTreeNode; Cod : integer);
var
qry : TFDQuery;
node1 : TTreeNode;
begin
qry := TFDQuery.Create( nil );
qry.Connection := dm1.FDConnection1;
qry.close;
qry.SQL.Add('SELECT cod, nome_grupo FROM teste WHERE parent_cod = :cod ORDER BY nome_grupo ASC');
qry.ParamByName('cod').AsInteger := cod;
qry.Open();
qry.First;
while not qry.EOF do
begin
node1 := TreeView1.Items.AddChild(NODE, qry.Fields[1].Value);
MontaFilho(node1, qry.Fields[0].Value );
qry.Next;
end;
end;
begin
TreeView1.Items.Clear;
qryGrupoPai.close; qryGrupoPai.Open;
qryGrupoPai.First;
while not qryGrupoPai.EOF do
begin
NodePai := TreeView1.Items.Add(nil, qryGrupoPai.Fields[1].Value);
MontaFilho( NodePai, qryGrupoPai.Fields[0].Value);
qryGrupoPai.Next;
end;
end;【讨论】：
一些解释会很好地伴随代码转储并解释为什么它解决了 OP 的问题。【参考方案4】：我在 *** en español Consumir menu del sql server 上写了一个示例，可能对其他人有用。
它使用几个字段：
元素 ID 的 ID 父 ID 的 PID 要执行的命令的名称 树节点标题的CAPTION ISVISIBLE 以了解此元素是否对最终用户可见 (Y/N)。它适用于任何菜单级别，旨在通过使用 TDataSource 作为参数与任何数据库一起使用
type
tElementoMenu = Class(TObject)
Comando : String;
//Nombre : String;
ID : String;
End;
...
procedure TForm1.CrearMenuDeArbol(dsOrigen: TDataSource; CampoID, IDPadre,
CampoComando, CampoCaption, CampoVisible: String; Raiz : TTreeNode = Nil);
var
RamaActual, PrimeraRama : TTreeNode;
ElementoMenu : TElementoMenu;
iIndiceImagen : Integer;
begin
RamaActual := Nil;
PrimeraRama := Nil;
if not assigned(Raiz) then
VaciarArbol;
with dsOrigen.DataSet do
begin
//For this example I use filter, however it can be use with WHERE sentence
Filtered := False;
IF not assigned(Raiz) then
Filter := IdPadre + ' IS NULL '
else
Filter := IDPadre + ' = ' + TElementoMenu(Raiz.Data).ID;
Filtered := True;
First;
while not Eof do
begin
if FieldByName(CampoVisible).AsString = 'Y' then
begin
ElementoMenu := TElementoMenu.Create;
ElementoMenu.Comando := FieldByName(CampoComando).AsString;
ElementoMenu.ID := FieldByName(CampoID).AsString;
//ElementoMenu.Nombre := FieldByName(CampoName).AsString; //Otros datos para agregar al elemento del menu
iIndiceImagen := 0;
if Not Assigned(Raiz) then
RamaActual := TreeView1.Items.AddObject(Nil, FieldByName(CampoCaption).AsString, ElementoMenu )
else
Begin
RamaActual := TreeView1.Items.AddChildObject(Raiz, FieldByName(CampoCaption).AsString, ElementoMenu );
iIndiceImagen := 1;
End;
RamaActual.ImageIndex := iIndiceImagen;
RamaActual.SelectedIndex := iIndiceImagen;
end;
Next;
end;
if not Assigned(Raiz) then
PrimeraRama := TreeView1.Items.GetFirstNode
else
PrimeraRama := Raiz.getFirstChild;
while Assigned(PrimeraRama) do
begin
CrearMenuDeArbol(dsOrigen, CampoID, IDPadre, CampoComando, CampoCaption, CampoVisible, PrimeraRama);
PrimeraRama := PrimeraRama.getNextSibling;
end;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
VaciarArbol;
end;
procedure TForm1.TreeView1DblClick(Sender: TObject);
begin
if Assigned(treeView1.Selected) then
ShowMessage(TElementoMenu(treeView1.Selected.Data).Comando);
end;
procedure TForm1.VaciarArbol;
var
itm : TTreeNode;
begin
while TreeView1.Items.Count > 0 do
begin
itm := TreeView1.Items[TreeView1.Items.Count-1];
TElementoMenu(itm.Data).Free;
TreeView1.Items.Delete(itm);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
CrearMenuDeArbol(ds1, 'ID', 'PID', 'NAME', 'CAPTION', 'ISVISIBLE');
Treeview1.FullExpand;
end;
【讨论】：
【参考方案5】：我遇到了同样的问题，想用 SQL 来修复它，以避免对数据库服务器的调用过多（对于每个记录/递归步骤）。我们的嵌入式 RDBMS NexusDB 不允许像 oracle 或 MSSQL 这样的递归查询。所以这就是我想出的，内联解释。它允许在 1 遍中加载树，但仍使用提供的 rootid 作为起点加载整个树。
我的数据库表名为OBJDAT，具有唯一整数ID，父链接通过字段TechPar
调用例程应该如下所示，您必须为 RootID 提供一个参数值。 NULL 将从所有根中选择所有对象（具有 TachPar=NULL）
SELECT Obj.* FROM TABLE(RECURTABLE(:RootID)) AS Obj
结果将是一个首先使用根（也称为***）对象排序的表。 然后您可以遍历结果表并将对象添加到您的树控件（或内存结构中），如下所示：
//pseudodelphicode
ResultSet:=SQLQueryResult
ResultSet.First
while not ResultSet.EOF do
begin
NewNode:=TreeNode.Create;
NewNode.ID:=ResultSet.ID;
NewNode.Name:=ResultSet.Name
... load more relevant stuff
ParentID:=ResultSet.TechPar
if ParentID<>nil then
Tree.FIndNode(ParentID).AddChild(NewNode)
else Tree.AddRoot(NewNode)
ResultSet.Next;
end
实际完成工作的存储过程的实现是这样的：
-- NexusDB 变种的 SQL 存储过程从 -- 资产登记簿或图书馆。
DROP ROUTINE IF EXISTS RECURTABLE;
CREATE FUNCTION RECURTABLE(aRootID INTEGER)
RETURNS TABLE
MODIFIES SQL DATA
BEGIN
-- pre-clean temporary tables
CREATE LOCAL TEMPORARY TABLE #tmpsublayer
(
ID INTEGER,
Name VARCHAR(50),
UserID VARCHAR(50),
ObjType INTEGER,
TechPar INTEGER
);
CREATE LOCAL TEMPORARY TABLE #tmpobjparsublayer (LIKE #tmpsublayer);
CREATE LOCAL TEMPORARY TABLE #tmpResultTable (LIKE #tmpsublayer);
-- for debugging purpose, ignore
-- DROP TABLE IF EXISTS #tmpobjparsublayer;
-- DROP TABLE IF EXISTS #tmpsublayer;
-- DROP TABLE IF EXISTS #tmpResultTable;
DECLARE lRecursionCounter,lParentID INTEGER;
DECLARE lRootPath TEXT;
START TRANSACTION;
TRY
IF (aRootID=0) OR (aRootID IS NULL) THEN
-- No root provided: select all root records into the intermediate sublayer result set
INSERT INTO #tmpsublayer
SELECT
ID,
Name,
UserID,
ObjType,
TechPar
FROM OBJDAT
WHERE (TechPar IS NULL) OR (TechPar=0); -- Match on TechPar in (Null,0)
ELSE
-- a root record was provided, select the root record into the result list
SET lRootPath=NULL;
SET lParentID=aRootID;
SET lRecursionCounter=0;
-- this loop resolves the path from the selected root object to the ultimate root object
REPEAT
SET lRecursionCounter=lRecursionCounter+1;
-- avoid infinite loop by cyclical links here by usning a recursion counter watchdog
IF lRecursionCounter>100 THEN
SIGNAL 'Resolve root path for ('+ToStringLen(aRootID,10)+'): Maximum hierarchical depth reached.';
END IF;
SET lParentID=(SELECT TechPar FROM $AMOBJTABLENAME WHERE ID=lParentID);
IF NullIf(lParentID,0) IS NULL THEN
LEAVE;
ELSE
SET lRootPath=TOSTRINGLEN(lParentID,10)+COALESCE(';'+lRootPath,'');
END IF;
UNTIL FALSE
END REPEAT;
-- actually select the single root object into the intermediate sublayer result set
INSERT INTO #tmpsublayer
SELECT
ID,
Name,
UserID,
ObjType,
TechPar
FROM OBJDAT
WHERE ID=aRootID; // match on ID
END IF;
-- copy our rootlayer of results into out final output result set
INSERT INTO #tmpResultTable
SELECT
*
FROM #tmpsublayer;
SET lRecursionCounter=0;
-- this loop adds layers of sub objects to the result table
REPEAT
SET lRecursionCounter=lRecursionCounter+1;
IF (SELECT TOP 1 ID FROM #tmpsublayer) IS NULL THEN
LEAVE; -- empty result set, we are done get out of the loop
END IF;
-- watchdog for loop count to avoid infinite loops caused by cyclical links
IF lRecursionCounter>100 THEN
SIGNAL 'RecurSelect('+ToStringLen(aRootID,10)+'): Max hierarchical depth reached.';
END IF;
-- get a sublayer from the main table based on the current parent layer and technical parent field
-- Not required DROP TABLE IF EXISTS #tmpobjparsublayer;
DELETE FROM #tmpobjparsublayer;
INSERT INTO #tmpobjparsublayer
SELECT
D.ID ID,
D.Name Name,
D.UserID UserID,
D.ObjType TypeID,
D.TechPar TechPar
FROM #tmpsublayer P
JOIN OBJDAT ON P.ID=D.TechPar;
-- insert our sublayer of regular linked objects into the result table
INSERT INTO #tmpResultTable
SELECT
*
FROM #tmpobjparsublayer;
-- clear current sublayer
DELETE FROM #tmpsublayer;
-- Move the newly selected objects layer to the sublayer set for the next iteration
INSERT INTO #tmpsublayer
SELECT
*
FROM #tmpobjparsublayer;
UNTIL FALSE -- trust the LEAVE and SIGNAL statements
END REPEAT;
-- clean up temporary tables
DELETE FROM #tmpobjparsublayer;
DELETE FROM #tmpsublayer;
COMMIT;
CATCH TRUE
-- cleanup if something went wrong
ROLLBACK;
SIGNAL ERROR_MESSAGE;
END;
DROP TABLE IF EXISTS #tmpobjparsublayer;
DROP TABLE IF EXISTS #tmpsublayer;
-- return result
RETURN SELECT * FROM #tmpResultTable;
END;
【讨论】：
我实际上想将代码部分设置为语法突出显示为 SQL，检查如何执行此操作...以上是关于SQL 和 Delphi：从表中创建树的递归机制的主要内容，如果未能解决你的问题，请参考以下文章