怎么样移动文件夹???(30分)

  • 主题发起人 主题发起人 cansim
  • 开始时间 开始时间
C

cansim

Unregistered / Unconfirmed
GUEST, unregistred user!
现在有在同一目录下的文件夹,image和record
image里面又有很多文件夹
如何将image里面的文件夹移到record里面呢??
请给点代码,谢谢!没有分了不好意思
 
http://www.gislab.ecnu.edu.cn/delphibbs/DispQ.asp?LID=119086
http://www.gislab.ecnu.edu.cn/delphibbs/DispQ.asp?LID=92662
http://www.gislab.ecnu.edu.cn/delphibbs/DispQ.asp?LID=144910


 
兄弟,全都打不开啊!是不是不让邮电网访问??
 
SHFileOperation
 
function MoveDirectory(AToDir, AFromDir: string;
AHandle: THandle): Boolean;
var
sh: TSHFILEOPSTRUCT;
cFrom, cTo: array[0..128] of Char;
begin

FillChar(sh, Sizeof(sh), #0);

if not DirectoryExists(AFromDir) then

begin

Result := False;
Exit;
end;


FillChar(cFrom, Sizeof(cFrom), #0);
FillChar(cTo, Sizeof(cTo), #0);
StrPCopy(cFrom, AFromDir);
StrPCopy(cTo, AToDir);

sh.Wnd := AHandle;
sh.pFrom := @cFrom;
//源路径
sh.pTo := @cTo;
//目标路径
sh.lpszProgressTitle := '正在拷贝数据文件...';
//显示进度窗口的Caption
sh.wFunc := FO_MOVE;
//执行Move操作
sh.fAnyOperationsAborted := False;
//遇到任何错误停止
sh.hNameMappings := nil;
//不使用Map文件
sh.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_MULTIDESTFILES or
FOF_NOCONFIRMMKDIR;
//允许撤消,不出现确定窗口,需要创建新目录时不提示

if ShFileOperation(sh) = 0 then

Result := True;
end;


如果是Copy,只要将sh.wFunc := FO_MOVE改成sh.wFunc := FO_COPY就ok
 
给你三个函数:拷贝目录,删除目录,移动目录:
需要引用 ShellApi 单元
---- 1、拷贝目录

---- 为了能拷贝目录下带有子目录的情况,先定义一个辅助的拷贝函数,它是递归执行的,直到把目录下的所有文件和子目录都拷贝完。

---- 1.1拷贝目录的递归辅助函数:DoCopyDir

functiondo
CopyDir(sDirName:String;
sToDirName:String):Boolean;
var
hFindFile:Cardinal;
t,tfile:String;
sCurDir:String[255];
FindFileData:WIN32_FIND_DATA;
begin

//先保存当前目录
sCurDir:=GetCurrentDir;
ChDir(sDirName);
hFindFile:=FindFirstFile('*.*',FindFileData);
if hFindFile< >INVALID_HANDLE_VALUE then

begin

if not DirectoryExists(sToDirName) then

ForceDirectories(sToDirName);
repeat
tfile:=FindFileData.cFileName;
if (tfile='.') or (tfile='..') then

Continue;
if FindFileData.dwFileAttributes=
FILE_ATTRIBUTE_DIRECTORY then

begin

t:=sToDirName+'/'+tfile;
if not DirectoryExists(t) then

ForceDirectories(t);
if sDirName[Length(sDirName)]< >'/' then

do
CopyDir(sDirName+'/'+tfile,t)
else

do
CopyDir(sDirName+tfile,sToDirName+tfile);
end
else

begin

t:=sToDirName+'/'+tFile;
CopyFile(PChar(tfile),PChar(t),True);
end;

until FindNextFile(hFindFile,FindFileData)=false;
FindClose(hFindFile);
end
else

begin

ChDir(sCurDir);
result:=false;
exit;
end;

//回到原来的目录下
ChDir(sCurDir);
result:=true;
end;


---- 1.2拷贝目录的函数:CopyDir

function CopyDir(sDirName:String;
sToDirName:string):Boolean;
begin

if Length(sDirName)< =0 then

exit;
//拷贝...
Result:=DoCopyDir(sDirName,sToDirName);
end;


---- 2、删除目录

---- 删除目录与拷贝目录很类似,但为了能删除位于根目录下的一个空目录,需要在辅助函数中设置一个标志变量,即:如果删除的是空目录,则置bEmptyDir为True,这一句已经用深色框表示了。

---- 2.1删除目录的递归辅助函数:DoRemoveDir

functiondo
RemoveDir(sDirName:String):Boolean;
var
hFindFile:Cardinal;
tfile:String;
sCurDir:String;
bEmptyDir:Boolean;
FindFileData:WIN32_FIND_DATA;
begin

//如果删除的是空目录,则置bEmptyDir为True
//初始时,bEmptyDir为True
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
bEmptyDir:=False;
if FindFileData.dwFileAttributes=
FILE_ATTRIBUTE_DIRECTORY then

begin

if sDirName[Length(sDirName)]< >'/' then

do
RemoveDir(sDirName+'/'+tfile)
else

do
RemoveDir(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;
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;


---- 2.2删除目录的函数:DeleteDir

function DeleteDir(sDirName:String):Boolean;
begin

if Length(sDirName)< =0 then

exit;
//删除...
Result:=DoRemoveDir(sDirName) and RemoveDir(sDirName);
end;


---- 3、移动目录

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

function MoveDir(sDirName:String;
sToDirName:string):Boolean;
begin

if CopyDir(sDirName,sToDirName) then

if RemoveDir(sDirName) then

result:=True
else

result:=false;
end;

 
给你一个函数就OK
Function TDm.RemoveFile(const sName, dName: string): Boolean;
var
sOld, sObj: AnsiString;
lpFileOp: TSHFileOpStruct;
begin

Sold := PChar(sName) + #0#0;
sObj := PChar(dName) + #0#0;
with lpFileOpdo

begin

Wnd := Application.Handle;
wFunc := FO_MOVE;
pFrom := PChar(sold);
pTo := PChar(sObj);
fFlags := FOF_ALLOWUNDO;
hNameMappings := nil;
lpszProgressTitle := nil;
fAnyOperationsAborted := True;
end;

Result := SHFileOperation(lpFileOp) = 0;
end;

 
多人接受答案了。
 

Similar threads

后退
顶部