SQL и Delphi: рекурсивный механизм для создания дерева из таблицы

Ответ 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 и просто закрыть/изменить значения параметра/открыть.

См. причины и образец Delphi в http://bobby-tables.com/

Один пример "загрузить все сразу сразу" - это время, когда он динамически создает всплывающее меню из таблицы sql-сервера в Delphi - хотя я не думаю, что пик является хорошим подходом для более или менее больших деревьев.

Обратите внимание на этот подход: вы заполняете корневые элементы, затем обнаруживаете, что так или иначе вы заполняете элементы, которые еще не заполнены, но уже упоминаются другими, пока нет таких элементов.

Вы можете сделать это рекурсивно, конечно, пройдя дерево до его конца - но это потребует много вложенных запросов к базе данных.

Вы можете сделать рекурсивный запрос SQL, но он, вероятно, будет очень зависящим от сервера, а механизмы RDBMS обычно налагают свои ограничения на глубину рекурсии.

Подход, возможно, немного худший в управлении деревьями, но более чистое и простое в RDBMS должно было бы сделать выделенный TQueue только что добавленный элемент дерева. После того, как вы загрузите какой-то элемент - изначально все корневые - вы запомните его в очереди. Затем вы удаляете один за другим из очереди и заполняете (загружать и ставить в очередь) его дочерние элементы. Пока очередь не станет пустой.

Ответ 2

Мне нравится использовать хэш-таблицу для создания индекса всех узлов, индексированных с помощью ключевого слова, и использовать это для построения дерева. Он требует 2 прохода таблицы. Первый проход создает дерево корней node для каждой записи и добавляет хэш-запись ключаID против дерева node. второй проход проходит по таблице, просматривая parentId в хеше. Если он найдет его, то он перемещает текущий node под родительский node, иначе игнорирует его. В конце второго прохода у вас есть полное дерево.

    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;

Ответ 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;

Ответ 4

Я написал пример на stackoverflow en español Consumir menu del sql server, может быть полезным для кого-то еще.

Используется несколько полей:

• ID для идентификатора элемента
• PID для идентификатора родителя
• НАИМЕНОВАНИЕ для выполнения команды
• CAPTION для заголовка TreeNode
• НЕВОЗМОЖНО знать, будет ли этот элемент видимым для конечного пользователя (Д/Н).

Он работает для любых уровней меню и предназначен для использования с любой базой данных с использованием 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, чтобы избежать слишком большого количества обращений к серверу БД (для каждого шага записи/рекурсии). Наша встроенная СУБД NexusDB не допускает рекурсивные запросы, такие как oracle или MSSQL. Итак, вот что я придумал, объяснение в строке. Это позволяет загрузить дерево за 1 проход, но все же загружает все дерево, используя предоставленный корневой элемент в качестве отправной точки. Моя таблица БД называется 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;