Таблица Persons (Персоналии)

Архангельский Андрей

       Как бы не возражал Д.Кузьменко, но у каждого человека есть отец и мать, т.е. два родителя. Создавать для этого две таблицы не имеет смысла, так как это только усложняет структуру БД и увеличивает риск возникновения блокирующих связей. Но самое интересное, что требуется еще одно дерево — псевдоним. У многих людей есть псевдонимы — писатели, артисты, разведчики. Кроме того, женщины меняют фамилию при выходе замуж. В Литве у женщины, например, окончание фамилии зависит от ее семейного положения.

Построение таблицы Persons

       В качестве примера рассмотрим таблицу Persons, описывающую людей.

Create table Persons (
       PersonID    Integer not null primary key,
       Father      Integer default 0,  FatherCnt  Integer default 0,
       Mother      Integer default 0,  MotherCnt  Integer default 0,
       PAlias      Integer default 0,  PAliasCnt  Integer default 0,
       SurName     Char(100),
       FirstName   Char(100),
       LastName    Char(100),
       Birthday    Date,
       Atribut3    Char(50));
Commit;
Alter table add foreign key (Father) references Persons on update cascade;
Alter table add foreign key (Mother) references Persons on update cascade;
Alter table add foreign key (Palias) references Persons on update cascade;
Commit;

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

Create trigger Insert_Persons for Persons
active before insert position 0
as
Begin
   Update Persons p set p.FatherCnt=p.FatherCnt+1 where p.PersonID=new.Father;
   Update Persons p set p.MotherCnt=p.MotherCnt+1 where p.PersonID=new.Mother;
   Update Persons p set p.PAliasCnt=p.PAliasCnt+1 where p.PersonID=new.PAlias;
end

       Триггер по изменению проверяет, не меняется ли родитель элемента. Если да, то значит элемент перемещается от одного родителя к другому и нужно соответственно уменьшить счетчик у старого и увеличить у нового родителя. Действия относительно отца или матери обрабатываются отдельно.

Create trigger Update_Persons for Persons
active before update position 0
as
Begin
  if (old.Father<>new.Father) then
     begin
       Update Persons p set p.FatherCnt=p.FatherCnt-1
                        where p.PersonID=old.Father;
       Update Persons p set p.FatherCnt=p.FatherCnt+1
                        where p.PersonID=new.Father;
     end
  if (old.Mother<>new.Mother) then
     begin
       Update Persons p set p.MotherCnt=p.MotherCnt-1
                        where p.PersonID=old.Mother;
       Update Persons p set p.MotherCnt=p.MotherCnt+1
                        where p.PersonID=new.Mother;
     end
  if (old.PAlias<>new.PAlias) then
     begin
       Update Persons p set p.PAliasCnt=p.PAliasCnt-1
                        where p.PersonID=old.PAlias;
       Update Persons p set p.PAliasCnt=p.PAliasCnt+1
                        where p.PersonID=new.PAlias;
     end
end

       При удалении нужно уменьшить количество "детей" у соответствующего родителя

Create trigger Delete_Persons for Persons
active before delete position 0
as
Begin
   Update Persons p set p.FatherCnt=p.FatherCnt-1 where p.PersonID=old.Father;
   Update Persons p set p.MotherCnt=p.MotherCnt-1 where p.PersonID=old.Mother;
   Update Persons p set p.PAliasCnt=p.PAliasCnt-1 where p.PersonID=old.PAlias;
end

       Но в отличие от других деревьев “Псевдоним” требует особого к себе отношения. Дело в том, что как бы человек не менял фамилию, но его день рождения остается одним и тем же. И если дата рождения введена неправильно или не полностью, то при изменении этого поля требуется изменить его также во всех связанных записях — в основной записи и других псевдонимах. В этом случае триггер на измененение таблицы будет выглядеть следующим образом:

Create trigger Update_Persons for Persons
active before update position 0
as
Begin
  if (old.Father<>new.Father) then
     begin
       Update Persons p set p.FatherCnt=p.FatherCnt-1
                        where p.PersonID=old.Father;
       Update Persons p set p.FatherCnt=p.FatherCnt+1
                        where p.PersonID=new.Father;
     end
  if (old.Mother<>new.Mother) then
     begin
       Update Persons p set p.MotherCnt=p.MotherCnt-1
                        where p.PersonID=old.Mother;
       Update Persons p set p.MotherCnt=p.MotherCnt+1
                        where p.PersonID=new.Mother;
     end
  if (old.PAlias<>new.PAlias) then
     begin
       Update Persons p set p.PAliasCnt=p.PAliasCnt-1
                        where p.PersonID=old.PAlias;
       Update Persons p set p.PAliasCnt=p.PAliasCnt+1
                        where p.PersonID=new.PAlias;
     End
  If (old.BirthDay<> new.BirthDay) then -- изменение д.р. у Alias
     Begin
     If ((new.PAlias=0) and (new.PAliasCnt>0)) then
        Begin
          Update Persons p set p.BirtDay=new.BirthDay
                           where p.PAlias=new.PersonID;
        end
     If (new.PAlias<>0) then
        Begin
          Update Persons p set p.BirtDay=new.BirthDay
          where p.PAlias=new.PAlias or p.PersonID=new.PAlias;
        end
     end
end

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

 

Отображение таблицы Persons

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


Рис.2-1 Отображение таблицы People по отцовской линии

 


Рис.2-2 Отображение таблицы People по материнской линии

 


Рис.2-3 Отображение таблицы People по дереву псевдонимов

       Для отображения этой таблицы используется пример {Example04}. Так как в таблице несколько деревьев, то необходимо использовать какой-либо переключатель деревьев (в данном случае Radio-Button) и несколько измененную процедуру построения дерева:

procedure TForm1.PersonsDatasetOpen();  {Example04}
Var
   RowChild   : Integer;
   sFld       : String;
   ChildNode,NewNode : TTreeNode;
begin
  inherited;
  If qrTVPersons.Database.Connected then
     begin
        tvPersons.Items.Clear;
        tvPersons.Items.BeginUpdate;
        trTVPersons.Active := True;
01      qrTVPersons.Close;   qrTVPersons.SQL.Clear;
02      qrTVPersons.SQL.Add('Select * from Persons');
03      If rbFather.Checked 
           then qrTVPersons.SQL.Add(' where Father=0 and PersnSex=1');
04      If rbMother.Checked
           then qrTVPersons.SQL.Add(' where Mother=0 and PersnSex=2');
05      If rbPAlias.Checked
           then qrTVPersons.SQL.Add(' where PAlias=0 and PAliasCnt<>0');
06      qrTVPersons.SQL.Add(' and PersonID<>0');
07      qrTVPersons.Open;     qrTVPersons.First;
        While not qrTVPersons.EOF do
          begin
08           sFld := '';  RowChild := 0;
09           If not VarIsNull(qrTVPersons.FieldValues['SurName'])
                then sFld := qrTVPersons.FieldValues['SurName'];
10           If not VarIsNull(qrTVPersons.FieldValues['FirstName'])
                then sFld := sFld+' '+qrTVPersons.FieldValues['FirstName'];
11           If not VarIsNull(qrTVPersons.FieldValues['LastName'])
                then sFld := sFld+' '+qrTVPersons.FieldValues['LastName'];
