unitfilemove.pas

用于制作和整理（文件搜索方式）编程技术文档和各类源代码, 可以如编程工具一样分色显示程序(C++, Delphi , java, Vb, SQL ……)(用算法实现), 主要用于查找相应的类和函数

unit UnitFileMove;
{*******************************************************************}
{                                                                   }
{       Support: [e-mail]                                     }
{                                                                   }
{      finish 2005-12-14                                            }
{*******************************************************************}
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls,filectrl;

type
  TfileSearch = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    EdtFileName: TEdit;
    TreeView1: TTreeView;
    Label2: TLabel;
    Button2: TButton;
    Label3: TLabel;
    EdtToDir: TEdit;
    Label4: TLabel;
    lblSearchDir: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
     searchDir:string;
  procedure  seathfile(FromDir:string;ToDir:string;FileName:string;node:Ttreenode);

    { Private declarations }
  public
    { Public declarations }
  end;

var
  fileSearch: TfileSearch;
  count:integer;
implementation
 uses Ebookfrm;
{$R *.dfm}
Procedure FileCopy( Const sourcefilename, targetfilename: String );
Var
S, T: TFileStream;
Begin
try
  S := TFileStream.Create( sourcefilename, fmOpenRead );
  try
    T := TFileStream.Create( targetfilename,fmOpenWrite or fmCreate );
    try
      T.CopyFrom(S, S.Size ) ;

    finally
      T.Free;
    end;
  finally
    S.Free;
  end;
except

end;
End;
procedure tfileSearch.seathfile(FromDir:string;ToDir:string;FileName:string;node:Ttreenode);
var
  r:integer;
  f:tsearchrec;
  index:integer;
  temp,s:string;
  filetypelength:integer;
  FileType:string;
  Fstream :TFileStream ;
  dirNode: Ttreenode;
begin
    FileType:= ExtractFileExt(filename) ;
    fileTypeLength:=length(fileType);
    r:=findfirst(FromDir+'\'+fileName,faDirectory,f);
    while r=0 do
    begin
     //复制文件
      index:=1;
      s:=copy(f.Name,1,length(f.Name )-fileTypelength) ;

      temp:=s;
      //得到唯一名称!
      while fileexists(ToDir+'\'+s+fileType) do
      begin
       s:=temp+inttostr(index);
       inc(index);
      end;
      treeview1.Items.AddChild(node,s) ;
      filecopy(FromDir+'\'+F.Name ,ToDir+'\'+s+fileType);
      


      application.ProcessMessages ;

      inc(count);
      self.Label1.Caption :=inttostr(count);

      r:=findnext(f);
    end;
    //

    r:=findfirst(FromDir+'\*.*',faDirectory,f);

    while r=0 do
    begin
      if (f.Name <>'.') and (f.Name <>'..')and
           (f.Attr and faDirectory = faDirectory ) then   //是目录
      begin
          s:=f.Name ;
         //得到唯一名称!
        temp:=s;
        index:=1;
        while fileexists(ToDir+'\'+s+fileType) do
        begin
          s:=temp+inttostr(index);
          inc(index);
        end;

        //创建相应目录文件
        Fstream := TFileStream.Create(ToDir+'\'+s+fileType,fmOpenWrite or fmCreate );
        Fstream.Free ;

        //递归调用
        dirNode:=treeview1.Items.AddChild(node,s) ;
        seathfile(Fromdir+'\'+f.Name ,Todir,FileName,dirNode );

       // 删除多余的节点文件
       if ( not dirNode.HasChildren )  then
       begin
          deletefile(ToDir+'\'+s+fileType);
          treeview1.Items.Delete(dirNode);

       end;
      end;


      r:=findnext(f);
    end;
end;
procedure TfileSearch.Button1Click(Sender: TObject);
begin
   Treeview1.Items.Clear ;
  count:=0;
  if SelectDirectory('选择搜索目录 ...','',searchdir) then
  begin
     lblSearchDir.Caption := MinimizeName(
                             searchdir,lblsearchDir.Canvas ,lblsearchDir.Width );
     EdtToDir.Text :=EdtFileName.Text +'Ebook';
  end;

end;

procedure TfileSearch.Button2Click(Sender: TObject);
var toDir,filename:string;
begin
    filename:='*.'+trim(edtfilename.Text );
    Todir:=ExtractFilePath(searchdir)+ trim(EdtToDir.Text) ;

    if  (searchdir<>'') and (filename<>'') and (trim(EdtToDir.Text)<>'')then
    begin
      if not directoryexists(Todir) then
          mkdir(Todir);
        seathfile( searchdir,ToDir,filename,nil);
        self.TreeView1.SaveToFile(Todir+'\'+trim(EdtTodir.Text )+'.ebook');
        showmessage('完成创建!');
        mainfrm.open_dir(Todir+'\'+trim(EdtTodir.Text )+'.ebook');
        self.Close ;
    end
    else
    begin
       showmessage('不允许为空！');
    end;
end;

end.