求助: 类似 deltree xcopy 的函数(100分)

  • 主题发起人 李宏光
  • 开始时间

李宏光

Unregistered / Unconfirmed
GUEST, unregistred user!
现谢了
那位大侠手头有类似do
s 的 deltree, xcopy的函数,给老第一用
 
D

dwwang

Unregistered / Unconfirmed
GUEST, unregistred user!
这是一个Deltree的过程,测试过,可以正常工作:
procedure deleteAll(DirName:string);
var
DirInfo: TSearchRec;
r : Integer;
begin

r := FindFirst(DirName+'/*.*', FaAnyfile, DirInfo);
while r = 0do

begin

if ((DirInfo.Attr and FaDirectory) = FaDirectory) and (DirInfo.Name<>'.')
and (DirInfo.Name<>'..')then

deleteAll(DirName + '/' + DirInfo.Name);
if ((DirInfo.Attr and FaDirectory <> FaDirectory) and
(DirInfo.Attr and FaVolumeId <> FaVolumeID)) then

if DeleteFile(pChar(DirName+'/' + DirInfo.Name)) = false then

ShowMessage('Unable to delete :'+DirName + '/' + DirInfo.Name);
r := FindNext(DirInfo);
end;

SysUtils.FindClose(DirInfo);
if RemoveDirectory(pchar(DirName)) = false then

ShowMessage('Unable to delete direcotry : '+DirName);
end;
 
3

3h

Unregistered / Unconfirmed
GUEST, unregistred user!
下面这个是我在程序中用的实例,在D3中肯定没问题,而且可根据fFlags的值
决定是不是将文件移到回收站(是0时不移),还能同时删除多个文件或目录,
不过必须用 #0 将这些列表隔开,最后以#0#0结尾,用的是WINAPI函数SHFileOperation(). NAMELIST就是文件名。
将 wFunc := FO_DELETE;
改为 FO_COPY可实现XCOPY的功能。

var
lpFileOp: TSHFileOpStruct;
begin
with lpFileOpdo
begin
Wnd := Self.Handle;
wFunc := FO_DELETE;
pFrom := pchar(NameList + #0);
pTo := nil;
fFlags := FOF_ALLOWUNDO;
hNameMappings := nil;
lpszProgressTitle := nil;
fAnyOperationsAborted := True;
end;

if SHFileOperation(lpFileOp) <> 0 then
ShowMessage('删除失败,请查实。');
 

李宏光

Unregistered / Unconfirmed
GUEST, unregistred user!
非常谢谢,
我觉得 dwwang先生的程序不会有问题,
3h先生的答案,很有特点,我试了一下,有下面的错误提示:
[Error] Unit2.pas(197): Undeclared identifier: 'TSHFileOpStruct'
不知3h先生能否给解释一下,最好给举个例子,特别是对应于:
"xcopy" 的情况,我用的是delphi4.0
 
S

SeaSky

Unregistered / Unconfirmed
GUEST, unregistred user!
上面的用法太麻烦,最简单的办法:
使用Win32 API函数
ShFileOperation;
(文件操作函数)
具体用法参见Win32 API
实例如下
Uses ShellAPI
function Win_XCOPY(fFROM,fTO:String):boolean;
var FData : TShFileOpStruct;
begin
Fdata.pFrom := PChar(fFrom);
//设立数据源路径和文件、目录名,支持(?, *通配符)
fdata.pTo := PChar(fTo);
//设立目标路径
fdata.wFunc := FO_COPY ;
//设立操作方式
//FO_COPY 拷贝操作 相当于 XCOPY
//FO_MOVE 移动操作 相当于 MOVE
//FO_DELETE 删除操作 相当于 DELTREE
FData.Wnd := self.Handle ;
fData.lpszProgressTitle := 'Wait';
//设立提示窗标题
fData.fFlags := FOF_ALLOWUNDO OR FOF_NOCONFIRMMKDIR;
//设定操作选项
result:=ShFileOperation( FData ) = 0 ;
end;

 

李宏光

Unregistered / Unconfirmed
GUEST, unregistred user!
seasky先生:
手头没太多的资料,不好意思也得再麻烦,能否解释一下
对 // FO_DELETE 删除操作 相当于 DELTREE ,如何设定fFROM,fTO
此句 DELTREE FData.Wnd := self.Handle 有
Undeclared identifier: 'self' 的错误
 
S

SeaSky

Unregistered / Unconfirmed
GUEST, unregistred user!
不好意思忘记改Handle了
应该是Application.Handle,
做 FO_DELETE 操作时
fFrom是被删除目标的路径,
fTO参数被忽略, 你可以随便赋一个值,
 
H

huizhang

Unregistered / Unconfirmed
GUEST, unregistred user!
李宏光,
你的问题都提的很有水平, 我喜欢你的问题! 不过此问题上面三位大虾的答案都可行,
我就提一点评语吧!
dwwang 的做法是通过 Windows kernel32.dll 的 DeleteFile 函数的调用实现的,
使用的是 windows 底层的函数, 虽然编程序麻烦一点, 但是很有特色;
hhh 的做法较简单, 使用的是 ShellApi 的文件管理功能实现的, 运行时与你使用
系统的删除文件一样, 你没试通是因为没有 uses ShellApi;
此外他那段代码必须
放在你的 Form 下的某一个事件中才能运行, 因为那个 Self 是指一个 form;
SeaSky 的东西与 hhh 是一码事, 只不过是单独地做成了一个函数使用, 不过应该
将其中 fData.Wnd := self.handle 改成 Application.handle, 或者再加一个
参数来传递 Form.handle;
至于那个fFrom,fTo 参数是两个字符串用来描述从目录Copy到目标目录, 作 DelTree 时 fTo 为空.
字符即可
 

李宏光

Unregistered / Unconfirmed
GUEST, unregistred user!
FData.Wnd := self.Handle 改为
FData.Wnd := Application.Handle 后 仍然此句不通
大概是应该放在一个事件过程中,可做成函数用起来更方便,为何不行?
看到huizhang先生的提示想起一件事,也是困扰了我好长时间,
在一个事件过程中,调用一个自编的过程,自编的过程中只要用到
窗体的控件,就不灵,没办法,很多相似的东西都的多分开重复写,
看到大侠们干的东西,看看人家的得分,心中凄凉的出现了
"既生瑜,何生亮" 的感觉, "咳,穷人啊 !"

 
D

dwwang

Unregistered / Unconfirmed
GUEST, unregistred user!
没必要这么悲观吧!
不过你所谓的"自编过程" 恐怕一定是如同:
procedure myprocedure(...);
的过程,当然不能用form中的控件了,办法只有两个:
1.如果该过程定义在你的Form中,则把它定义为:
procedure TMyForm.MyProcedure(...);
就可以了,也就是说定义为窗口的成员.
2.如果是通用过程,定义在另一个unit中,
就把窗口的实例作为参数传给这个procedure.
 
A

Another_eYes

Unregistered / Unconfirmed
GUEST, unregistred user!
在单独的过程或函数中完全可以调用form的控件
只需加上 with form1do
或者在每个控件前面加上form1. (form1为一个全局变量)如form1.label1.caption等
其实form也是一个类的实例, 要在类外调用类中的东西当然需要指定类实例变量
名. 您说可对?
 

李宏光

Unregistered / Unconfirmed
GUEST, unregistred user!
我试过,Another_eYes先生说的对,(不知咋搞的,以前试为何不行)
仍希望大侠们看看,我按dwwang先生的意思做的为何不灵
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics,
Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
// procedure TForm1.mypro ? 加也不行,不加也不行
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure form1.mypro ;
begin
form1.edit1.text:='123456';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
mypro;
// 调用过程
end;

end.
 
C

CJ

Unregistered / Unconfirmed
GUEST, unregistred user!
出现什么错误?你的忘记了“;”不过程序里因该没有忘记
 
D

dwwang

Unregistered / Unconfirmed
GUEST, unregistred user!
上帝呀! 老兄,看我的例子是 -> procedure TMyForm.MyProcedure(...);
因此你的程序应该是:
procedure Tform1.mypro ;
^
begin
form1.edit1.text:='123456';
end;

差了一个'T',可就天壤之别了.
对象和类的区别还是要搞清楚哟!
另外,我的方法的好处是"逻辑的独立性"
这两项可是俺的老本行 :)
 
