有人写过这样的函数(文件拷贝)吗？可否共享？

Question

function CopyMyFile(SoureFileName,DestFileName:string;Overwrite:Boolean):Boolean; 把文件SoureFileName拷贝到DestFileName（请看下去）， DestFileName是一个正确的文件名，如：c:\a\b\c\d\e\f.gif
 但不能确定目录a\b\c\d\e\是否存在。
    我要的功能是：如果目录a\b\c\d\e\任何一级不存在都自动创建它，再把文件拷贝过去，如果目录存在，当然直接拷过去就行了。
    刚学DELPHI，对字符串操作还不熟。希望写过这个函数的能共享一下。谢谢。
100分或更多分相送。(好久没上来了，还有 可用分：1495 )

Answer 1

删除目录：function DelDirectory(const Source:string): boolean;
var
  fo: TSHFILEOPSTRUCT;
begin
  FillChar(fo, SizeOf(fo), 0);
  with fo do
  begin
    Wnd := 0;
    wFunc := FO_DELETE;
    pFrom := PChar(source+#0);
    pTo := #0#0;
    fFlags := FOF_NOCONFIRMATION+FOF_SILENT;
  end;
  Result := (SHFileOperation(fo) = 0);
end;
复制目录：
///复制Source整个目录到DEST目录，如果Dest不存在，自动建立，如果DEST存在，那么Source将作为Dest的子目录！
//例如如果要复制E:\Temp整个目录到E:\那么代码为： copydirectory('e:\temp','e:\');
///如果要复制E:\Temp到E:\Test目录下面，那么代码为：CopyDirecotry('E:\Temp','E:\TEST');
function CopyDirectory(const Source, Dest: string): boolean;
var
  fo: TSHFILEOPSTRUCT;
begin
  FillChar(fo, SizeOf(fo), 0);
  with fo do
  begin
    Wnd := 0;
    wFunc := FO_COPY;
    pFrom := PChar(source+#0);
    pTo := PChar(Dest+#0);
    fFlags := FOF_NOCONFIRMATION+FOF_NOCONFIRMMKDIR    ;
  end;
  Result := (SHFileOperation(fo) = 0);
end;重新命名：
用MoveFile()或者下面的函数也可以。
RenameFile('c:\a','c:\b')好想也可以？Win2K。
//RenDirectory('d:\wt2','d:\bcde');
function RenDirectory(const OldName,NewName:string): boolean;
var
  fo: TSHFILEOPSTRUCT;
begin
  FillChar(fo, SizeOf(fo), 0);
  with fo do
  begin
    Wnd := 0;
    wFunc := FO_RENAME;
    pFrom := PChar(OldName+#0);
    pTo := pchar(NewName+#0);
    fFlags := FOF_NOCONFIRMATION+FOF_SILENT;
  end;
  Result := (SHFileOperation(fo) = 0);
end;
//Copy 多个文件的处理：
function CopyFiles(const Source,Dest: string): boolean;
var
  fo: TSHFILEOPSTRUCT;
begin
  FillChar(fo, SizeOf(fo), 0);
  with fo do
  begin
    Wnd := 0;
    wFunc := FO_COPY;
    pFrom := @source[1];
    pTo :=pchar(dest);
    fFlags := FOF_NOCONFIRMATION+FOF_NOCONFIRMMKDIR    ;
  end;
  Result := (SHFileOperation(fo) = 0);
end;procedure TForm1.Button1Click(Sender: TObject);
var
  str:string;
  i:integer;
begin
  if opendialog1.Execute then
  begin
    for i:=0 to OpenDialog1.Files.Count-1 do
     str:=str+OpenDialog1.Files.strings[i]+#0;
    showmessage(str);
    str:=str+#0;
    CopyFiles(str,'d:\temp');
  end;
end;

Answer 2

谢谢，
但上面的不合规格！上面那个我已经在CSDN和delphibbs找到了。但不行。因因为：SHFileOperation听说只能在2000下用。

Answer 3

创建目录
procedure TForm1.Button1Click(Sender: TObject);var
  Dir: string;
begin  Dir := 'C:\APPS\SALES\LOCAL';  if ForceDirectories(Dir) then
    Label1.Caption := Dir + ' was created'end;

Answer 4

你在丰富一下：
procedure myCopyFile(src,dst:TFilename);
var
  dir:string;
begin
  dir:=extractFileDir(dst);
  forceDirectories(dir);
  copyFile(pchar(src),pchar(dst),true);
end;

Answer 5

哈哈。Good!一个ForceDirectories就可以搞定了。
____________________________________________________
Creates a new directory, also creating parents as needed.UnitCategoryfile management routinesfunction ForceDirectories(const Dir: string): Boolean;DescriptionForceDirectories creates a new directory as specified in Dir, which must be a fully-qualified path name. If the directories given in the path do not yet exist, ForceDirectories attempts to create them.ForceDirectories returns True if it successfully creates all necessary directories, False if it could not create a needed directory.Important
Do not call ForceDirectories with an empty string. Doing so causes ForceDirectories to raise an exception.

Answer 6

用递归可以解决
代吗如下：
procedure TForm1.autocreatepath(s: string);
var
  I : Integer ;
  tmpStr : String ;
begin
  tmpStr := '';
  if not DirectoryExists(s) then
  begin
     if not CreateDir(s) then
     begin
        for I := length(s) downto 1 do
        begin
           if s[i] = '\' then
           begin
             tmpstr := copy(s,1,i-1);
             break ;
           end ;
        end ;     end ;
     if tmpstr <> '' then
     autocreatepath(tmpstr);
     autocreatepath(s);
  end ;end;
我没有delphi没有编译，你试验一下

Answer 7

function Tform5.DoRemoveDir(sDirName:String):Boolean;
var
  hFindFile:Cardinal;
  tfile:String;
  sCurDir:String;
  bEmptyDir:Boolean;
  FindFileData:WIN32_FIND_DATA;
begin
  bEmptyDir:=True;
  sCurDir:=GetCurrentDir;
  SetLength(sCurDir,Length(sCurDir));
  ChDir(sDirName);
  hFindFile:=FindFirstFile('*.*',FindFileData);
  if hFindFile<>INVALID_HANDLE_VALUE then
  begin
      repeat
            tfile:=FindFileData.cFileName;
            if (tfile='.') or (tfile='..') then
            begin
               bEmptyDir:=bEmptyDir and True;
               Continue;
            end;
            bEmptyDir:=False;
            if FindFileData.dwFileAttributes=
            FILE_ATTRIBUTE_DIRECTORY then
            begin
                 if sDirName[Length(sDirName)]<>'\' then
                    DoRemoveDir(sDirName+'\'+tfile)
                 else
                    DoRemoveDir(sDirName+tfile);
                 if not RemoveDirectory(PChar(tfile)) then
                    result:=false
                 else
                    result:=true;
            end
            else
            begin
                 if not DeleteFile(PChar(tfile)) then
                    result:=false
                 else
                    result:=true;
            end;
      until FindNextFile(hFindFile,FindFileData)=false;
      Windows.FindClose(hFindFile);
  end
  else
  begin
      ChDir(sCurDir);
      result:=false;
      exit;
  end;
  if bEmptyDir then
  begin
      ChDir('..');
      RemoveDirectory(PChar(sDirName));
  end;
  ChDir(sCurDir);
  result:=true;
end;function Tform5.DeleteDir(sDirName:String):Boolean;
begin
  if Length(sDirName)<=0 then
     exit;
  Result:=DoRemoveDir(sDirName) and RemoveDir(sDirName);
end;