unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, sdDB, sdProvider, DB, ADODB, ComCtrls;

type
  TForm1 = class(TForm)
    mmError: TMemo;
    btnCheck: TButton;
    edtFile: TEdit;
    acTree: TADOConnection;
    sapTree: TsdADOProvider;
    sdsTree: TsdDataSet;
    ProgressBar: TProgressBar;
    OpenDialog: TOpenDialog;
    lblError: TLabel;
    btnRecheck: TButton;
    procedure btnCheckClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnRecheckClick(Sender: TObject);
  private
    { Private declarations }
    FIdx: TsdIndex;
    procedure CheckTree;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  ScUtils;

{$R *.dfm}

const
  SAdoConnectStr       = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;User ID=%s;Password=%s;Persist Security Info=True';

procedure TForm1.btnCheckClick(Sender: TObject);
begin
  if OpenDialog.Execute and FileExists(OpenDialog.FileName) then
  begin
    edtFile.Text := OpenDialog.FileName;
    Screen.Cursor := crHourGlass;
    try
      sdsTree.Close;
      acTree.Close;
      sdsTree.ClearIndex;

      acTree.ConnectionString := Format(SAdoConnectStr, [edtFile.Text, 'Admin', '']);
      acTree.Open;
      sapTree.TableName := 'Bills';
      sdsTree.Open;
      FIdx := sdsTree.AddIndex('idxParent', 'ParentID;SerialNo');

      mmError.Clear;
      CheckTree;
      sdsTree.Close;
      acTree.Close;
    finally
      Screen.Cursor := crDefault;
    end;
  end;
end;

procedure TForm1.btnRecheckClick(Sender: TObject);
begin
  if not FileExists(edtFile.Text) then Exit;
  Screen.Cursor := crHourGlass;
  try
    sdsTree.ClearIndex;
    acTree.Open;
    sdsTree.Open;
    FIdx := sdsTree.AddIndex('idxParent', 'ParentID;SerialNo');
    mmError.Clear;
    CheckTree;
    sdsTree.Close;
    acTree.Close;
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TForm1.CheckTree;
var
  I, J, K, iError, iFirstChild, iEndlessNextID, iLength: Integer;
  // [[ID, NextSibingID], []...]
  arrChild: array of array of Integer;
  Rec1, Rec2, Rec3: TsdDataRecord;
  bOnlyOneChild, bHasNext, bHasMoreThanOneNext, bHasLastNode, bHasMoreThanOneLastNode, bIsFirstChild: Boolean;

  function FindEndlessNext(AID: Integer): Integer;
  var
    L, M, iID, iLastID: Integer;
    arrNext: array of Integer;
    bHasNext: Boolean;
  begin
    Result := -1;
    if Length(arrChild) <= 1 then Exit;
    iLastID := AID;
    repeat
      iID := iLastID;
      bHasNext := False;
      for L := Low(arrChild) to High(arrChild) do
      begin
        if arrChild[L, 0] = iID then
        begin
          iLastID := arrChild[L, 1];
          if ArrayIndexOf(iLastID, arrNext) > 0 then
            Exit;
          bHasNext := True;
          SetLength(arrNext, Length(arrNext) + 1);
          arrNext[Length(arrNext) - 1] := iLastID;
          Break;
        end;
      end;
    until (iLastID = AID) or (iLastID = -1) or not bHasNext;
    Result := iLastID;
  end;

