umain.pas

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

////////////////////////////////////////////////////////////////////////////////
//程序名称:文件明细保存助手
//程序功能:对指定目录下的所有文件和目录进行读取,按照字母顺序排列,以一定的格式保
//存到文本文件中.
//编写人: 张渝勤
//开始日期:2005年6月22日
//完成日期:2005年6月23日
unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, uBinTree, ComCtrls;

type
  TFrmMain = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Bevel1: TBevel;
    Edit1: TEdit;
    SBDir: TSpeedButton;
    BtnSave: TButton;
    BtnExit: TButton;
    SDDir: TSaveDialog;
    BtnLook: TButton;
    ODDir: TOpenDialog;
    StatusBar1: TStatusBar;
    procedure BtnExitClick(Sender: TObject);
    procedure BtnSaveClick(Sender: TObject);
    procedure SBDirClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BtnLookClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    ExeDir,
    DirStr: string;
    procedure SaveFormatDir(Dir : string);
    procedure Search(Dir : string;  aTree : PBinTree);
    function FormatDir(Dir : string) : string;
    procedure SaveToFile(FileName:string);
  public
    { Public declarations }
  end;

var
  FrmMain: TFrmMain;
  BinTree : PBinTree;

implementation

uses uSelDir, IniFiles, ShellAPI;

{$R *.dfm}

procedure TFrmMain.BtnExitClick(Sender: TObject);
begin
  Close;
end;

procedure TFrmMain.BtnSaveClick(Sender: TObject);
var
  s: string;
begin
  s := Edit1.Text;
  {$I-}
  ChDir(S);
  //ShowMessage(S);
  
  if IOResult<>0 then
    MessageDlg('该目录不存在', mtWarning, [mbOk], 0)
  else
    SaveFormatDir(Edit1.Text);
  {$I+}
end;
////////////////////////////////////////////////////////////////////////////////
//对查找到的所有文件和目录以格式化保存
//输入:要查看的路径
//输出:要保存的文件
////////////////////////////////////////////////////////////////////////////////
procedure TFrmMain.SaveFormatDir(Dir: string);
var
  SaveFileName : string;
  IniFile : TIniFile;
begin
  //初始化保存对话框
  SDDir.FileName :='Result.txt';
  SDDir.InitialDir := ExeDir;
  if SDDir.Execute then
  begin
    //清空当前二叉树
    BinTreeClear;
    SaveFileName := SDDir.FileName;
    Dir := FormatDir(Dir);
    //添加一个头节点
    BinTree := BinTreeAdd(BinTreeRoot , Dir , ctLeft);
    //查找
    Search(Dir +'*.*', BinTree);
    //先序遍历二叉树
    BinTreePreOrder(BinTreeRoot, 0);
    //保存遍历结果
    SaveToFile(SaveFileName);
    //查看文件内容
    if MessageBox(Handle, '保存完毕.要查看文件的内容吗?','提示',MB_ICONQUESTION+
      MB_YESNO)=IDYES then
    begin
      ShellExecute(Handle,
      'open',
      PAnsiChar(SDDir.FileName),
      nil,
      nil,
      SW_SHOW);
    end;
    //保存当前的查看路径,以便下次运行程序时使用
    try
      SaveFileName := ExeDir;
      FormatDir(SaveFileName);
      SaveFileName := SaveFileName + 'Dir.Ini';
      IniFile:=TIniFile.Create(SaveFileName);
      IniFile.WriteString('PirorDir', 'Name', Dir);
    finally
      IniFile.Free;
    end;
  end;
end;

procedure TFrmMain.SBDirClick(Sender: TObject);
var
  s : string;
begin
  s := Edit1.Text;
  SelectDirectory(s,[sdAllowCreate, sdPerformCreate, sdPrompt],0);
  Edit1.Text:=s;
end;

procedure TFrmMain.FormCreate(Sender: TObject);
var
  IniFile: TIniFile;
  s : string;