12           NewNode := tvPersons.Items.Add(tvPersons.TopItem,sFld);
13           NewNode.ImageIndex := qrTVPersons.FieldValues['PersonID'];
14           If rbFather.Checked 
                then RowChild := qrTVPersons.FieldValues['FatherCnt'];
15           If rbMother.Checked 
                then RowChild := qrTVPersons.FieldValues['MotherCnt'];
16           If rbPAlias.Checked
                then RowChild := qrTVPersons.FieldValues['PAliasCnt'];
17           If RowChild>0 then 
             ChildNode := tvPersons.Items.AddChild(NewNode,IntToStr(RowChild));
18           qrTVPersons.Next;
          end; // While not qrTVPersons.EOF do
          tvPersons.Items.EndUpdate;
          tvPersons.Update;
          qrTVPersons.Close;      trTVPersons.Active := False;
    end; // qrTVPersons.Database.Connected
end;

       Отличие процедуры PersonsDatasetOpen от предыдущих заключается прежде всего в построении основного запроса, который выбирает родителей самого верхнего уровня. В зависимости от выбранной кнопки (строки 03-05) в условии указывается соответствующее дерево и дополнительный параметр PersnSex.
       Как и в других вариантах строка, которая выводится в качестве узла на дереве, собирается из значений нескольких полей, в данном случае — Фамилия, Имя, Отчество (строки 08-11). И уже из собранной строки создается новый узел (строка 12). Строка 13 запоминает PersonID для данного узла.
       И, наконец, строки 14-16 определяют есть ли у узла дети, в зависимости от выбранной кнопки.

procedure TForm1.tvPersonsExpanding(Sender: TObject; Node: TTreeNode;
                                    var AllowExpansion: Boolean); {Example04}
Var
   RowChild : Integer;
   sFld,PID : String;
   ChildNode,NewNode : TTreeNode;
begin
  inherited;
     If Node.HasChildren then begin
01      Node.DeleteChildren;
02      PID := IntToStr(Node.ImageIndex);
03      trTVPersons.Active := True;
04      qrTVPersons.Close;  qrTVPersons.SQL.Clear;
05      qrTVPersons.SQL.Add('Select * from Persons');
06      If rbFather.Checked then qrTVPersons.SQL.Add(' where Father='+PID);
07      If rbMother.Checked then qrTVPersons.SQL.Add(' where Mother='+PID));
08      If rbPAlias.Checked then qrTVPersons.SQL.Add(' where PAlias='+PID);
09      qrTVPersons.SQL.Add(' order by PBrDate');
10      qrTVPersons.Open;  qrTVPersons.First;
11      tvPersons.Items.BeginUpdate;
12      While not qrTVPersons.EOF do Begin
13         sFld := '';  RowChild := 0;
14         If not VarIsNull(qrTVPersons.FieldValues['SurName'])
              then sFld := qrTVPersons.FieldValues['SurName'];
15         If not VarIsNull(qrTVPersons.FieldValues['FirstName'])
              then sFld := sFld+' '+qrTVPersons.FieldValues['FirstName'];
16         If not VarIsNull(qrTVPersons.FieldValues['LastName'])
              then sFld := sFld+' '+qrTVPersons.FieldValues['LastName'];
17         NewNode := tvPersons.Items.AddChild(Node,sFld);
18         NewNode.ImageIndex := qrTVPersons.FieldValues['PersonID'];
19         If rbFather.Checked then
              RowChild := qrTVPersons.FieldValues['FatherCnt'];
20         If rbMother.Checked then
              RowChild := qrTVPersons.FieldValues['MotherCnt'];
21         If rbPAlias.Checked then
              RowChild := qrTVPersons.FieldValues['PAliasCnt'];
22         If RowChild>0 then 
              ChildNode:=tvPersons.Items.AddChild(NewNode,IntToStr(RowChild));
23         qrTVPersons.Next;
24      end; // While not qrTVPersons.EOF do
           tvPersons.Items.EndUpdate;
           trTVPersons.Active := False;
     end;// Node.HasChildren
     tvPersons.Update;
end;

       Таким же образом при раскрытии узла анализируется какая кнопка нажата и в соответствии с этим строится условие в запросе, который ищет детей, указанного узла соответствующего дерева (строки 06-08).
       И в строках 19-21 определяется по какому дереву определять наличие детей у текущего узла.
       Для редактирования узла на форме применяется точно такая же процедура, как и в примере {Example01}.

Хранимые процедуры таблицы Persons

       Для поиска всех потомков соответствующего родителя можно использовать ту же процедуру, что и случае одного родителя и, либо для каждого родителя использовать свой вариант, либо добавить входную переменную, указывающую номер дерева (TrNo):

SET TERM !! ;
create procedure PersonsGetChild (Prnt Integer, bLev SmallInt, TrNo SmallInt)
                  returns (Chld Integer, rLev SmallInt) as
begin
If (TrNo=1) then
  begin
  for select PersonID from Persons where PersonID<>0 and Father=:Prnt
                      into :Chld
      do begin
         rLev = bLev + 1;
         suspend;
         for select Chld,rLev from PersonsGetChild(:Chld,:rLev,:TrNo)
                              into :Chld,:rLev
             do begin
                suspend;
             end
      end
   end
If (TrNo=2) then
  begin
  for select PersonID from Persons where PersonID<>0 and Mother=:Prnt
                      into :Chld
      do begin
         rLev = bLev + 1;
         suspend;
         for select Chld,rLev from PersonsGetChild(:Chld,:rLev,:TrNo)
                              into :Chld,:rLev
             do begin
                suspend;
             end
      end
   end
If (TrNo=3) then
  begin
  for select PersonID from Persons where PersonID<>0 and PAlias=:Prnt
                      into :Chld
      do begin
         rLev = bLev + 1;
         suspend;
         for select Chld,rLev from PersonsGetChild(:Chld,:rLev,:TrNo)
                              into :Chld,:rLev
             do begin
                suspend;
             end
      end
   end
end!!
SET TERM ; !!

       Процедура PersonsGetChild выдающая вместе с узлом его родителя строится подобным образом и может быть найдена в файле описания БД (FB_SQL/DBCreate.doc).
       Точно также можно сделать и для поиска родителей:

SET TERM !! ;
create procedure PersonsGetParent (Chld Integer, bLev SmallInt, TrNo SmallInt)
                   returns (Prnt Integer, rLev SmallInt) as
begin
If (TrNo=1) then
   begin
   for select Father from Persons where PersonID=:Chld into :Prnt
     do begin
        If (Prnt<>0) then begin
           rLev = bLev - 1;
           suspend;
           for select Prnt,rLev from PersonsGetParent(:Prnt,:rLev,:TrNo)
                                into :Prnt,:rLev
             do begin
                suspend;
                end
           end
        end
   end
If (TrNo=2) then
   begin
   for select Mother from Persons where PersonID=:Chld into :Prnt
     do begin
        If (Prnt<>0) then begin
           rLev = bLev - 1;
           suspend;
           for select Prnt,rLev from PersonsGetParent(:Prnt,:rLev,:TrNo)
                                into :Prnt,:rLev
             do begin
                suspend;
                end
           end
        end
   end
