Gedcom-Datei parsen

[Sir Rufo]

Hier mal so ein Minimalprogramm zum Veranschaulichen

Delphi-Quellcode:

program dp_183093;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  System.Generics.Collections,
  System.SysUtils;

type
  TNode = class
  private
    FParent: TNode;
    FChildren: TList<TNode>;
    function GetLastChild: TNode;
    function GetChildCount: Integer;
    function GetChild( Index: Integer ): TNode;
  public
    constructor Create( AParent: TNode );
    destructor Destroy; override;

    procedure AddChild( ANode: TNode );

    property ChildCount: Integer read GetChildCount;
    property Children[Index: Integer]: TNode read GetChild;

    property Parent: TNode read FParent;
    property LastChild: TNode read GetLastChild;
  end;

  TGedFile = class( TNode )
  private
    function GetParent( Index: Integer ): TNode;
  public
    constructor Create( AValues: TArray<Integer> );
  end;

  { TNode }

procedure TNode.AddChild( ANode: TNode );
begin
  if Assigned( ANode.Parent ) and ( ANode.Parent <> nil )
  then
    raise Exception.Create( 'Fehlermeldung' );

  ANode.FParent := Self;

  if not FChildren.Contains( ANode )
  then
    FChildren.Add( ANode );
end;

constructor TNode.Create( AParent: TNode );
begin
  inherited Create;
  FChildren := TObjectList<TNode>.Create;
  if Assigned( AParent )
  then
    AParent.AddChild( Self );
end;

destructor TNode.Destroy;
begin
  FChildren.Free;
  inherited;
end;

function TNode.GetChild( Index: Integer ): TNode;
begin
  Result := FChildren[Index];
end;

function TNode.GetChildCount: Integer;
begin
  Result := FChildren.Count;
end;

function TNode.GetLastChild: TNode;
begin
  Result := FChildren.Last;
end;

{ TGedFile }

constructor TGedFile.Create( AValues: TArray<Integer> );
var
  LValue: Integer;
begin
  inherited Create( nil );

  for LValue in AValues do
    begin
      TNode.Create( GetParent( LValue ) );
    end;
end;

function TGedFile.GetParent( Index: Integer ): TNode;
begin
  Result := Self;
  while Index > 0 do
    begin
      if not Assigned( Result )
      then
        raise Exception.Create( 'Fehlermeldung' );
      Result := Result.LastChild;
      Dec( Index );
    end;
end;

procedure OutputNode( ANode: TNode; ALevel: Integer = 0 );
var
  LIdx: Integer;
begin
  Write( '':ALevel, ANode.ToString );
  if ALevel > 0
  then
    Write( ' (', ALevel - 1, ')' );
  WriteLn;
  for LIdx := 0 to ANode.ChildCount - 1 do
    OutputNode( ANode.Children[LIdx], ALevel + 1 );
end;

procedure Main;
var
  LFile: TGedFile;
begin
  LFile := TGedFile.Create( TArray<Integer>.Create( 0, 1, 2, 3, 1, 1, 1, 2, 3, 3, 3, 3 ) );
  try
    OutputNode( LFile );
  finally
    LFile.Free;
  end;
end;

begin
  try
    Main;
  except
    on E: Exception do
      WriteLn( E.ClassName, ': ', E.Message );
  end;
  ReadLn;

end.

Ausgabe ist dann wie folgt

Code:

TGedFile
 TNode (0)
  TNode (1)
   TNode (2)
    TNode (3)
  TNode (1)
  TNode (1)
  TNode (1)
   TNode (2)
    TNode (3)
    TNode (3)
    TNode (3)
    TNode (3)