begin
  ExeDir := ExtractFilePath(Application.ExeName);
  s := ExeDir;
  if s[Length(s)] <> '\' then
    s := s + '\';

  IniFile := TIniFile.Create(s + 'Dir.Ini');
  DirStr := IniFile.ReadString('PirorDir', 'Name', '');
  if DirStr='' then
    DirStr := s;
  Edit1.Text:=DirStr;

  BinTree :=  BinTreeInit;
end;

procedure TFrmMain.BtnLookClick(Sender: TObject);
var
  s : string;
begin
  ODDIr.Filter := '*.JPG;*.JPEG';
  if ODDir.Execute then
  begin
    //ODDIr.Filter := '*.JPG;*.JPEG';
    //ODDIr.Filter := '*.PAS;*.DPK;*.DPR';
    s := ODDIr.fileName;

    ShowMessage(S);
    ShellExecute(Handle,
      'open',
      PAnsiChar(s),
      nil,
      nil,
      SW_SHOW);
  end;
end;
////////////////////////////////////////////////////////////////////////////////
//在指定目录下查找所有文件,并加入到二叉树中.
//输入:指定目录,指定的二叉树
//输出:存在节点的二叉树
//在插入节点时,根据文件目录的特性,二叉树的左节点代表子文件或子目录,所有的右节点
//代表与父节点相同目录下的兄弟文件或兄弟目录.在插入时,如果是目录下查找到的第一个
//节点,就插入到左孩子,如果是查到的第二或第N个节点,比较后较大的节点放到右孩子处.
procedure TFrmMain.Search(Dir: string; aTree : PBinTree);
var
  sr: TSearchRec;
  FileAttrs , i: Integer;
  Dir1 : string;
  s : string;
begin
  //查找到的个数
  i := 0;
  FileAttrs :=  faDirectory ;

  if FindFirst(Dir, FileAttrs, sr) = 0 then
  begin
    repeat
      if (sr.Name<>'.') and (sr.Name<>'..') then
      begin
        //如果是目录,要在目录后加上\.
        if (sr.Attr and faDirectory ) = sr.Attr then
        begin
          Dir1 := Copy(Dir, 1, Length(Dir) - 3);
          Dir1 := Dir1 + sr.Name + '\*.*';

          s := sr.Name+'\'#9+DateTimeToStr(FileDateToDateTime(sr.Time));
;         //如果是第一个加为左孩子
          if i=0 then
            aTree := BinTreeAdd(aTree, s, ctLeft)
          //如果不是第一个,放在父节点的右孩子处
          else
            aTree := BinTreeAdd(GetHead(atree), s, ctRight);
          //查找下一级目录
          Search(Dir1, aTree);
        end
        else begin
          //如果是文件,同样处理
          if i=0 then
            aTree := BinTreeAdd(aTree, sr.Name+#9+DateTimeToStr(FileDateToDateTime(sr.Time)), ctLeft )
          else
            aTree := BinTreeAdd(GetHead(atree), sr.Name+#9+DateTimeToStr(FileDateToDateTime(sr.Time)), ctRight);
        end;
        i := i + 1;
      end;

    until FindNext(sr) <> 0;

    FindClose(sr);
  end;
end;

procedure TFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //释放空间
  BinTreeClear;
end;
////////////////////////////////////////////////////////////////////////////////
//格式化目录
function TFrmMain.FormatDir(Dir: string): string;
begin
  Result := Dir;
  if Dir[Length(Dir)]<>'\' then
    Result := Result + '\' ;
end;
////////////////////////////////////////////////////////////////////////////////
//保存文件.
procedure TFrmMain.SaveToFile(FileName:string);
var
  i : integer;
  SS : TStringList;
begin
  SS := TStringList.Create;
  for i:= 0 to High(BinTreeStrs)do
    SS.Add(BinTreeStrs[i]);
  SS.SaveToFile(FileName);
  SS.Free;
end;

end.