If (TrNo=3) then
   begin
   for select PAlias from Persons where PersonID=:Chld into :Prnt
     do begin
        If (Prnt<>0) then begin
           rLev = bLev - 1;
           suspend;
           for select Prnt,rLev from PersonsGetParent(:Prnt,:rLev,:TrNo)
                                into :Prnt,:rLev
             do begin
                suspend;
                end
           end
        end
   end
end!!
SET TERM ; !!

Заполнение таблицы Persons из SQL-скрипта

       Если заполнение таблицы с одним деревом выполнялось достаточно просто, то для заполнения таблицы с несколькими деревьями есть некоторые трудности.
       Во-первых, нельзя получить одновременно три ID из той же таблицы, куда вставляется запись.
       Во-вторых, возникают проблемы связанные с характером данных. В данном случае всегда может возникнуть ситуация, когда при вставке записи о человеке отсутствует запись об одном из его родителей или псевдониме.
       Поэтому вставка записей должна происходит в два этапа. Сначала вставляются все имеющиеся записи о людях без информации о родителях. Затем изменяется информация о связях между записями.
       Начало первой части скрипта для этой таблицы приведено ниже:

Insert into Persons(SurName,FirstName,LastName,BirthDate,Atribut3,PersnSex)
 values('Кеннеди','Патрик',' ','1/1/1823','Родоначальник клана Кенеди',1);
Insert into Persons(SurName,FirstName,LastName,BirthDate,Atribut3,PersnSex)
 values('Мэрфи','Бриджит',' ','1/1/1821','Родоначальница клана Кенеди',2);
Insert into Persons(SurName,FirstName,LastName,BirthDate,Atribut3,PersnSex)
 values('Кеннеди','Патрик','Джозеф','1/14/1858','Дед JFK',1);
Insert into Persons(SurName,FirstName,LastName,BirthDate,Atribut3,PersnSex)
 values('Хики','Мэри','Аугуста','12/6/1857','Бабушка JFK',2);

       Т.е. это обычный скрипт линейной вставки значений в таблицу.
       Обычным образом модифицировать данные в таблице используя результат запроса невозможно. Но можно использовать вспомогательную таблицу, в которой сформировать связи между записями, а затем с помощью хранимой процедуры модифицировать связи в целевой таблице, используя уже найденные ID. Для этого сначала построим вспомогательную таблицу:

Create table PersonsTemp (
   PersonID  AZInt32 not null references Persons on update cascade
                                                 on delete cascade,
   PFather   AZInt32 default 0 not null references Persons on update cascade
                                                           on delete cascade,
   PMother   AZInt32 default 0 not null references Persons on update cascade
                                                           on delete cascade,
   PAlias    AZInt32 default 0 not null references Persons on update cascade
                                                           on delete cascade,
Primary key (PersonID,PFather,PMother,PAlias));

       И для записи в это таблицу можно использовать следующий запрос:

Insert into PersonsTemp(PersonID,PFather,PMother)
  Select p1.PersonID,p2.PersonID,p3.PersonID
  from Persons p1, Persons p2, Persons p3
  where (p1.SurName='Кеннеди' and p1.FirstName='Джон'
         and p1.LastName='Фицджералд' and p1.BirthDate='5/29/1917')
    and (p2.SurName='Кеннеди' and p2.FirstName='Джозеф'
         and p2.LastName='Патрик' and p2.BirthDate='9/06/1888')
    and (p3.SurName='Фицджералд' and p3.FirstName='Роз'
         and p3.LastName='Элизабет' and p3.BirthDate='07/22/1890');

       С одной стороны этот запрос сразу собирает все ID как самого человека, так и его отца и матери. Но если по каким-то причинам одна из записей в условии отсутствует, то весь запрос возвратит пустой результат, и запись в таблицу PersonsTemp не будет вставлена. Поэтому этот запрос желательно разделить на два или три и кажду связь оформлять отдельно:

Insert into PersonsTemp(PersonID,PFather,PMother)
  Select p1.PersonID,p2.PersonID,p3.PersonID
  from Persons p1, Persons p2
  where (p1.SurName='Кеннеди' and p1.FirstName='Джон'
         and p1.LastName='Фицджералд' and p1.BirthDate='5/29/1917')
    and (p2.SurName='Кеннеди' and p2.FirstName='Джозеф'
         and p2.LastName='Патрик' and p2.BirthDate='9/06/1888');
Insert into PersonsTemp(PersonID,PFather,PMother)
  Select p1.PersonID,p2.PersonID,p3.PersonID
  from Persons p1, Persons p3
  where (p1.SurName='Кеннеди' and p1.FirstName='Джон'
         and p1.LastName='Фицджералд' and p1.BirthDate='5/29/1917')
    and (p3.SurName='Фицджералд' and p3.FirstName='Роз'
         and p3.LastName='Элизабет' and p3.BirthDate='07/22/1890');

       После того как вспомогательная таблица заполнена, можно приступать к обновлению связей. Точно также желательно каждую связь устанавливать отдельно во избежании ошибок. Хранимая процедура для этого приведена ниже:

SET TERM !! ;
create procedure PersonsSetParent
as
DECLARE VARIABLE PID  Integer;
DECLARE VARIABLE Fath Integer;
DECLARE VARIABLE Moth Integer;
DECLARE VARIABLE Alis Integer;
begin
   for select PersonID,PFather from PersonsTemp where PFather<>0
                               into :PID,:Fath
     do begin
        Update Persons Set Father=:Fath Where PersonID=:PID;
        end
   for select PersonID,PMother from PersonsTemp where PMother<>0
                               into :PID,:Moth
     do begin 
        Update Persons Set Mother=:Moth Where PersonID=:PID;
        end
   for select PersonID,PAlias from PersonsTemp where PAlias<>0
                              into :PID,:Alis
     do begin
        Update Persons Set PAlias=:Alis Where PersonID=:PID;
        end
end!!
SET TERM ; !!

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

Insert into PersonsTemp(PersonID,PAlias)
  Select p1.PersonID,p2.PersonID
  from Persons p1, Persons p2
  where (p1.SurName='Амалия&Амалия' and p1.FirstName=''
         and p1.LastName='' and p1.BirthDate='11/20/1973')
    and (p2.SurName='Мордвинова' and p2.FirstName='Амалия'
         and p2.LastName='Руслановна' and p2.BirthDate='11/20/1973');
Commit;

Execute procedure PersonsSetParent;
Commit;

       Полностью скрипт заполнения таблицы Persons приведен в файле FB_SQL/dat/Persons.txt.

 

Сохранение таблицы Persons в SQL-скрипте

       Сохранение содержимого таблицы Persons может быть и простым и сложным, в зависимости от того, что нужно сохранить.

Вариант 1.
       Если нужно сохранить только одну ветку одного дерева. Это достаточно просто и похоже на сохранение таблицы People. В примере {Example04} эта функция заведена на кнопку btnSaveChildToSQL. Таким же образом во вспомогательной таблице создается набор всех детей, начиная с текущего узла, но при этом выбираются дети только одного дерева, которое указано с помощью RadioButton. Отсортировав детей по уровням, выводится простой скрипт, последовательно заполняющий выбранную ветку дерева.

procedure TForm1.btnSaveChildToSQLClick(Sender: TObject);
Var
  rpPathName : String;
  flReprt : TextFile;
  Str1,Str2,Str3,sFld : String;
  SvCursor : TCursor;
