在DELPHI中如何实现拷贝目录！！！！！！！！！！！！！！！

2002-07-02 08:58:28 197 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

delphi 拷贝网络共享文件代码 procedure TForm1.Button4Click(Sender: TObject);var NetSource : TNetResource; Errinfo:longint;begin with NetSource do begin dwType := RESOURCETYPE_ANY; // 用于指定网络的资源类型 lpLoca 阅读详情

我想通过程序拷贝目录，因为我这个目录比较特别，但程序中我不大会，有人能告诉我吗？就像WINDOWS中的COPY再PASTE一样！

...全文

delphi 软件自动获取管理员权限方法 1.新建一个文本文件，命名为UAC.manifest，用记事本打开，把下面的内容粘贴进去，保存。 UTF-8" standalone="yes"?> 2.再建立一个文本文件，命名为 UAC.rc ，写入下面的内容，保存。 1 24 UAC.manifest 把UAC.rc 和 UAC.manifest 文件，一起拷贝到DELPHI安装目录下的BIN目录里，执行 brcc 阅读详情

CDMAA

Delphi 5,944 成员 262,941 内容

+ 关注 + 加入社区

切换为时间正序

likevclinux 2002-07-11

打赏
举报

来晚那

ahzhangcg 2002-07-10

打赏
举报

Form6应为MainForm

ahzhangcg 2002-07-10

打赏
举报

object Form6: TForm6
Left = 271
Top = 107
Width = 696
Height = 358
Caption = 'Form6'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object GroupBox1: TGroupBox
Left = 20
Top = 20
Width = 637
Height = 125
Caption = ' Copy directory example '
TabOrder = 0
object spbtnGetFromDir: TSpeedButton
Left = 590
Top = 20
Width = 23
Height = 22
Caption = '...'
end
object spbtnGetToDir: TSpeedButton
Left = 590
Top = 52
Width = 23
Height = 22
Caption = '...'
end
object edtFromDir: TEdit
Left = 40
Top = 20
Width = 553
Height = 21
TabOrder = 0
end
object edtToDir: TEdit
Left = 40
Top = 52
Width = 553
Height = 21
TabOrder = 1
end
object Button1: TButton
Left = 44
Top = 84
Width = 157
Height = 25
Caption = 'Copy Directory'
TabOrder = 2
end
end
object GroupBox2: TGroupBox
Left = 20
Top = 156
Width = 637
Height = 133
Caption = ' To recycle bin example '
TabOrder = 1
object spbtnRecycleBin: TSpeedButton
Left = 590
Top = 20
Width = 23
Height = 22
Caption = '...'
end
object edtRecycleDir: TEdit
Left = 40
Top = 20
Width = 553
Height = 21
TabOrder = 0
end
object btnRecycleDir: TButton
Left = 44
Top = 56
Width = 157
Height = 25
Caption = 'Delete Directory'
TabOrder = 1
end
end
object btnClose: TButton
Left = 312
Top = 296
Width = 75
Height = 25
Caption = 'Close'
TabOrder = 2
end
end

ahzhangcg 2002-07-10

打赏
举报

unit MainFrm;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons;

