SQL和Delphi：用於從表創建樹的遞歸機制

Question

我正在使用的DBMS是MySQL，編程環境是Delphi 7（這個例子並不重要）。

我有一個名為'subject'的表格，我將所有書籍主題存儲在系統中。 受試者可以有親子關系，比如科學可以分為數學和物理，而數學可以細分為微積分，代數，幾何和我們去。

我想要的是創建一個填充了該表中日期的樹。 拜托，幫幫我吧。 它甚至與您用於說明目的的語言無關，它只是偽代碼。

Subject表的數據庫圖如下所示：

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;

使用一些虛擬數據填充Subject表：

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示例

---

“一次加載所有”的一個例子就是從Delphi中的sql server表動態創建彈出菜單樹 - 雖然我不認為對於或多或少的大樹來說是匆忙的好方法。

關於這種方法的注意事項：你填寫根元素，然后你找到一種方式來填充元素，但尚未填充，但已被其他人引用，直到最后沒有這樣的元素。

當然，你可以遞歸地執行它，遍歷樹到它的結尾 - 但這會要求許多嵌套的數據庫查詢。

您可以創建遞歸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

 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 4

我在stackoverflow和españolConsumir菜單del sql server上寫了一個例子，可能對其他人有用。

它使用幾個字段：

• 元素ID的ID
• 父ID的PID
• 要執行的命令的名稱
• TreeNode標題的CAPTION
• 不明白這個元素是否對最終用戶可見（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;

Answer 5

我遇到了同樣的問題，並希望使用SQL來修復它，以避免對DB服務器的過多調用（對於每個記錄/遞歸步驟）。 我們的嵌入式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

實際執行工作的存儲過程的實現是這樣的：

- 用於從 - Asset Register或庫返回數據的SQL存儲過程的NexusDB變體。

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;