ubintree.pas

为管理和查阅的方便, 对指定目录下的所有目录及文件以格式化形式保存到文本文件中.

////////////////////////////////////////////////////////////////////////////////
//定义了一个二叉树结构,该二叉树具有添加、清空、初始化、中序遍历的功能,初始化即把
//二叉树的根指针置为空,清空是把二叉树的所有节点占用的空间释放,同时置根节点为空.
//添加是在指定节点的子节点上加上新节点,该节点的添加方法不同于一般方法,如果指定节
//点没有左孩子,则添加到左孩子,否则,则添加到最底层的右孩子上. 要求排序
unit uBinTree;

interface

uses Classes;

type
  //孩子的类型
  TChildType = (ctLeft, ctRight);
  //二叉树结构
  PBinTree = ^TBinTree;
  TBinTree = record
    Parent : PBinTree;
    Child : array [TChildType] of PBinTree;
    FileName : string;
  end;

  function BinTreeAdd( aParent : PBinTree; aFileName : string; aType:TChildType)
     :PBinTree;
  procedure BinTreeClear;
  function BinTreeInit : PBinTree;
  procedure BinTreePreOrder(aRoot : PBinTree ; Level : integer);
  function CmpDir(s1,s2:string): Boolean;
  function GetHead(aTree : PBinTree) : PBinTree;

var
  BinTreeRoot : PBinTree;
  Count : integer;
  BinTreeStr : string;
  BinTreeStrs : array of string;
  SeperateChar : char;

implementation

////////////////////////////////////////////////////////////////////////////////
//函数说明
//在父节点加入一个新节点.根据加入类型加入节点,如果是左节点类型,则在指定父节点的
//左节点处加入,如果加入类型是右节点类型,则加到指定父节点的右孩子的右孩子的位置,
//至于加到哪个右孩子,要比较之后才能定下,如果加入的字符串小于父节点的字符串,那么,
//父节点还要和新节点的位置交换才可.
//输入:父节点和目录/文件名
//输出:已经加入的新节点
////////////////////////////////////////////////////////////////////////////////
function BinTreeAdd( aParent : PBinTree; aFileName : string ;
  aType : TChildType) : PBinTree;
var
  FNode : PBinTree;
  Temp : PBinTree;
  
begin
  //对新节点赋值
  New(FNode);
  FNode.Parent := nil;
  FNode.Child[ctLeft] := nil;
  FNode.Child[ctRight] := nil;
  FNode.FileName := aFileName;

  //添加到父节点中的合适位置
  if aParent = nil then
  begin
    //如果父节点为空,直接把根指向新节点
    BinTreeRoot:= FNode;
    aParent := FNode;
  end
  else begin
    if (aParent.Child[ctLeft] = nil )and(aType=ctLeft)then
    begin
      //如果加入左孩子,直接加入
      aParent.Child[ctLeft] := FNode;
      FNode.Parent := aParent;
    end
    else begin
      //如果加入右孩子,比较父节点和新节点
      if not cmpdir(aParent.FileName,aFileName) then
      begin
        //父节点和新节点交换位置
        Temp := aParent.Parent;
        FNode.Parent := Temp;
        FNode.Child[ctRight]:=aParent;
        if Temp.Child[ctLeft] = aParent then
          Temp.Child[ctLeft] := FNode
        else
          Temp.Child[ctRight] := FNode;
        aParent.Parent := FNode;
      end
      else begin
        //找到合适的右孩子位置并加入
        Temp := aParent;
        while (Temp.Child[ctRight]<>nil ) and cmpdir(Temp.FileName,aFileName) do
        begin
          Temp := Temp.Child[ctRight];
        end;
        if (Temp.Child[ctRight]= nil) and cmpdir(Temp.FileName, aFileName) then
        begin
          //如果加到最底层的右孩子处
          Temp.Child[ctRight] := FNode;
          FNode.Parent := Temp;
        end
        else begin
          //插到找到的右孩子之前的位置
          FNode.Parent := Temp.Parent;
          Temp.Parent.Child[ctRight] := FNode;
          FNode.Child[ctRight] := Temp;
          Temp.Parent := FNode;
        end;
      end;
    end;
  end;
  Result := FNode;
end;

////////////////////////////////////////////////////////////////////////////////
//函数说明
//依次清空所有的节点空间,凡是节点的左右节点均为NIL,则清空该节点,同时更新父节点的
//对应子节点为空.如果节点的右节点不为空,则要检索到最右节点给以清空.
////////////////////////////////////////////////////////////////////////////////
procedure BinTreeClear;
var
  Temp , aParent : PBinTree;