A

Another_eYes

Unregistered / Unconfirmed
GUEST, unregistred user!
type TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
// procedure TForm1.mypro ? 加也不行,不加也不行
问题就在这里, 改成:
procedure mypro;
准保没问题. 你定义procedure 的地方其实是TForm1的public部分,
定义的mypro只不过是TForm1类的一个全局方法, 当然前面不能再加TForm1. 啦
 
3

3h

Unregistered / Unconfirmed
GUEST, unregistred user!
哇塞,我开了个头,没想到大家都一起将小李往死里砍!哈哈哈。
本来我要来回一回,一会儿没上网,一上竟然大家回了几十次!快炸了我的信箱!
不过这也好,要回的大家都回了,免得我费事。哈哈哈。
这个
type TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
我也不懂的,什么意思,是将它定义成一个类?
我只懂一点皮毛,这个臭问题可能大家觉得可笑,但我实在不懂,请原谅。
还有,什么叫做"逻辑的独立性"?
TO huizhang,你的分析我很喜欢。:)
 
C

CJ

Unregistered / Unconfirmed
GUEST, unregistred user!
绝对没有问题!!你是怎么让FORM响应系统事件的?
一定没有问题,dwwang说的一点也没有错,应该是TFORM1,也许是笔误,
在写一遍,整个贴上来!
 
A

Another_eYes

Unregistered / Unconfirmed
GUEST, unregistred user!
用dwwang"逻辑的独立性"的方法编程的话, 不用多久就训练成打字高手拉.
(玩笑玩笑, 莫怪莫怪)
 
C

CJ

Unregistered / Unconfirmed
GUEST, unregistred user!
我同意dwwang的思路,这样设计程序风格好,如果怕打字,应Copy/Paster
 

李宏光

Unregistered / Unconfirmed
GUEST, unregistred user!
非常感谢,
各位的答案,对本人帮助很大
 

Similar threads

回复
0
查看
808
不得闲
回复
0
查看
851
不得闲
S
回复
0
查看
947
SUNSTONE的Delphi笔记
S
顶部