谁来帮我写个新建N个文件夹的函数

[LWWL]

我想把a.txt 复制到 c:\a\b\c\d\f\a.txt
但是 我c:\ 没有a目录 所以其他的也不会有

delphi这个函数 搞不定 只能1层1层的建
mkDir(c:\a\b\c\d\f\')

谁写个函数 mkDirs(str:string):integer; 运行后建出所有目录

[postren]

写个函数很简单吧

[postren]

//str := 'C:\a\b\c\d\'
//若最后有\则创建最后一个文件夹，如果没有\则最后一个不是文件夹，不创建
function MakeDir(str: string): Boolean;
var
iPos: Integer;
tmpDir: string;
DiskStr: string;
begin
Result := False;
iPos := Pos('\', str);
DiskStr := Copy(str, 1, iPos);
str := Copy(str, iPos + 1, MaxInt);
iPos := Pos('\', str);

try
while iPos > 0 do
begin
tmpDir := Copy(str, 1, iPos);
DiskStr := DiskStr + tmpDir;
MkDir(DiskStr);
str := Copy(str, iPos + 1, MaxInt);
iPos := Pos('\', str);
end;
Result := True;
except
Result := False;
end;
end;

[DURON800]

我这里也有

[DURON800]

---- 3、移动目录

---- 有了拷贝目录和删除目录的函数，移动目录就变得很简单，只需顺序调用前两个函数即
可：

function MoveDir(sDirName:String;
sToDirName:string):Boolean;
begin
if CopyDir(sDirName,sToDirName) then
if RemoveDir(sDirName) then
result:=True
else
result:=false;
end;

///////////////////////////////////////////////
procedure TForm1.Button2Click(Sender: TObject);
var
OpStruc: TSHFileOpStruct;
frombuf, tobuf: Array [0..128] of Char;
Begin
FillChar( frombuf, Sizeof(frombuf), 0 );
FillChar( tobuf, Sizeof(tobuf), 0 );
StrPCopy( frombuf, 'd:\brief\*.*' );
StrPCopy( tobuf, 'd:\temp\brief' );
With OpStruc DO Begin
Wnd:= Handle;
wFunc:= FO_COPY;
pFrom:= @frombuf;
pTo:=@tobuf;
fFlags:= FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION;
fAnyOperationsAborted:= False;
hNameMappings:= Nil;
lpszProgressTitle:= Nil;

end;
ShFileOperation( OpStruc );
end;

[DURON800]

不想写了，参考着抄吧。

[quicksand201]

这个太简单了点
ForceDirectories('c:\a\b\c\d\f\');
搞定

[postren]

楼上的quicksand201(流沙)，LZ说是让自己写，没说让用现成的
嘿嘿

[LWWL]

postren(小虫)
你的函数不行 mkdir('d:\a\') <>mkdir('d:\a')

[postren]

postren(小虫)
你的函数不行 mkdir('d:\a\') <>mkdir('d:\a')

//str := 'C:\a\b\c\d\'
//若最后有\则创建最后一个文件夹，如果没有\则最后一个不是文件夹，不创建

呵呵，我注释得很清楚了，如果字符串结尾不是\，则不创建，避免创建文件夹错误