type
TMainForm = class(TForm)
GroupBox1: TGroupBox;
spbtnGetFromDir: TSpeedButton;
spbtnGetToDir: TSpeedButton;
edtFromDir: TEdit;
edtToDir: TEdit;
Button1: TButton;
GroupBox2: TGroupBox;
edtRecycleDir: TEdit;
spbtnRecycleBin: TSpeedButton;
btnRecycleDir: TButton;
btnClose: TButton;
procedure spbtnGetFromDirClick(Sender: TObject);
procedure spbtnGetToDirClick(Sender: TObject);
procedure btnCopyDirectoryClick(Sender: TObject);
procedure spbtnRecycleBinClick(Sender: TObject);
procedure btnRecycleDirClick(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
MainForm: TMainForm;

implementation
uses ShellAPI, FileCtrl;
{$R *.DFM}

function GetDirectory: String;
begin
if not SelectDirectory(Result, [sdAllowCreate, sdPerformCreate, sdPrompt], 0) then
Result := EmptyStr;
end;

procedure CopyDirectoryTree(AHandle: THandle; const AFromDirectory, AToDirectory: String);
var
SHFileOpStruct: TSHFileOpStruct;
FromDir: PChar;
ToDir: PChar;
begin

GetMem(FromDir, Length(AFromDirectory)+2);
try
GetMem(ToDir, Length(AToDirectory)+2);
try

FillChar(FromDir^, Length(AFromDirectory)+2, 0);
FillChar(ToDir^, Length(AToDirectory)+2, 0);

StrCopy(FromDir, PChar(AFromDirectory));
StrCopy(ToDir, PChar(AToDirectory));

with SHFileOpStruct do
begin
Wnd := AHandle; // Assign the window handle
wFunc := FO_COPY; // Specify a file copy
pFrom := FromDir;
pTo := ToDir;
fFlags := FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION;
fAnyOperationsAborted := False;
hNameMappings := nil;
lpszProgressTitle := nil;
if SHFileOperation(SHFileOpStruct) <> 0 then
RaiseLastWin32Error;
end;
finally
FreeMem(ToDir, Length(AToDirectory)+2);
end;
finally
FreeMem(FromDir, Length(AFromDirectory)+2);
end;
end;

procedure ToRecycle(AHandle: THandle; const ADirName: String);
var
SHFileOpStruct: TSHFileOpStruct;
DirName: PChar;
BufferSize: Cardinal;
begin
BufferSize := Length(ADirName) +1 +1;
GetMem(DirName, BufferSize);
try
FillChar(DirName^, BufferSize, 0);
StrCopy(DirName, PChar(ADirName));

with SHFileOpStruct do
begin
Wnd := AHandle;
wFunc := FO_DELETE;
pFrom := DirName;
pTo := nil;
fFlags := FOF_ALLOWUNDO;

fAnyOperationsAborted := False;
hNameMappings := nil;
lpszProgressTitle := nil;
end;

if SHFileOperation(SHFileOpStruct) <> 0 then
RaiseLastWin32Error;
finally
FreeMem(DirName, BufferSize);
end;
end;

procedure TMainForm.spbtnGetFromDirClick(Sender: TObject);
begin
edtFromDir.Text := GetDirectory;
end;

procedure TMainForm.spbtnGetToDirClick(Sender: TObject);
begin
edtToDir.Text := GetDirectory;
end;

procedure TMainForm.btnCopyDirectoryClick(Sender: TObject);
begin
CopyDirectoryTree(Handle, edtFromDir.Text, edtToDir.Text);
end;

procedure TMainForm.spbtnRecycleBinClick(Sender: TObject);
begin
edtRecycleDir.Text := GetDirectory;
end;

procedure TMainForm.btnRecycleDirClick(Sender: TObject);
begin
ToRecycle(0, edtRecycleDir.Text);
end;

procedure TMainForm.btnCloseClick(Sender: TObject);
begin
Close;
end;

end.

cqbonny 2002-07-10

打赏
举报

我试试

I_am_zealot 2002-07-03

打赏
举报

Performs a copy, move, rename, or delete operation on a file system object.

WINSHELLAPI int WINAPI SHFileOperation(LPSHFILEOPSTRUCT lpFileOp);
Parameters
lpFileOp:Pointer to an SHFILEOPSTRUCT structure that contains information the function needs to carry out the operation.

Return Values
Returns zero if successful or nonzero if an error occurs.

Now Supported on Windows NT

toplor 2002-07-03

打赏
举报

提醒一下，请在uses部分加上ShellAPI单元

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
风过西窗客渡舟船无觅处
年年一川新草遥看却似旧

toplor 2002-07-03

打赏
举报

这是完整的文件夹复制方法，看看吧：

procedure TForm1.CopyBtnClick(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,pchar(edit1.Text));//源目录
strpcopy(tobuf,pchar(edit2.Text));//目的目录
//填充opstruc记录
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;
//开始复制
if shfileoperation(opstruc)=0 then
messagebox(handle,'复制完毕.','复制信息',mb_ok+mb_iconinformation);

end;

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
风过西窗客渡舟船无觅处
年年一川新草遥看却似旧

CDMAA 2002-07-02

打赏
举报

能不给我详细的代码呀！！！

cs_str 2002-07-02

打赏
举报

Shell 编程也可以实现该功能

佣工7001 2002-07-02

打赏
举报

用API
SHFileOperation（）可实现Window一样的效果，支持回收站！～

CDMAA 2002-07-02

打赏
举报

好像还是不行，不能把文件夹的特性拷过去，有没有实现WINDOW中的COPY方法的呀！

happyjoe 2002-07-02

打赏
举报

搜索一下，前面有

cpls 2002-07-02

打赏
举报

WinExec中执行'xcopy SourceDir TargetDir /s/e'

在DELPHI中如何实现拷贝目录！！！！！！！！！！！！！！！

相关推荐