mysql - SQL 和 Delphi：从表中创建树的递归机制

Question

我正在使用的 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;

这就是这段代码的作用：

+- Science
|   |
|   +- Mathematics
|
+- Languages
    |
    +- English
    +- Latin

但我希望它看起来像这样：

+- Science
|   |
|   +- Mathematics
|       |
|       +- Calculus
|       +- Algebra
|       +- Geometry
|
+- Languages
    |
    +- English
    +- Latin

Answer 1

我建议您不要一次加载整棵树，为什么要加载？目前没有人可以查看一千个项目。它可能很长，您的程序看起来会冻结。它在网络和服务器上产生了巨大的负载。

您最好使用VirtualTreeView方法，其中每个项目根据请求加载其子项目。这将需要一个参数化的准备查询，例如

 Select ID, Title, This, That from TREE where Parent_ID = :ID

• http://code.google.com/p/virtual-treeview/
• http://www.lischke-online.de/index.php/controls/virtual-treeview-gallery
• 树状数据结构（用于 VirtualTreeview）
• VirtualStringTree 正确/推荐使用

---

是的，不要为每个项目都创建新的 SQL 文本。它既危险又缓慢（您需要删除为旧请求收集的所有数据并解析新请求）

您应该进行一个参数化查询，Prepare然后关闭/更改参数值/打开。

请参阅http://bobby-tables.com/上的原因和 Delphi 示例

---

“一次全部加载” rush 的一个示例是从 Delphi 中的 sql server 表动态创建弹出菜单树- 尽管我不认为 rush 对于或多或少的大树来说是一个好方法。

请注意这种方法：您填充根元素，然后找到一种或另一种填充元素的方法，尚未填充，但已被其他人引用，直到最后没有这样的元素。

当然，您可以递归地执行此操作，将树遍历到其末端-但这会要求许多嵌套的数据库查询。

您可以发出递归 SQL 请求，但它可能非常依赖于服务器，并且 RDBMS 引擎通常会限制递归深度。

一种方法可能在树控制上稍差，但在 RDBMS 上更干净、更容易，就是专门TQueue使用刚刚添加的树项。在加载了一些元素之后——最初是所有根元素——你在队列中记住了它。然后你从队列中一个接一个地删除并填充（加载和入队）它的孩子。直到队列变空。

Answer 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;

Answer 3

我遇到了同样的问题，并想使用 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 存储过程变体，用于从 -- Asset Register 或库中返回数据。

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;

Answer 4

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;

Answer 5

我在 stackoverflow en español Consumir menu del sql server上写了一个示例，可能对其他人有用。

它使用几个字段：

• 元素 ID 的 ID
• 父 ID 的 PID
• 要执行的命令的名称
• TreeNode 标题的 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;