盒子论坛 v2.1

这是我自己以前写的一个copy文件夹的function:

TBrowseCallBackFunc = Function(var psFile:string) :integer;

function CopyDir(psSource, psDesti :string; pfCallBack:TBrowseCallBackFunc):boolean;
var tStack :TStringList;
  Status: Integer;
  SearchRec: TSearchRec;
  tsCurrent :string;
  tsDesti,tsTemp,tsTemp2 :string;
begin
  result := false;
  tStack := TStringList.Create;
  tStack.Add(psSource);
while tStack.Count >0 do
begin
    tsCurrent := tStack[tStack.Count -1];  //出栈
    tStack.Delete(tStack.Count -1);

    tsTemp := Copy(tsCurrent, length(psSource)+1, 255); //相对路径
    tsDesti := psDesti+iif(StrLeft(tsTemp,1)='\',','\')+ tsTemp;
    if not DirectoryExists(tsDesti) then
        CreateDir(tsDesti);

    tsTemp := tsCurrent + iif(strright(tsCurrent,1)='\',','\')+'*.*';
    Status := FindFirst(tsTemp, faAnyFile, SearchRec);

    while Status = 0 do
    begin
      if (SearchRec.Attr and faDirectory = faDirectory) then //directory
      begin
        if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
        begin
          tsTemp := tsCurrent+iif(strright(tsCurrent,1)='\',','\')+
                     SearchRec.Name;  //取得绝对路径
          tStack.Add(tsTemp);  //进栈
        end;
      end
     else  //file
      begin
         tsTemp := tsCurrent+iif(strright(tsCurrent,1)='\',','\')+
                     SearchRec.Name;
         tsTemp2 := tsDesti+iif(strright(tsDesti,1)='\',','\')+
                     SearchRec.Name;

          if @pfCallBack <> nil then
            pfCallBack(tsTemp);

          CopyFile(PChar(tsTemp), PChar(tsTemp2), LongBool(1));
      end;
      Status := FindNext(SearchRec);
    end;
  end;
   result := true;
end;

//pfCallBack是用来显示进度的回叫函数，如果不用传入nil就行。

----------------------------------------------
www.acreport.com

作者：

shaoyy (远洋)	★☆☆☆☆	-
	盒子活跃会员

2004/1/27 19:22:45

3楼：

呵呵，写以上函数时主要目的是为了验证一下N层目录树的遍历算法，不过我也不知道还有没有更简单的办法:)
----------------------------------------------
www.acreport.com

作者：

shaoyy (远洋)	★☆☆☆☆	-
	盒子活跃会员

2004/1/27 19:25:00

4楼：

对了，里面的iif函数的定义：

function iif(b: boolean; v1, v2: variant): variant;
begin
  if b then
    Result := v1
  else
    Result := v2;
end;
----------------------------------------------
www.acreport.com

信息

登陆以后才能回复