跪求目录同步源码~

function FindDifferentFilesBetweenTwoDirectory(sFromDirectroyName,
  sToDirectroyName: string; DifferentFiles: TStrings): Boolean;
var
  hFindFile, toFindFile: Cardinal;
  t, tfile: string;
  sCurDir: string[255];
  FindFileData, ToFileData: WIN32_FIND_DATA;
  dtFindFile, dtToFindFile: TDateTime;
begin  toFindFile := INVALID_HANDLE_VALUE;
  //先保存当前目录  sCurDir := GetCurrentDir;  ChDir(sFromDirectroyName);  hFindFile := FindFirstFile('*.*', FindFileData);
  if hFindFile <> INVALID_HANDLE_VALUE then //如果找到了文件
  begin    //  if not DirectoryExists(sToDirectroyName) then
     //   ForceDirectories(sToDirectroyName); //目标目录不在就创建    repeat
      Application.ProcessMessages;
      tfile := FindFileData.cFileName;      if (tfile = '.') or (tfile = '..') then
        Continue;      if FindFileData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY then
        //如果文件是子目录
      begin
        t := sToDirectroyName + '\' + tfile;        // not DirectoryExists(t) then //子目录不在就创建
         //   ForceDirectories(t);        if sFromDirectroyName[Length(sFromDirectroyName)] <> '\' then
          FindDifferentFilesBetweenTwoDirectory(sFromDirectroyName + '\' +
            tfile, t, DifferentFiles)
        else
          FindDifferentFilesBetweenTwoDirectory(sFromDirectroyName + tfile,
            sToDirectroyName + tfile, DifferentFiles)
      end
      else //如果是文件,这里是核心
      begin
        t := sToDirectroyName + '\' + tFile;
        toFindFile := FindFirstFile(Pchar(t), ToFileData); //寻找目标文件
        if toFindFile <> INVALID_HANDLE_VALUE then //如果在就比较时间
        begin
          //方式:转化为系统日期与时间作比较新与旧,只有源文件是新的才复制
          if GetFileLastModifyTime(findFileData.ftLastWriteTime, dtFindfile)
            and GetFileLastModifyTime(toFileData.ftLastWriteTime, dttoFindfile)
            and (dtfindFile > dtToFindFile) then
            DifferentFiles.Add(GetCurrentDir + '\' + tFile);
        end
        else //如果目标目录没有该文件
          DifferentFiles.Add(GetCurrentDir + '\' + tFile);      end; //endif
      //repeat end
    until FindNextFile(hFindFile, FindFileData) = false;    windows.FindClose(hFindFile);
    windows.FindClose(ToFindFile);  end
  else //一个文件都没找到则
  begin
    ChDir(sCurDir);
    Result := false;
    exit;
  end;
  //回到原来的目录下
  ChDir(sCurDir);
  Result := True;
end;

以上函数有几个严重的问题需要解决,首先CD当前目录在UNC是不支持的,另外,在程序进程创建文件夹也是不允许(因为只读共享!),求高手帮忙看看!

以上函数有几个严重的问题需要解决,首先CD当前目录在UNC是不支持的,另外,在程序进程创建文件夹也是不允许(因为只读共享!),还有个最严重的问题是,在生成更新列表时会出错,本来是只添加文件,不知道怎么出的错竟也添加进了文件夹,求高手帮忙看看!

整个程序的方法就不对，如果你想变相支持unc，可以把共享目录映射为网络驱动器。
共享只读？！那你怎么同步呢？通常这种同步，都是把本地的文件同步到远程啊，如果是只读的话，即使发现了不对，也不能修改远程的文件啊。分分太少了啊，这种代码是偏门，需要有人有兴趣和动力去写的，够呛有现成的。

我先加分,你的问题说得好,只是我没说明清楚,不错,已有目录共享,我没有马上就同步了,因为我只要获取更新列表(而不是即时同步),只读,将更新列表是要放到服务器上,用WINRAR压缩所更新的文件成SFX(自解压),在通过远程批量执行以完成更新!这是我的一点想法!

看看下面搜索文件的方法, 可能对你有用
转载--超级猛料
--------------------------------------------
procedure findall(disk,path: String; var fileresult: Tstrings);
var
fpath: String;
fs: TsearchRec;
begin
fpath:=disk+path+'\*.*';
if findfirst(fpath,faAnyFile,fs)=0 then
begin
if (fs.Name<>'.')and(fs.Name<>'..') then
if (fs.Attr and faDirectory)=faDirectory then
findall(disk,path+'\'+fs.Name,fileresult)
else
fileresult.add(disk+strpas(strupper(pchar(path)))+'\'+strpas(
strupper(pchar(fs.Name)))+'('+inttostr(fs.Size)+')');
while findnext(fs)=0 do
begin
if (fs.Name<>'.')and(fs.Name<>'..') then
if (fs.Attr and faDirectory)=faDirectory then
findall(disk,path+'\'+fs.Name,fileresult)
else
fileresult.add(disk+strpas(strupper(pchar(path)))+'\'+str
pas(strupper(pchar(fs.Name)))+'('+inttostr(fs.Size)+')');
end;
end;
findclose(fs);
end; procedure DoSearchFile(Path: string; Files: TStrings = nil);
var
  Info: TSearchRec;  procedure ProcessAFile(FileName: string);
  begin
    if Assigned(PnlPanel) then
      PnlPanel.Caption := FileName;
    Label2.Caption := FileName;
  end;  function IsDir: Boolean;
  begin
    with Info do
      Result := (Name <> '.') and (Name <> '..') and ((attr and fadirectory) = fadirectory);
  end;  function IsFile: Boolean;
  begin
    Result := not ((Info.Attr and faDirectory) = faDirectory);
  end;begin
  Path := IncludeTrailingBackslash(Path);
  try
    if FindFirst(Path + '*.*', faAnyFile, Info) = 0 then
      if IsFile then
        ProcessAFile(Path + Info.Name)
      else if IsDir then DoSearchFile(Path + Info.Name);
    while FindNext(Info) = 0 do
    begin
      if IsDir then
        DoSearchFile(Path + Info.Name)
      else if IsFile then
        ProcessAFile(Path + Info.Name);
      Application.ProcessMessages;
      if QuitFlag then Break;
      Sleep(100);
    end;
  finally
    FindClose(Info);
  end;
end;

网上是有些代码,不过没法满足的我的要求! 另外说得同步软件.国内国外都有很好的软件,像国外的Beyond Compare 2就有很强的对比同步功能,可以我就是不喜欢,因为我只要对比结果,同步并不是现在的关键问题!
不如换个说法,有谁帮我把上面的代码做点优化或排错,因为速度一般般,另外有个致命BUG,我只需提取文件,它却有时加进文件夹,另外,对比较深层的文件夹,会出现没比较的情况!

呕血奉献，抛砖引玉！！！（c:\windows目录搜索11480个文件，用时2.073秒，一个文件也不多也不少哈）
支持unc，如果有用户名及密码，请在查询前执行net use命令，参看net use /?及delphi执行dos命令的方法。
TSearchRec，这里面有文件及目录的各种属性，可以用于比对！！！function TForm1.IsValidDir(SearchRec:TSearchRec):Boolean;
begin
        //16为目录，与操作为16表示为一个目录
        Result:=((SearchRec.Attr and 16)=16)
                and (SearchRec.Name<>'.') and (SearchRec.Name<>'..');
end;function TForm1.SearchFile(MainPath:string;
        var FoundResult:TStrings):Boolean;
var
        i:integer;
        Found:Boolean;
        subdir1:TStrings;
        searchRec:TsearchRec;
        HasSubDir:Boolean;
begin
        found:=false;
        subdir1:=TStringList.Create;//字符串列表必须动态生成
        //找出所有下级子目录。
        HasSubDir := False;        if (FindFirst(MainPath+'*.*', 4095, SearchRec)=0) then //4095指搜索全部
        begin
                if IsValidDir(SearchRec) then
                begin
                        HasSubDir := True;
                        subdir1.Add(SearchRec.Name);
                end;
                while (FindNext(SearchRec) = 0) do
                begin
                        if IsValidDir(SearchRec) then
                        begin
                                HasSubDir := True;
                                subdir1.Add(SearchRec.Name);
                        end;
                end;
        end;
        FindClose(SearchRec);        if (FindFirst(MainPath+'*.*',faAnyFile,SearchRec)=0) then
        begin
                found := True;
                if (Not IsValidDir(SearchRec)) and (SearchRec.Name <> '.') and (SearchRec.Name <> '..')then
                        FoundResult.Add(MainPath+SearchRec.Name);
                while (FindNext(SearchRec)=0) do
                begin
                        if (Not IsValidDir(SearchRec)) and (SearchRec.Name <> '.') and (SearchRec.Name <> '..')then
                                FoundResult.Add(MainPath+SearchRec.Name);
                end;
        end;
        FindClose(SearchRec);        //这是递归部分，查找各子目录。
        for i:=0 to subdir1.Count-1 do
                found:=Searchfile(MainPath+subdir1.Strings[i]+
                        '\',foundresult) or found;
        //资源释放并返回结果。
        subdir1.Free;
        result:=found;
end;procedure TForm1.Button5Click(Sender: TObject);
var
        mStrList: TStrings;
        mDate: TDateTime;
begin
        mStrList := TStringList.Create;
        mDate:=Now();
        SearchFile('c:\windows\',mStrList);
        Memo1.Lines.Clear;
        Memo1.Lines.AddStrings(mStrList);
        ShowMessage(Format('%d,%d',
                [DateTimeToTimeStamp(now).Time-DateTimeToTimeStamp(mdate).Time
                ,mStrList.Count]));
end;着实花了我一番心血，怎么感谢我哩，呵呵。

去源码天空找找：
http://www.codesky.net/showcode.asp?uid=36531

TO: erhan(二憨)
   谢谢你的辛苦劳动!
But:
   可是,上面的代码,只是找出某一目录下的所有文件夹与文件,存贮在字符串列表里,可是怎么没有对比的代码,
两个列表要如何对比,难道还要再生成一一对应的修改时间列表,然后一一对比,这样效率会优吗?只是两个列表由一列表找出另一列表是否存在相同文件就是个很麻烦的事!希望你可以再教教我!
   我再把的思路说一下!
现在可以不先考虑UNC的支持,我们只要找出两个目录之间需要同步的文件列表!
条件是两个目录都是只读的!不可以生成目录,像我提供的代码就有这个BUG!如果不生成目录,会产生意想的后果,而且基本上很难调试(对我而言),我所知道的BUG,竟然会经常多出一些子目录,而且这些子目录也没有比较!

现在,我公布真正想要实现的目的! 我之所以不想马上同步(一边检索一边复制)的原因,是我想通过WINRAR将需要同步打包成一个自解压文件EXE,然后执行这个程序以完成同步,而且另一些电脑就不用再去检查需要同步什么内容,只是不管37 21就执行.这样肯定比每一台电脑都检查一遍来的快,而且经过压缩的文件,传输的效率会高多了! 我一直再找能实现这一功能,可惜没找着! 我想我的想法应该是很有创意的!

写了个完整版的带比对的代码，只在原来的代码上加了些代码。还是可以支持unc！
function TForm1.CompareFile(SearchRec:TSearchRec;CompPath:string):integer;
var
        mResult: integer; //0:文件一致；1:目标目录无此文件;2：文件不一致
        CompRec:TsearchRec;
begin
        mResult := 1;
        if (FindFirst(CompPath+SearchRec.Name,faAnyFile,CompRec)=0) then
        begin
                //可以在此增加其他判断条件
                if (SearchRec.Size =CompRec.Size) then
                        mResult := 0
                else
                        mResult := 2;
        end;
        Result := mResult;
end;function TForm1.IsValidDir(SearchRec:TSearchRec):Boolean;
begin
        //16为目录，与操作为16表示为一个目录
        Result:=((SearchRec.Attr and 16)=16)
                and (SearchRec.Name<>'.') and (SearchRec.Name<>'..');
end;function TForm1.SearchFile(MainPath:string;CompPath:string;
        var FoundResult:TStrings):Boolean;
var
        i:integer;
        Found:Boolean;
        subdir1:TStrings;
        searchRec:TsearchRec;
        HasSubDir:Boolean;
begin
        found:=false;
        subdir1:=TStringList.Create;//字符串列表必须动态生成
        //找出所有下级子目录。
        HasSubDir := False;        if (FindFirst(MainPath+'*.*', 4095, SearchRec)=0) then //4095指搜索全部
        begin
                if IsValidDir(SearchRec) then
                begin
                        HasSubDir := True;
                        subdir1.Add(SearchRec.Name);
                end;
                while (FindNext(SearchRec) = 0) do
                begin
                        if IsValidDir(SearchRec) then
                        begin
                                HasSubDir := True;
                                subdir1.Add(SearchRec.Name);
                        end;
                end;
        end;
        FindClose(SearchRec);        if (FindFirst(MainPath+'*.*',faAnyFile,SearchRec)=0) then
        begin
                found := True;
                if (Not IsValidDir(SearchRec)) and (SearchRec.Name <> '.') and (SearchRec.Name <> '..')then
                begin
                        i:=CompareFile(SearchRec,CompPath);
                        if i=1 then
                                FoundResult.Add(CompPath+SearchRec.Name+';无此文件')
                        else if i=2 then
                                FoundResult.Add(CompPath+SearchRec.Name+';文件不一致')
                        else
                                FoundResult.Add(CompPath+SearchRec.Name+';文件一致')
                end;
                while (FindNext(SearchRec)=0) do
                begin
                        if (Not IsValidDir(SearchRec)) and (SearchRec.Name <> '.') and (SearchRec.Name <> '..')then
                        begin
                                i:=CompareFile(SearchRec,CompPath);
                                if i=1 then
                                        FoundResult.Add(CompPath+SearchRec.Name+';无此文件')
                                else if i=2 then
                                        FoundResult.Add(CompPath+SearchRec.Name+';文件不一致')
                                else
                                        FoundResult.Add(CompPath+SearchRec.Name+';文件一致')
                        end;
                end;
        end;
        FindClose(SearchRec);        //这是递归部分，查找各子目录。
        for i:=0 to subdir1.Count-1 do
                found:=Searchfile(MainPath+subdir1.Strings[i]+
                        '\',CompPath+subdir1.Strings[i]+'\',foundresult) or found;
        //资源释放并返回结果。
        subdir1.Free;
        result:=found;
end;procedure TForm1.Button5Click(Sender: TObject);
var
        mStrList: TStrings;
        mDate: TDateTime;
begin
        mStrList := TStringList.Create;
        mDate:=Now();
        SearchFile('c:\gtja\','d:\gtja\',mStrList);
        Memo1.Lines.Clear;
        Memo1.Lines.AddStrings(mStrList);
        ShowMessage(Format('%d,%d',
                [DateTimeToTimeStamp(now).Time-DateTimeToTimeStamp(mdate).Time
                ,mStrList.Count]));
end;

TO erhan(二憨):谢谢你!你给的方法确实可行!结帖了!请查收积分!

调试易

跪求目录同步源码~

解决方案 »