begin
  //从根节点开始.
  Count := 0;
  Temp := BinTreeRoot ;
  while temp <> nil do
  begin
    //无子节点的节点清空
    if (Temp.Child[ctLeft] = nil) and (Temp.Child[ctRight] = nil ) then
    begin
      aParent := Temp.Parent;
      if aParent <> nil then
      begin
        if aParent.Child[ctLeft] = Temp then
          aParent.Child[ctLeft] := nil
        else
          aParent.Child[ctRight] := nil;
      end;
      Dispose(Temp);
      Temp := aParent;
      Inc(Count);
    end
    else begin
      if Temp.Child[ctRight]<> nil then
      begin
        Temp := Temp.Child[ctRight];
      end
      else begin
        Temp := Temp.Child[ctLeft];
      end;
    end;
  end;
  BinTreeRoot := nil;
  SetLength(BinTreeStrs, 0);
end;

////////////////////////////////////////////////////////////////////////////////
//初始化根节点为空
////////////////////////////////////////////////////////////////////////////////
function BinTreeInit : PBinTree;
begin
  BinTreeRoot := nil;
  Result := nil;
  SeperateChar := #9;
end;

////////////////////////////////////////////////////////////////////////////////
//先序遍历。即先访问根节点，然后是左节点，然后是右节点。采用递归方式。
//输入:节点,层次
//输出:格式化字符串
//根据层次定出加的TAB个数.
////////////////////////////////////////////////////////////////////////////////
procedure BinTreePreOrder(aRoot : PBinTree ; Level : integer );
var
  i : integer;
begin
  BinTreeStr := '';
  if aRoot <> nil then
  begin
    for i:=0 to Level-1 do
      BinTreeStr := BinTreeStr + SeperateChar;
    BinTreeStr := BinTreeStr + aRoot.FileName;
    SetLength(BinTreeStrs, High(BinTreeStrs)+2);
    BinTreeStrs[High(BinTreeStrs)] := BinTreeStr;
    Level := Level + 1;

    BinTreePreOrder(aRoot.Child[ctLeft], Level);
    Level := Level - 1;
    BinTreePreOrder(aRoot.Child[ctRight],Level);
  end
  else begin
    Level := Level - 1;
  end;
end;
////////////////////////////////////////////////////////////////////////////////
//比较文件和目录的大小
//输入:两个文件或目录
//输出:大小结果
//文件小于目录,同是目录或同是文件则分开比较.文件还要提出文件名和扩展名,目录要提
//出目录名
function CmpDir(s1,s2:string): Boolean;
var
  FileName1, FileName2, ExtrcName1, ExtrcName2 : string;
  i : integer;
begin
  if (s1='') or (s2='') then
  begin
    Result := s1 < s2;
  end
  else begin
    if (s1[Length(s1)] = '\') and (s2[Length(s2)] <> '\' )then
    begin
      Result := TRUE;
    end
    else if (s1[Length(s1)] <>'\')and(s2[Length(s2)] = '\')then
    begin
      Result := FALSE;
    end
    else if (s1[Length(s1)]='\')and(s2[Length(s2)]='\')then
    begin
      s1 := Copy(s1, 1, Length(s1)-1);
      s2 := Copy(s2, 1, Length(s2)-1);
      Result := s1 < s2;
    end
    else begin
      for i:=Length(s1) downto 1 do
        if s1[i]='.' then
          break;
      FileName1:=Copy(s1,1,i-1);
      ExtrcName1 := Copy(s1,i+1,Length(s1)-i);
      for i:=Length(s2) downto 1 do
        if s2[i]='.' then
          break;
      FileName2 := Copy(s2, 1, i-1);
      ExtrcName2 := Copy(s2, i+1, Length(s2)-i);

      if FileName1<FileName2 then
        Result := TRUE
      else if FileName1 = FileName2 then
        Result := ExtrcName1 < ExtrcName2
      else
        Result := FALSE;
    end;
  end;
end;
////////////////////////////////////////////////////////////////////////////////
//得到某个节点的父节点.条件是该节点是父节点的右孩子的右孩子... ,即在目录是他们是
//同级的.
//输入:节点
//输出:符合条件的父节点
function GetHead(aTree : PBinTree) : PBinTree;
var
  Temp : PBinTree;
begin
  if aTree = BinTreeRoot then
  begin
    Result := aTree;
    Exit;
  end;

  if aTree.Parent.Child[ctLeft]=aTree then
    Result := aTree
  else begin
    Temp := aTree.Parent;
    while (Temp.Parent.Child[ctLeft]<>Temp)and(Temp.Parent<>nil) do
      Temp := Temp.Parent;
    Result := Temp;
  end;
end;

end.