begin
   rpPathName := ExtractFilePath(Application.ExeName);
   SvCursor := Screen.Cursor;
   Screen.Cursor := crHourGlass;
// Создание файла и каталога, если необходимо
   If not DirectoryExists(rpPathName+'\DtSave') then
      If not CreateDir(rpPathName+'\DtSave') then
         raise Exception.Create('Cannot create '+rpPathName+'\DtSave');
   AssignFile(flReprt,rpPathName+'\DtSave\PersonsChild.txt');
   ReWrite(flReprt);
   WriteLn(flReprt,'/* Заполнение таблицы Persons*/');
// Очистка вспомогательной таблицы PersonsLev
   qrExeProc.Close;      qrExeProc.SQL.Clear;
   qrExeProc.SQL.Add('Delete from PersonsLev');
   qrExeProc.ExecSQL;    qrExeProc.Close;
// Выборка ID всех детей от указанного узла
   Str1 := IntToStr(tvPersons.Selected.ImageIndex);
   If tvPersons.Selected.Level>1
      then Str2 := IntToStr(tvPersons.Selected.Parent.ImageIndex)
      else Str2 := '0';

       Получение правильного родительского узла. Если уровень узла больше 1, то у узла есть родитель, в противном случае ID родителя равно 0.

   qrExeProc.Close;      qrExeProc.SQL.Clear;
   qrExeProc.SQL.Add('Insert into PersonsLev(PersonID,PIDParnt,PTreeNo, PIDLevel)');
   qrExeProc.SQL.Add(' values('+Str1+','+Str2+',0,0)');
   qrExeProc.ExecSQL;

       Сначала в вспомогательную таблицу PersonsLev вставляется ID самого узла, так как процедура PersonsGetChild возвращает только детей узла.

   qrExeProc.Close;      qrExeProc.SQL.Clear;
   qrExeProc.SQL.Add('Insert into PersonsLev(PersonID,PIDParnt,PTreeNo, PIDLevel)');
   If rbFather.Checked then qrExeProc.SQL.Add(' select Chld,rPnt,1,rLev'
                            +' from PersonsGetChild2('+Str1+',0,1)');
   If rbMother.Checked then qrExeProc.SQL.Add(' select Chld,rPnt,2,rLev'
                            +' from PersonsGetChild2('+Str1+',0,2)');
   If rbPAlias.Checked then qrExeProc.SQL.Add(' select Chld,rPnt,3,rLev'
                            +' from PersonsGetChild2('+Str1+',0,3)');
   qrExeProc.ExecSQL;

       Запрос на получение детей и вставку их в таблицу PersonsLev формируется в зависимости от значения выбранного дерева.

