PDA

View Full Version : سوال: چطور چند تا پوشه رو روی پنجره برنامه درگ کنم و لیستی از نام پوشه ها بدست بیارم؟



mbshareat
جمعه 03 خرداد 1398, 00:40 صبح
من میخوام چند تا پوشه برنامه رو توی فلش ذخیره کنم.ولی میخوام فقط فایلهای ضروری برنامه رو ذخیره کنم(بعضی وقتها برنامه رو می برم خونه روش کار می کنم و نتیجه رو می برم سر کار)
خودم یه بچ فایل دارم که باهاش بعضی فایلها(dcu,pas,dfm,dpr,ddp) رو از پوشه چند برنامه اصلیم رو کپی می کنم.اما ممکنه بخوام فایلهای اصلی برنامه دیگه ای رو به فلش منتقل کنم.
قبلا توی سایت برنامه ای دیده بودم که می تونست فایلها رو به کلیپ برد منتقل کنه که بعدا یه جایی الصاق کنیم.فکر می کنم برای پوشه هم راهی باشه.فقط اسم پوشه ها رو توی برنامه میخوام.میخوام پوشه ها رو درگ گنم روی پنجره برنامه و برنامه بقیه کار رو انجام بده.قبلا خودم از این شیوه درگ کردن برای پخش صوت استفاده کردم.اما از کدش سر در نمیارم.اسم پروسیجرش هم WMDROPFILES بود.
ببخشید یه جورایی میخوام یکی تکلفم رو انجام بده.:بامزه:

mbshareat
جمعه 03 خرداد 1398, 00:52 صبح
فکر نمی کردم بتونم از همون برنامه استفاده کنم.
public
{ Public declarations }
procedure WMDROPFILES(var msg : TWMDropFiles) ; message WM_DROPFILES;
end;
..

implementation

..

procedure TForm1.WMDROPFILES(var msg: TWMDropFiles) ;
const
MAXFILENAME = 255;
var
cnt, fileCount : integer;
fileName : array [0..MAXFILENAME] of char;
begin
HidenList.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)
HidenList.Items.Insert(0, fileName) ;
end;
//release memory
DragFinish(msg.Drop) ;
End;
procedure TForm1.FormCreate(Sender: TObject);
begin
DragAcceptFiles( Handle, True ) ;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DragAcceptFiles(Handle, False);
end;

mbshareat
جمعه 03 خرداد 1398, 01:23 صبح
گفتم شاید کد به درد کسی بخوره:
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.