begin
  ProgressBar.Max := FIdx.RecordCount - 2;
  ProgressBar.Position := 0;
  bIsFirstChild := True;
  iError := 0;
  iFirstChild := 0;
  for I := 0 to FIdx.RecordCount - 2 do
  begin
    Rec1 := FIdx.Records[I];
    bOnlyOneChild := False;
    bHasNext := False;
    bHasMoreThanOneNext := False;
    bHasLastNode := False;
    bHasMoreThanOneLastNode := False;
    iEndlessNextID := -1;
    // 生产所有兄弟的ID关系数组，后面检查兄弟关系死循环用
    if bIsFirstChild then
      for K := iFirstChild to FIdx.RecordCount - 1 do
      begin
        Rec3 := FIdx.Records[K];
        // 是否换Parent
        if Rec1.ValueByName('ParentID').AsInteger <> Rec3.ValueByName('ParentID').AsInteger then Break;
        iLength := Length(arrChild) + 1;
        SetLength(arrChild, iLength, 2);
        arrChild[iLength - 1, 0] := Rec3.ValueByName('ID').AsInteger;
        arrChild[iLength - 1, 1] := Rec3.ValueByName('NextSiblingID').AsInteger;
      end;

    for J := iFirstChild to FIdx.RecordCount - 1 do
    begin
      ProgressBar.Position := I;
      Rec2 := FIdx.Records[J];
      // 判断是否到下一个父节点
      if Rec1.ValueByName('ParentID').AsInteger <> Rec2.ValueByName('ParentID').AsInteger then
      begin
        // 父节点只有一个儿子
        if J = I + 1 then
        begin
          bOnlyOneChild := True;
          if Rec1.ValueByName('NextSiblingID').AsInteger <> -1 then
          begin
            mmError.Lines.Add(Format('Node[ID: %d] has Only one Child and no LastChild.', [Rec1.ValueByName('ParentID').AsInteger]));
            Inc(iError);
          end;
        end;
        Break;
      end;
      // 检查最后兄弟
      if bIsFirstChild then
      begin
        if Rec2.ValueByName('NextSiblingID').AsInteger = -1 then
        begin
          if bHasLastNode  then
            bHasMoreThanOneLastNode := True;
          bHasLastNode := True;
        end;
      end;
      // 寻找后兄弟
      if Rec1.ValueByName('NextSiblingID').AsInteger = Rec2.ValueByName('ID').AsInteger then
      begin
        if bHasNext then
          bHasMoreThanOneNext := True;
        bHasNext := True;
        // 检查兄弟关系死循环
        iEndlessNextID := FindEndlessNext(Rec1.ValueByName('ID').AsInteger);
      end;
      if Rec2.ValueByName('NextSiblingID').AsInteger = Rec1.ValueByName('ID').AsInteger then
    end;
    if not bOnlyOneChild then
    begin
      if not bHasNext then
      begin
        mmError.Lines.Add(Format('Node[ID: %d] has no NextSibling.', [Rec1.ValueByName('ID').AsInteger]));
        Inc(iError);
      end;
      if bHasMoreThanOneNext then
      begin
        mmError.Lines.Add(Format('Node[ID: %d] has more than one NextSibling.', [Rec1.ValueByName('ID').AsInteger]));
        Inc(iError);
      end;
      if bIsFirstChild and not bHasLastNode then
      begin
        mmError.Lines.Add(Format('Node[ID: %d] has no LastChild.', [Rec1.ValueByName('ParentID').AsInteger]));
        Inc(iError);
      end;
      if bHasMoreThanOneLastNode then
      begin
        mmError.Lines.Add(Format('Node[ID: %d] has more than one LastChld.', [Rec1.ValueByName('ParentID').AsInteger]));
        Inc(iError);
      end;
      if iEndlessNextID >= 0 then
      begin
        mmError.Lines.Add(Format('Node[ID: %d] have endless loop.', [Rec1.ValueByName('ID').AsInteger]));
        Inc(iError);
      end;
    end;
    Rec2 := FIdx.Records[I + 1];
    bIsFirstChild := Rec1.ValueByName('ParentID').AsInteger <> Rec2.ValueByName('ParentID').AsInteger;
    if bIsFirstChild then
    begin
      iFirstChild := I + 1;
      SetLength(arrChild, 0, 0);
    end;
  end;
  lblError.Caption := Format('共%d条记录，%d条错误', [sdsTree.RecordCount, iError]);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  sdsTree.Close;
  acTree.Close;
end;

end.