qrExeProc.Close;  qrExeProc.SQL.Clear;
qrExeProc.SQL.Add('Select t1.SurName,t1.FirstName,t1.LastName, t1.BirthDate,');
qrExeProc.SQL.Add(' t1.PersnSex,t1.Atribut3,pl.PIDLevel,pl.PTreeNo,');
qrExeProc.SQL.Add(' t2.SurName as PSurName, t2.FirstName as PFirstName,');
qrExeProc.SQL.Add(' t2.LastName as PLastName, t2.BirthDate as PBirthDate');
qrExeProc.SQL.Add('  from Persons t1, Persons t2, PersonsLev pl');
qrExeProc.SQL.Add('  where t1.PersonID=pl.PersonID');
qrExeProc.SQL.Add('    and t2.PersonID=pl.PIDParnt');
qrExeProc.SQL.Add('  order by pl.PIDLevel');
qrExeProc.Open;    qrExeProc.First;

       Так как процедура PersonsGenChild2 возвращает ID и его родителя то можно построить запрос, имеющий все поля для построения скрипта. Он образуется соединением таблицы PersonsLev и двумя экземплярами таблицы Persons. Для того чтобы отличить одинаковые поля от различных экземпляров таблиц, поля от второго экземпляра таблицы Persons представлены псевдонимами с добавлением символа 'P'. Для того чтобы не было ошибок при выполнении скрипта записи сортируются по уровню узлов.
       Далее в цикле каждая запись результирующего запроса преобразуется в запрос на вставку этой записи в скрипте.

   While not qrExeProc.EOF do Begin
      If qrExeProc.FieldValues['PTreeNo']>0 then begin
      If qrExeProc.FieldValues['PTreeNo']=1
         then Str1 := 'Insert into Persons(PFather,';
      If qrExeProc.FieldValues['PTreeNo']=2 then
         Str1 := 'Insert into Persons(PMother,';
      If qrExeProc.FieldValues['PTreeNo']=3
         then Str1 := 'Insert into Persons(PAlias,';
      Str1 := Str1 + 'SurName,FirstName,LastName,BirthDate';
      Str2 := '  Select PersonID,''';
      Str2 := Str2 + qrExeProc.FieldValues['SurName']+''',''';
      Str2 := Str2 + qrExeProc.FieldValues['FirstName']+''',''';
      Str2 := Str2 + qrExeProc.FieldValues['LastName']+''',''';
      sFld := qrExeProc.FieldValues['BirthDate'];
      Str2 := Str2 + FormatDateTime('mm"/"dd"/"yyyy',StrToDateTime(sFld))+'''';
      If qrExeProc.FieldValues['PersnSex']<>0 then Begin
         Str1 := Str1 + ',PersnSex';
         Str2 := Str2 + ','+ IntToStr(qrExeProc.FieldValues['PersnSex']);
       end;
      If not VarIsNull(qrExeProc.FieldValues['Atribut3']) then begin
         If qrExeProc.FieldValues['Atribut3']<>'' then Begin
            Str1 := Str1 + ',Atribut3';
            Str2 := Str2 + ','''+ qrExeProc.FieldValues['Atribut3']+'''';
            end;
         end;
      Str3:='  where SurName='''+qrExeProc.FieldValues['PSurName']+'''';
      Str3:=Str3+' and FirstName='''+qrExeProc.FieldValues['PFirstName']+'''';
      Str3:=Str3+' and LastName='''+qrExeProc.FieldValues['PLastName']+'''';
      sFld:=qrExeProc.FieldValues['PBirthDate'];
      sFld:=FormatDateTime('mm"/"dd"/"yyyy',StrToDateTime(sFld));
      Str3:=Str3 + ' and BirthDate=''' + sFld+''';';
      WriteLn(flReprt,Str1);  WriteLn(flReprt,Str2);
      WriteLn(flReprt,'  from Persons');
      WriteLn(flReprt,Str3);    WriteLn(flReprt,'');
      end;
      qrExeProc.Next;
   end; // While not qrExeProc.EOF do
   WriteLn(flReprt,'Commit;');   WriteLn(flReprt,'');

   CloseFile(flReprt);
Screen.Cursor := SvCursor;
end;

       После вывода скрипта, выводится команда Commit; и файл закрывается.

Вариант 2.
       Если нужно сохранить всю таблицу, то проблем также не возникает. Процедура для этого привязана к кнопке btnSaveAllToSQL:

procedure TForm1.btnSaveAllToSQLClick(Sender: TObject);
Var
  rpPathName : String;
  flReprt : TextFile;
  Str1,Str2,Str3,Str4,sFld : String;
  SvCursor : TCursor;
  RC : Integer;
begin
   rpPathName := ExtractFilePath(Application.ExeName);
   SvCursor := Screen.Cursor;
   Screen.Cursor := crHourGlass;
// Создание файла и каталога, если необходимо
   If not DirectoryExists(rpPathName+'\DtSave') then
      If not CreateDir(rpPathName+'\DtSave') then
         raise Exception.Create('Cannot create '+rpPathName+'\DtSave');
   AssignFile(flReprt,rpPathName+'\DtSave\PersonsAll.txt');
   ReWrite(flReprt);
   WriteLn(flReprt,'/* Заполнение таблицы Persons */');
   WriteLn(flReprt,'Delete from PersonsTemp;');
   WriteLn(flReprt,'Commit;');
//  Получение всех полей для формирования скрипта
   qrExeProc.Close;  qrExeProc.SQL.Clear;
   qrExeProc.SQL.Add('Select * from Persons where PersonID<>0');
   qrExeProc.Open;    qrExeProc.First;
   While not qrExeProc.EOF do Begin
      Str1 := 'Insert into Persons(SurName,FirstName,LastName,BirthDate,';
      Str2 := '  values(''';
      Str2 := Str2 + qrExeProc.FieldValues['SurName']+''',''';
      Str2 := Str2 + qrExeProc.FieldValues['FirstName']+''',''';
      Str2 := Str2 + qrExeProc.FieldValues['LastName']+''',''';
      sFld := qrExeProc.FieldValues['BirthDate'];
      Str2 := Str2 + FormatDateTime('mm"/"dd"/"yyyy',StrToDateTime(sFld))+'''';
      If qrExeProc.FieldValues['PersnSex']<>0 then Begin
         Str1 := Str1 + ',PersnSex';
         Str2 := Str2 + ','+ IntToStr(qrExeProc.FieldValues['PersnSex']);
       end;
      If not VarIsNull(qrExeProc.FieldValues['Atribut3']) then begin
         If qrExeProc.FieldValues['Atribut3']<>'' then Begin
            Str1 := Str1 + ',Atribut3';
            Str2 := Str2 + ','''+ qrExeProc.FieldValues['Atribut3']+'''';
            end;
         end;
      WriteLn(flReprt,Str1+')');  WriteLn(flReprt,Str2+');');
      qrExeProc.Next;
   end; // While not qrExeProc.EOF do
   WriteLn(flReprt,'Commit;');    WriteLn(flReprt,'');

       Сначала формируется скрипт, который заполняет таблицу Persons всеми записями, но без учета связей между ними.
       Потом делается выборка только тех записей, у которых указан родитель по отцовской линии, т.е. Father<>0. И на основании этого запроса стоится скрипт, который заполняет вспомогательную таблицу PersonsTemp. Эта таблица была очищена командой Delete в начале скрипта.

   qrExeProc.Close;  qrExeProc.SQL.Clear;
   qrExeProc.SQL.Add('Select * from Persons where PersonID<>0 and Father<>0');
   qrExeProc.Open;    qrExeProc.First;
   While not qrExeProc.EOF do Begin
      Str1:='Insert into PersonsTemp(PersonID,PFather)';
      Str2:='  Select p.PersonID,f.PersonID from Persons p, Persons f';
      Str3:='  where (p.SurName='''+qrExeProc.FieldValues['SurName']+'''';
      Str3:=Str3+' and p.FirstName='''+qrExeProc.FieldValues['FirstName']+'''';
      Str3:=Str3+' and p.LastName='''+qrExeProc.FieldValues['LastName']+'''';
      sFld:= qrExeProc.FieldValues['BirthDate'];
      Str3:= Str3 + ' and p.BirthDate='''
          + FormatDateTime('mm"/"dd"/"yyyy',StrToDateTime(sFld))+''')';
      RC := qrExeProc.FieldValues['Father'];

       Выходной запрос требует две части условия — для основной записи и ее родителя. Для получения значений родительской записи строится еще один запрос.

      qrExeProc2.Close;  qrExeProc2.SQL.Clear;
      qrExeProc2.SQL.Add('Select * from Persons where PersonID='+IntToStr(RC));
      qrExeProc2.Open;
      Str4 := '    and (f.SurName='''+qrExeProc2.FieldValues['SurName']+'''';
      Str4 := Str4 + ' and f.FirstName=''' 
             + qrExeProc2.FieldValues['FirstName'] + '''';
      Str4:=Str4+' and f.LastName='''+qrExeProc2.FieldValues['LastName']+'''';
      sFld := qrExeProc2.FieldValues['BirthDate'];
      Str4 := Str4 + '  and f.BirthDate='''
           + FormatDateTime('mm"/"dd"/"yyyy',StrToDateTime(sFld))+''');';

       После формирования всех строк результирующего запроса, они выводятся в файл скрипта

      WriteLn(flReprt,Str1);  WriteLn(flReprt,Str2); 
      WriteLn(flReprt,Str3);  WriteLn(flReprt,Str4); WriteLn(flReprt,'');

      qrExeProc.Next;
   end; // While not qrExeProc.EOF do
   WriteLn(flReprt,'Commit;');   WriteLn(flReprt,'');

       То же самое повторяется для материнской ветки дерева

   qrExeProc.Close;  qrExeProc.SQL.Clear;
   qrExeProc.SQL.Add('Select * from Persons where PersonID<>0 and Mother<>0');
   qrExeProc.Open;    qrExeProc.First;
   While not qrExeProc.EOF do Begin
      Str1 := 'Insert into PersonsTemp(PersonID,PMother)';
      Str2 := '  Select p.PersonID,m.PersonID from Persons p, Persons m';
      Str3 := '  where (p.SurName='''+qrExeProc.FieldValues['SurName'] + '''';
      Str3:=Str3+' and p.FirstName='''+qrExeProc.FieldValues['FirstName']+'''';
      Str3:=Str3+' and p.LastName='''+qrExeProc.FieldValues['LastName']+'''';
      sFld := qrExeProc.FieldValues['BirthDate'];
      Str3 := Str3 + ' and p.BirthDate='''
           + FormatDateTime('mm"/"dd"/"yyyy',StrToDateTime(sFld))+''')';
      RC := qrExeProc.FieldValues['Mother'];
      qrExeProc2.Close;  qrExeProc2.SQL.Clear;
      qrExeProc2.SQL.Add('Select * from Persons where PersonID='+IntToStr(RC));
      qrExeProc2.Open;
      Str4 := '    and (m.SurName='''+qrExeProc2.FieldValues['SurName']+'''';
      Str4 := Str4 + ' and m.FirstName='''
           +qrExeProc2.FieldValues['FirstName']+'''';
      Str4 := Str4 + ' and m.LastName='''
           + qrExeProc2.FieldValues['LastName'] + '''';
      sFld := qrExeProc2.FieldValues['BirthDate'];
      Str4 := Str4 + '  and m.BirthDate='''
           + FormatDateTime('mm"/"dd"/"yyyy',StrToDateTime(sFld))+''');';
      WriteLn(flReprt,Str1);  WriteLn(flReprt,Str2);
      WriteLn(flReprt,Str3);  WriteLn(flReprt,Str4);  WriteLn(flReprt,'');
      qrExeProc.Next;
   end; // While not qrExeProc.EOF do
   WriteLn(flReprt,'Commit;');   WriteLn(flReprt,'');

       И также все повторяется для ветви дерева "Псевдонимы"

   qrExeProc.Close;  qrExeProc.SQL.Clear;
   qrExeProc.SQL.Add('Select * from Persons where PersonID<>0 and PAlias<>0');
   qrExeProc.Open;    qrExeProc.First;
   While not qrExeProc.EOF do Begin
      Str1 := 'Insert into PersonsTemp(PersonID,PAlias)';
      Str2 := '  Select p.PersonID,a.PersonID from Persons p, Persons a';
      Str3 := '  where (p.SurName='''+qrExeProc.FieldValues['SurName'] + '''';
      Str3:=Str3+' and p.FirstName='''+qrExeProc.FieldValues['FirstName']+'''';
      Str3:=Str3+' and p.LastName='''+qrExeProc.FieldValues['LastName']+'''';
      sFld := qrExeProc.FieldValues['BirthDate'];
      Str3 := Str3 + ' and p.BirthDate='''
           + FormatDateTime('mm"/"dd"/"yyyy',StrToDateTime(sFld))+''')';
      RC := qrExeProc.FieldValues['PAlias'];
      qrExeProc2.Close;  qrExeProc2.SQL.Clear;
      qrExeProc2.SQL.Add('Select * from Persons where PersonID='+IntToStr(RC));
      qrExeProc2.Open;
      Str4 := '    and (a.SurName='''+qrExeProc2.FieldValues['SurName'] + '''';
      Str4 := Str4+' and a.FirstName='''
           + qrExeProc2.FieldValues['FirstName']+'''';
      Str4 := Str4 + ' and a.LastName='''
           + qrExeProc2.FieldValues['LastName'] + '''';
      sFld := qrExeProc2.FieldValues['BirthDate'];
      Str4 := Str4 + '  and a.BirthDate='''
           + FormatDateTime('mm"/"dd"/"yyyy',StrToDateTime(sFld))+''');';
      WriteLn(flReprt,Str1);  WriteLn(flReprt,Str2);
      WriteLn(flReprt,Str3);  WriteLn(flReprt,Str4);  WriteLn(flReprt,'');
      qrExeProc.Next;
   end; // While not qrExeProc.EOF do
   WriteLn(flReprt,'Commit;');   WriteLn(flReprt,'');
   WriteLn(flReprt,'Execute procedure PersonsSetParent;');
   WriteLn(flReprt,'Commit;');   WriteLn(flReprt,'');
   CloseFile(flReprt);
Screen.Cursor := SvCursor;
end;

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

Вариант 3.
       Самый сложный случай — это когда нужно сохранить одну ветвь дерева с учетом всех связей по другим деревьям.
       Проблема заключается в том, что если сохраняется, например, ветвь дерева по отцовской линии, то будут утеряны родители по материнской линии. Для того чтобы их сохранить, нужно определить всех родителей до самого верха по материнской линии для всех детей, которые получены по отцовской линии. Поэтому получение списка всех записей, которые должны быть выведены в скрипт, происходит в несколько этапов. Для чего в таблицу PersonsLev добавлено поле PPassNo — номер прохода.
       — Сначала нужно получить детей выбранного дерева — это будет первый проход (PPassNo=0);
       — После этого нужно получить родителей всех полученных записей исключая выбранное дерево — второй проход (PPassNo=1). Так как это процесс достаточно трудоемкий, то была написана специальная хранимая процедура PersonsGetBranch;
       — Но у полученных родителей есть родители, по выбранному дереву. Для того чтобы их получить используется хранимая процедура PersonsParentBranch. Результат записывается в таблицу PersonsLev как PPassNo=2;
       — Дальше нужно выбрать уникальные значения поля PIDParnt и сложить их вместе со значениями поля PersonID — установив PPassNo=2;
       — После чего можно выбрать все уникальные значения PersonID как отдельный список — установив PPassNo=3;
       — И, наконец, значения полей PersonID,Father,Mother,PAlias полученного списка перебросить в таблицу PersonsTemp.
       Процедура PersonsGetBranch достаточно проста:

Create procedure PersonsGetBranch
as
DECLARE VARIABLE PID  Integer;
DECLARE VARIABLE Tree Integer;
DECLARE VARIABLE Pass Integer;
begin
  for select PersonID,PTreeNo from PersonsLev where PPassNo=0 into :PID,:Tree
    do begin 
       If (not (Tree=1)) then
          Begin
            Insert into PersonsLev(PersonID,PIDParnt,PTreeNo,PIDLevel,PPassNo)
             Select rChld,Prnt,1,rLev,1 from PersonsGetParent2(:PID,0,1);
          End
       If (not (Tree=2)) then
          Begin
            Insert into PersonsLev(PersonID,PIDParnt,PTreeNo,PIDLevel,PPassNo)
             Select rChld,Prnt,2,rLev,1 from PersonsGetParent2(:PID,0,2);
          End
       If (not (Tree=3)) then
          Begin
            Insert into PersonsLev(PersonID,PIDParnt,PTreeNo,PIDLevel,PPassNo)
             Select rChld,Prnt,3,rLev,1 from PersonsGetParent2(:PID,0,3);
          End
       end
end!!

       Процедура просматривает в таблице PersonsLev записи, полученные в результате прохода PPassNo=0, и для невыбранных деревьев получает всех родителей. Результат записывается в таблицу PersonsLev как PPassNo=1.
       Хранимая процедура PersonsParentBranch отличается от процедуры PersonsGetBranch тем, что просматривает результаты прохода PPassNo=1 и принимает в качестве параметра, по которому будут получаться родительские записи.

       Таким образом, в таблице PersonsTemp собрана вся информация о записях, которые необходимо сохранить в SQL-скрипт. Однако так как в таблице три дерева, то вывод как и в предыдущем варианте происходит в четыре этапа — сначала выводятся все записи, без учета связей между ними, затем выводятся запросы устанавливающие связи по каждому дереву в отдельности.

procedure TForm1.btnSaveChildToSQL2Click(Sender: TObject);
Var
  rpPathName : String;
  flReprt : TextFile;
  Str1,Str2,Str3,Str4,sFld : String;
  SvCursor : TCursor;
begin
   rpPathName := ExtractFilePath(Application.ExeName);
   SvCursor := Screen.Cursor;
   Screen.Cursor := crHourGlass;
// Создание файла и каталога, если необходимо
   If not DirectoryExists(rpPathName+'\DtSave') then
      If not CreateDir(rpPathName+'\DtSave') then
         raise Exception.Create('Cannot create '+rpPathName+'\DtSave');
   AssignFile(flReprt,rpPathName+'\DtSave\PersonsChild2.txt');
   ReWrite(flReprt);
   WriteLn(flReprt,'/* Заполнение таблицы Persons*/');
   WriteLn(flReprt,'Delete from PersonsTemp;');
   WriteLn(flReprt,'Commit;');
// Очистка вспомогательной таблицы PersonsLev
   qrExeProc.Close;      qrExeProc.SQL.Clear;
   qrExeProc.SQL.Add('Delete from PersonsLev');
   qrExeProc.ExecSQL;
// Очистка вспомогательной таблицы PersonsTemp
   qrExeProc.Close;      qrExeProc.SQL.Clear;
   qrExeProc.SQL.Add('Delete from PersonsTemp');
   qrExeProc.ExecSQL;    qrExeProc.Close;
// Выборка ID всех детей от указанного узла
   Str1 := IntToStr(tvPersons.Selected.ImageIndex);
   If tvPersons.Selected.Level>1
      then Str2 := IntToStr(tvPersons.Selected.Parent.ImageIndex)
      else Str2 := '0';
// Получение всех детей текущего узла по выбранному дереву  PPassNo=0
   qrExeProc.Close;      qrExeProc.SQL.Clear;
   qrExeProc.SQL.Add('Insert into PersonsLev(PersonID,PIDParnt,PTreeNo, PIDLevel,PPassNo)');
   qrExeProc.SQL.Add(' values('+Str1+','+Str2+',0,0,0)');
   qrExeProc.ExecSQL;
   qrExeProc.Close;      qrExeProc.SQL.Clear;
   qrExeProc.SQL.Add('Insert into PersonsLev(PersonID,PIDParnt,PTreeNo, PIDLevel,PPassNo)');
   If rbFather.Checked then qrExeProc.SQL.Add(' select Chld,rPnt,1,rLev,'
                            +'0 from PersonsGetChild2('+Str1+',0,1)');
   If rbMother.Checked then qrExeProc.SQL.Add(' select Chld,rPnt,2,rLev,'
                            +'0 from PersonsGetChild2('+Str1+',0,2)');
   If rbPAlias.Checked then qrExeProc.SQL.Add(' select Chld,rPnt,3,rLev,'
                            +'0 from PersonsGetChild2('+Str1+',0,3)');
   qrExeProc.ExecSQL;

       Сначала в таблицу PersonsLev записывается выбранный узел, а затем получаются дети по выбранному узлу — rbFather, rbMother или rbPAlias.

   qrExeProc.Close;      qrExeProc.SQL.Clear;
   qrExeProc.SQL.Add('Execute procedure PersonsGetBranch');  // PassNo=1
   qrExeProc.ExecSQL;

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

   qrExeProc.Close;      qrExeProc.SQL.Clear;
   If rbFather.Checked
      then qrExeProc.SQL.Add('Execute procedure PersonsParentBranch(1)');
   If rbMother.Checked 
      then qrExeProc.SQL.Add('Execute procedure PersonsParentBranch(2)');
   If rbPAlias.Checked 
      then qrExeProc.SQL.Add('Execute procedure PersonsParentBranch(3)');

       А затем выбираются дополнительные родители по выбранному дереву

// PassNo=2 Получаются уникальные родители
   qrExeProc.ExecSQL;
   qrExeProc.Close;      qrExeProc.SQL.Clear;
   qrExeProc.SQL.Add('Insert into PersonsLev(PersonID,PIDParnt,PPassNo)');
   qrExeProc.SQL.Add('Select distinct PIDParnt,0,2 from PersonsLev');
   qrExeProc.ExecSQL;
//PassNo=3 Получается уникальный список выводимых записей
   qrExeProc.Close;      qrExeProc.SQL.Clear;
   qrExeProc.SQL.Add('Insert into PersonsLev(PersonID,PIDParnt,PPassNo)');
   qrExeProc.SQL.Add('Select distinct PersonID,0,3 from PersonsLev');
   qrExeProc.ExecSQL;
// Получается список выводимых записей со связями
   qrExeProc.Close;      qrExeProc.SQL.Clear;
   qrExeProc.SQL.Add('Insert into PersonsTemp(PersonID,PFather,PMother, PAlias)');
   qrExeProc.SQL.Add('Select distinct p.PersonID,p.Father,p.Mother,p.PAlias');
   qrExeProc.SQL.Add(' from Persons p, PersonsLev l');
   qrExeProc.SQL.Add(' where p.PersonID=l.PersonID');
   qrExeProc.SQL.Add('  and l.PPassNo=3');
   qrExeProc.SQL.Add(' order by p.PersonID');
   qrExeProc.ExecSQL;

//  Получение всех полей для формирования скрипта
   qrExeProc.Close;  qrExeProc.SQL.Clear;
   qrExeProc.SQL.Add('Select p.PersonID,p.SurName,p.FirstName,p.LastName,');
   qrExeProc.SQL.Add(' p.BirthDate, p.PersnSex,p.Atribut3');
   qrExeProc.SQL.Add('  from Persons p, PersonsTemp t');
   qrExeProc.SQL.Add('  where p.PersonID=t.PersonID and t.PersonID<>0');
   qrExeProc.SQL.Add('  order by p.PersonID');
   qrExeProc.Open;    qrExeProc.First;
// Вывод всех записей без связей
   While not qrExeProc.EOF do Begin
      Str1 := 'Insert into Persons(SurName,FirstName,LastName,BirthDate,';
      Str2 := '  values(''';
      Str2 := Str2 + qrExeProc.FieldValues['SurName']+''',''';
      Str2 := Str2 + qrExeProc.FieldValues['FirstName']+''',''';
      Str2 := Str2 + qrExeProc.FieldValues['LastName']+''',''';
      sFld := qrExeProc.FieldValues['BirthDate'];
      Str2 := Str2 + FormatDateTime('mm"/"dd"/"yyyy',StrToDateTime(sFld))+'''';
      If qrExeProc.FieldValues['PersnSex']<>0 then Begin
         Str1 := Str1 + ',PersnSex';
         Str2 := Str2 + ','+ IntToStr(qrExeProc.FieldValues['PersnSex']);
       end;
      If not VarIsNull(qrExeProc.FieldValues['Atribut3']) then begin
         If qrExeProc.FieldValues['Atribut3']<>'' then Begin
            Str1 := Str1 + ',Atribut3';
            Str2 := Str2 + ','''+ qrExeProc.FieldValues['Atribut3']+'''';
            end;
         end;
      WriteLn(flReprt,Str1+')');  WriteLn(flReprt,Str2+');');
      qrExeProc.Next;
   end; // While not qrExeProc.EOF do
   WriteLn(flReprt,'Commit;');    WriteLn(flReprt,'');

// Father - вывод связей по дереву Father
   qrExeProc.Close;  qrExeProc.SQL.Clear;
   qrExeProc.SQL.Add('Select p1.SurName,p1.FirstName,');
   qrExeProc.SQL.Add('p1.LastName,p1.BirthDate,');
   qrExeProc.SQL.Add(' p2.SurName as PSurName, p2.FirstName as PFirstName,');
   qrExeProc.SQL.Add(' p2.LastName as PLastName, p2.BirthDate as PBirthDate');
   qrExeProc.SQL.Add('  from Persons p1, Persons p2, PersonsTemp tm');
   qrExeProc.SQL.Add('  where p1.PersonID=tm.PersonID');
   qrExeProc.SQL.Add('    and p2.PersonID=tm.PFather');
   qrExeProc.SQL.Add('    and tm.PFather<>0');
   qrExeProc.SQL.Add('  order by tm.PersonID');
   qrExeProc.Open;    qrExeProc.First;
   While not qrExeProc.EOF do Begin
      Str1 := 'Insert into PersonsTemp(PersonID,PFather)';
      Str2 := '  Select p.PersonID,f.PersonID from Persons p, Persons f';
      Str3 := '  where (p.SurName='''+qrExeProc.FieldValues['SurName']+'''';
      Str3:=Str3+' and p.FirstName='''+qrExeProc.FieldValues['FirstName']+'''';
      Str3:=Str3+' and p.LastName='''+qrExeProc.FieldValues['LastName']+'''';
      sFld := qrExeProc.FieldValues['BirthDate'];
      Str3 := Str3 + ' and p.BirthDate='''
           + FormatDateTime('mm"/"dd"/"yyyy',StrToDateTime(sFld))+''')';
      Str4 := '    and (f.SurName='''+qrExeProc.FieldValues['PSurName']+'''';
      Str4 := Str4 + ' and f.FirstName='''
           +qrExeProc.FieldValues['PFirstName']+'''';
      Str4 := Str4 + ' and f.LastName='''
           + qrExeProc.FieldValues['PLastName'] + '''';
      sFld := qrExeProc.FieldValues['PBirthDate'];
      Str4 := Str4 + ' and f.BirthDate='''
           + FormatDateTime('mm"/"dd"/"yyyy',StrToDateTime(sFld))+''');';
      WriteLn(flReprt,Str1);  WriteLn(flReprt,Str2);
      WriteLn(flReprt,Str3);  WriteLn(flReprt,Str4);  WriteLn(flReprt,'');
      qrExeProc.Next;
   end; // While not qrExeProc.EOF do
   WriteLn(flReprt,'Commit;');   WriteLn(flReprt,'');

// Mother - вывод связей по дереву Mother
   qrExeProc.Close;  qrExeProc.SQL.Clear;
   qrExeProc.SQL.Add('Select p1.SurName,p1.FirstName,');
   qrExeProc.SQL.Add('p1.LastName,p1.BirthDate,');
   qrExeProc.SQL.Add(' p2.SurName as PSurName, p2.FirstName as PFirstName,');
   qrExeProc.SQL.Add(' p2.LastName as PLastName, p2.BirthDate as PBirthDate');
   qrExeProc.SQL.Add('  from Persons p1, Persons p2, PersonsTemp tm');
   qrExeProc.SQL.Add('  where p1.PersonID=tm.PersonID');
   qrExeProc.SQL.Add('    and p2.PersonID=tm.PMother');
   qrExeProc.SQL.Add('    and tm.PMother<>0');
   qrExeProc.SQL.Add('  order by tm.PersonID');
   qrExeProc.Open;    qrExeProc.First;
   While not qrExeProc.EOF do Begin
      Str1 := 'Insert into PersonsTemp(PersonID,PMother)';
      Str2 := '  Select p.PersonID,f.PersonID from Persons p, Persons f';
      Str3 := '  where (p.SurName='''+qrExeProc.FieldValues['SurName']+'''';
      Str3:=Str3+' and p.FirstName='''+qrExeProc.FieldValues['FirstName']+'''';
      Str3:=Str3+' and p.LastName='''+qrExeProc.FieldValues['LastName']+'''';
      sFld := qrExeProc.FieldValues['BirthDate'];
      Str3 := Str3 + ' and p.BirthDate='''
           + FormatDateTime('mm"/"dd"/"yyyy',StrToDateTime(sFld))+''')';
      Str4 := '    and (f.SurName='''+qrExeProc.FieldValues['PSurName']+'''';
      Str4 := Str4 + ' and f.FirstName='''
           + qrExeProc.FieldValues['PFirstName'] + '''';
      Str4:=Str4+' and f.LastName='''+qrExeProc.FieldValues['PLastName']+'''';
      sFld := qrExeProc.FieldValues['PBirthDate'];
      Str4 := Str4 + ' and f.BirthDate='''
           + FormatDateTime('mm"/"dd"/"yyyy',StrToDateTime(sFld))+''');';
      WriteLn(flReprt,Str1);  WriteLn(flReprt,Str2);
      WriteLn(flReprt,Str3);  WriteLn(flReprt,Str4); WriteLn(flReprt,'');
      qrExeProc.Next;
   end; // While not qrExeProc.EOF do
   WriteLn(flReprt,'Commit;');   WriteLn(flReprt,'');

// PAlias - вывод связей по дереву PAlias
   qrExeProc.Close;  qrExeProc.SQL.Clear;
   qrExeProc.SQL.Add('Select p1.SurName,p1.FirstName,');
   qrExeProc.SQL.Add('p1.LastName,p1.BirthDate,');
   qrExeProc.SQL.Add(' p2.SurName as PSurName, p2.FirstName as PFirstName,');
   qrExeProc.SQL.Add('p2.LastName as PLastName, p2.BirthDate as PBirthDate');
   qrExeProc.SQL.Add('  from Persons p1, Persons p2, PersonsTemp tm');
   qrExeProc.SQL.Add('  where p1.PersonID=tm.PersonID');
   qrExeProc.SQL.Add('    and p2.PersonID=tm.PAlias');
   qrExeProc.SQL.Add('    and tm.PAlias<>0');
   qrExeProc.SQL.Add('  order by tm.PersonID');
   qrExeProc.Open;    qrExeProc.First;
   While not qrExeProc.EOF do Begin
      Str1 := 'Insert into PersonsTemp(PersonID,PAlias)';
      Str2 := '  Select p.PersonID,f.PersonID from Persons p, Persons f';
      Str3 := '  where (p.SurName='''+qrExeProc.FieldValues['SurName']+'''';
      Str3:=Str3+' and p.FirstName='''+qrExeProc.FieldValues['FirstName']+'''';
      Str3:=Str3+' and p.LastName='''+qrExeProc.FieldValues['LastName']+'''';
      sFld := qrExeProc.FieldValues['BirthDate'];
      Str3 := Str3 + ' and p.BirthDate='''
           + FormatDateTime('mm"/"dd"/"yyyy',StrToDateTime(sFld))+''')';
      Str4 := '    and (f.SurName='''+qrExeProc.FieldValues['PSurName']+'''';
      Str4 := Str4 + ' and f.FirstName='''
           + qrExeProc.FieldValues['PFirstName'] + '''';
      Str4:=Str4+' and f.LastName='''+qrExeProc.FieldValues['PLastName']+'''';
      sFld := qrExeProc.FieldValues['PBirthDate'];
      Str4 := Str4 + ' and f.BirthDate='''
           + FormatDateTime('mm"/"dd"/"yyyy',StrToDateTime(sFld))+''');';
      WriteLn(flReprt,Str1);  WriteLn(flReprt,Str2); 
      WriteLn(flReprt,Str3);  WriteLn(flReprt,Str4); WriteLn(flReprt,'');
      qrExeProc.Next;
   end; // While not qrExeProc.EOF do
   WriteLn(flReprt,'Commit;');   WriteLn(flReprt,'');

   WriteLn(flReprt,'Execute procedure PersonsSetParent;');
   WriteLn(flReprt,'Commit;');   WriteLn(flReprt,'');

   CloseFile(flReprt);

Screen.Cursor := SvCursor;
end;

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

© 01.08.2009, Архангельский А.Г.

<<Пред. Оглавление
Об Авторе
Все персоны
Главная страница
След.>>



Поддержите культуру
ЯндексЯндекс. ДеньгиХочу такую же кнопку

Google
 
Web azdesign.ru az-libr.ru


Дата последнего изменения:
Wednesday, 23-Oct-2013 09:02:58 UTC