好像只能如此：Function MyUtil_CopyDirectory(SourceDir, TargetDir:pchar; Recursive:integer):integer;stdcall;
var
r:TSearchRec;
li_return : integer;
begin
errorMessage := '';
if not DirectoryExists(TargetDir) then CreateDir(TargetDir);
try
if FindFirst(SourceDir+'*.*', faDirectory+faArchive, r)=0 then
repeat
if (r.Name<>'.') and (r.Name<>'..') then
if (r.Attr and faDirectory<>0) and (Recursive = 1) then
MyUtil_CopyDirectory(pchar(SourceDir+r.Name+'\'), pchar(TargetDir+r.Name+'\'), Recursive)
else
if r.Attr and faArchive<>0 then
CopyFile(PChar(SourceDir+r.Name), PChar(TargetDir+r.Name), False);
until FindNext(r)<>0;
li_return := 1;
except
on E: Exception do
begin
ErrorMessage := string(E.Message);
li_return := -1;
end;
end;
result := li_return;
end;
var
r:TSearchRec;
li_return : integer;
begin
errorMessage := '';
if not DirectoryExists(TargetDir) then CreateDir(TargetDir);
try
if FindFirst(SourceDir+'*.*', faDirectory+faArchive, r)=0 then
repeat
if (r.Name<>'.') and (r.Name<>'..') then
if (r.Attr and faDirectory<>0) and (Recursive = 1) then
MyUtil_CopyDirectory(pchar(SourceDir+r.Name+'\'), pchar(TargetDir+r.Name+'\'), Recursive)
else
if r.Attr and faArchive<>0 then
CopyFile(PChar(SourceDir+r.Name), PChar(TargetDir+r.Name), False);
until FindNext(r)<>0;
li_return := 1;
except
on E: Exception do
begin
ErrorMessage := string(E.Message);
li_return := -1;
end;
end;
result := li_return;
end;
=============================
Function ConvertWordToBinaryString(InputWord : Word; Length : Integer) : ShortString;
var
Counter, Number : Cardinal;
D : Array[0..1] of Char;
Begin
D[0] := '0';
D[1] := '1';
Number := 1;
Result[0] := #16;
For Counter := 15 Downto 0 Do
Begin
Result[Number] :=
D[Ord(InputWord and (1 shl Counter) <> 0)];
Inc(Number);
End;
If Length > 16 Then Length := 16;
If Length < 1 Then Length := 1;
Result := Copy(Result,16-Length,Length);
End;Function ConvertIntegerToBinaryString(Int, Length : Integer) : ShortString;
Begin
Result := ConvertWordToBinaryString(Word(Int),Length);
End;
//获取目录中的文件信息
Function FilesInDirDetail(
FileList : TStrings;
Directory : String;
Mask : String;
Intersection: Boolean;
IsReadOnly : Boolean;
IsHidden : Boolean;
IsSystem : Boolean;
IsVolumeID : Boolean;
IsDirectory : Boolean;
IsArchive : Boolean;
IsNormal : Boolean;
InclDotFiles: Boolean): Boolean;
var
j : Integer;
MaskPtr : PChar;
Ptr : PChar;
FileInfo : TSearchRec;
CurDir : String;
FileType : TFileType;
FileType_I : Integer;
FileType_B : ShortString;
TSList : TStringList;
BinaryAttr : ShortString;
ShouldAdd : Boolean;
begin
{ Result := False;}{zzz}
TSList := TStringList.Create();
Try
Try
FileType := [];
If IsReadOnly Then FileType := (FileType + [ftReadOnly]);
If IsHidden Then FileType := (FileType + [ftHidden]);
If IsSystem Then FileType := (FileType + [ftSystem]);
If IsVolumeID Then FileType := (FileType + [ftVolumeID]);
If IsDirectory Then FileType := (FileType + [ftDirectory]);
If IsArchive Then FileType := (FileType + [ftArchive]);
If IsNormal Then FileType := (FileType + [ftNormal]);
FileType_I := 0;
If IsReadOnly Then FileType_I := (FileType_I + 1);
If IsHidden Then FileType_I := (FileType_I + 2);
If IsSystem Then FileType_I := (FileType_I + 4);
If IsVolumeID Then FileType_I := (FileType_I + 8);
If IsDirectory Then FileType_I := (FileType_I + 16);
If IsArchive Then FileType_I := (FileType_I + 32);
If IsNormal Then FileType_I := (FileType_I + 128);
FileType_B := ConvertIntegerToBinaryString(FileType_I,8);
TSList.Clear;
GetDir(0,CurDir);
ChDir(Directory); { go to the directory we want }
FileList.Clear; { clear the list } MaskPtr := PChar(Mask);
while MaskPtr <> nil do
begin
Ptr := StrScan (MaskPtr, ';');
If Ptr <> nil Then Ptr^ := #0;
If FindFirst(MaskPtr, 191, FileInfo) = 0 Then
Begin
Repeat { exclude normal files if ftNormal not set }
Begin
If ftNormal in FileType Then
Begin
TSList.Add(FileInfo.Name);
End
Else
Begin
BinaryAttr := ConvertIntegerToBinaryString(FileInfo.Attr,8);
If Intersection Then
Begin
ShouldAdd := True;
For j := 1 To 8 Do
Begin
If (FileType_B[j]='1') And (BinaryAttr[j]<>'1') Then
Begin
ShouldAdd := False;
Break;
End;
End;
If ShouldAdd Then
TSList.Add(FileInfo.Name);
End
Else
Begin
For j := 1 To 8 Do
Begin
If (FileType_B[j]='1') And (BinaryAttr[j]='1') Then
Begin
TSList.Add(FileInfo.Name);
Break;
End;
End;
End;
End;
End;
Until FindNext(FileInfo) <> 0;
{zzz Changed 4/17/99 rlm}
//FindClose(FileInfo.FindHandle);
FindClose(FileInfo);
End;
If Ptr <> nil then
begin
Ptr^ := ';';
Inc (Ptr);
end;
MaskPtr := Ptr;
end;
ChDir(CurDir);
TSList.Sorted := False;
If Not InclDotFiles Then
Begin
If TSList.IndexOf('.') > -1 Then
TSLIst.Delete(TSList.IndexOf('.'));
If TSList.IndexOf('..') > -1 Then
TSLIst.Delete(TSList.IndexOf('..'));
End;
TSList.Sorted := True;
TSList.Sorted := False;
FileList.Assign(TSList);
Result := True;
Except
Result := False;
End;
Finally
TSList.Free;
End;
end;//调用以下函数清空文件夹Function MyUtil_EmptyDirectory(as_Directory : pchar): Integer;stdcall;
Var
T : TStringList;
i,li_return : Integer;
Directory : string;
Begin
Directory := as_directory;
Try
T := TStringList.Create();
If Copy(Directory,Length(Directory),1) <> '\' Then Directory := Directory + '\';
If Not DirectoryExists(Directory) Then
li_return := 0
else
begin
FilesInDirDetail(
T, //FileList : TStrings;
Directory, //Directory : String;
'*.*', //Mask : String;
False, //Intersection: Boolean;
False, //IsReadOnly : Boolean;
False, //IsHidden : Boolean;
False, //IsSystem : Boolean;
False, //IsVolumeID : Boolean;
False, //IsDirectory : Boolean;
False, //IsArchive : Boolean;
True, //IsNormal : Boolean;
False); //InclDotFiles: Boolean): Boolean; For i := 0 To T.Count - 1 Do DeleteFile(PChar(Directory+T[i]));
li_return := 1;
End;
t.Destroy;
except
on E: Exception do
begin
ErrorMessage := string(E.Message);
li_return := -1;
end;
End;
result := li_return;
End;
uses shellapiprocedure 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;
FOF_DEFAULT_IDEAL = FOF_MULTIDESTFILES + FOF_RENAMEONCOLLISION + FOF_NOCONFIRMATION + FOF_ALLOWUNDO +
FOF_FILESONLY + FOF_NOCONFIRMMKDIR + FOF_NOERRORUI + FOF_SIMPLEPROGRESS;
FOF_DEFAULT_DELTREE = FOF_NOCONFIRMATION + FOF_ALLOWUNDO + FOF_NOERRORUI;
FOF_DEFAULT_COPY = FOF_NOCONFIRMATION + FOF_ALLOWUNDO + FOF_NOCONFIRMMKDIR + FOF_NOERRORUI + FOF_MULTIDESTFILES;
FOF_DEFAULT_DELFILES = FOF_DEFAULT_DELTREE; function ShellDeleteFiles( hWnd : THandle ; const DirName : string; Flags : FILEOP_FLAGS; WinTitle : PChar ) : integer;
{---------------------------------------------------------------------------------------------}
{Apaga arquivos/Diretorios atraves do shell do windows}
//Notas: Ver comentario sobre o uso de duplo #0 nos parametros de Origem e destino
var
FileOpShell : TSHFileOpStruct;
Oper : array[0..1024] of char;
begin
if WinTitle <> nil then begin
Flags:=Flags + FOF_SIMPLEPROGRESS;
end;
with FileOpShell do begin
wFunc:=FO_DELETE;
pFrom:=Oper;
pTo:=Oper; //pra garantir a rapadura!
fFlags:=Flags;
lpszProgressTitle:=WinTitle;
Wnd:=hWnd;
hNameMappings:=nil;
fAnyOperationsAborted:=False;
end;
StrPCopy( Oper, DirName );
StrCat(Oper, PChar( ExtractFileName( FindFirstChildFile( DirName )) ) );
Result:=0;
try
while Oper <> EmptyStr do begin
Result:=ShFileOperation( FileOpShell );
if FileOpShell.fAnyOperationsAborted then begin
Result:=ERROR_REQUEST_ABORTED;
break;
end else begin
if Result <> 0 then begin
Break;
end;
end;
StrPCopy(Oper, FindFirstChildFile( DirName ) );
end;
except
Result:=ERROR_EXCEPTION_IN_SERVICE;
end;
end;