گفتم شاید کد به درد کسی بخوره:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,ShellAPI, ComCtrls;
type
TForm1 = class(TForm)
FoldersList: TListBox;
ProgressBar1: TProgressBar;
Label1: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
procedure CopyProgramFilesToFlash();
{ Private declarations }
public
{ Public declarations }
procedure WMDROPFILES(var msg : TWMDropFiles) ; message WM_DROPFILES;
end;
var
Form1: TForm1;
Files:Array[1..32000] of String;
FilesNo:Word;
implementation
{$R *.dfm}
procedure GetFiles(const sRootDir,Ext:string);
var
srSearch: TSearchRec;
sSearchPath: string;
sltSub: TStrings;
i: Integer;
begin
sltSub := TStringList.Create;
try
sSearchPath := IncludeTrailingBackslash(sRootDir);
if FindFirst(sSearchPath + '*', faDirectory, srSearch) = 0 then
repeat
if (srSearch.Name <> '.') and
(srSearch.Name <> '..') then
begin
if ((srSearch.Attr and faDirectory) =0)
and (LowerCase(ExtractFileExt(srSearch.Name))=LowerCas e(Ext)) then
Begin
Inc(FilesNo);
Files[FilesNo]:=sSearchPath + srSearch.Name;
End;
sltSub.Add(sSearchPath + srSearch.Name);
end;
until (FindNext(srSearch) <> 0);
FindClose(srSearch);
for i := 0 to sltSub.Count - 1 do
GetFiles(sltSub.Strings[i],Ext);
finally
FreeAndNil(sltSub);
end;
end;
procedure TForm1.CopyProgramFilesToFlash();
var
I:Word;
TmpDir:String;
begin
For I:=0 to FoldersList.Items.Count-1 Do
Begin
GetFiles(FoldersList.Items[I],'.dcu');
GetFiles(FoldersList.Items[I],'.dfm');
GetFiles(FoldersList.Items[I],'.dpr');
GetFiles(FoldersList.Items[I],'.ddp');
GetFiles(FoldersList.Items[I],'.pas');
GetFiles(FoldersList.Items[I],'.res');
GetFiles(FoldersList.Items[I],'.exe');
GetFiles(FoldersList.Items[I],'.ico');
End;
ProgressBar1.min:=1;
ProgressBar1.max:=FilesNo;
For I:=1 to FilesNo Do
Begin
ProgressBar1.Position:=I;
if TmpDir<>ExtractFileName(ExtractFileDir(Files[I])) then
Begin
TmpDir:=ExtractFileName(ExtractFileDir(Files[I]));
ForceDirectories('J:\'+TmpDir);
End;
Label1.Caption:=ExtractFileName(Files[I]);
Label1.Refresh;
Application.ProcessMessages;
CopyFile(PChar(Files[I]),PChar('J:\'+TmpDir+'\'+ExtractFileName(Files[I])),false);
End;
Application.Terminate;
end;
procedure TForm1.WMDROPFILES(var msg: TWMDropFiles) ;
const
MAXFILENAME = 255;
var
cnt, fileCount : integer;
fileName : array [0..MAXFILENAME] of char;
begin
FoldersList.Items.Clear;
// how many files dropped?
fileCount := DragQueryFile(msg.Drop, $FFFFFFFF, fileName, MAXFILENAME) ;
// query for file names
for cnt := 0 to -1 + fileCount do
begin
DragQueryFile(msg.Drop, cnt, fileName, MAXFILENAME) ;
//do something with the file(s)
FoldersList.Items.Insert(0, fileName) ;
end;
//release memory
DragFinish(msg.Drop) ;
FoldersList.Refresh;
Label1.Caption:='';
Application.ProcessMessages;
CopyProgramFilesToFlash();
End;
procedure TForm1.FormCreate(Sender: TObject);
begin
DragAcceptFiles( Handle, True ) ;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DragAcceptFiles(Handle, False);
end;
end.
end.