دریافت آدرس فعال و آیتم انتخاب شده در پنجره ی Explorer

[Mahmood_M]

با سلام ...
پیرو سئوال پرسیده شده در این تاپیک (http://barnamenevis.org/forum/showthread.php?t=215310) ، بنده یک جستجویی کردم و از چند منبع ، اطلاعاتی بدست آوردم که در نهایت جوابی برای اون سئوال پیدا شد ... !
با جستجویی که کردم یک Procedure پیدا شد ! که با کمی تغییر اون رو تبدیل به دو تا تابع کردم ، یکی برای بدست آوردن مسیر جاری Explorer و یکی هم برای بدست آوردن نام آیتم ( Folder یا File ) انتخاب شده در پنجره ی Explorer ، در زیر می تونید این توابع رو مشاهده کنید :

1. GetCurrentPath : بدست آوردن مسیر جاری پنجره

function GetCurrentPath : TMChar;
var
hwndFind : HWND;
psw : IShellWindows;
pdisp : IDispatch;
X : Integer;
pwba : IWebBrowserApp;
psp : IServiceProvider;
psb : IShellBrowser;
psv : IShellView;
pfv : IFolderView;
ppf2 : IPersistFolder2;
pidlFolder : PItemIDList;
begin
hwndFind := GetForegroundWindow;
Result[0] := #0;
if SUCCEEDED(CoCreateInstance(CLASS_ShellWindows, nil, CLSCTX_ALL, IID_IShellWindows, psw)) then
begin
try
for X := 0 to psw.Count - 1 do
begin
pdisp := psw.Item(X);
try
if SUCCEEDED(pdisp.QueryInterface(IID_IWebBrowserApp, pwba)) then
try
if pwba.get_HWND = hwndFind then
begin
if SUCCEEDED(pwba.QueryInterface(IServiceProvider, psp)) then
try
if SUCCEEDED(psp.QueryService(SID_STopLevelBrowser, IID_IShellBrowser, psb)) then
try
if SUCCEEDED(psb.QueryActiveShellView(psv)) then
try
if SUCCEEDED(psv.QueryInterface(IID_IFolderView, pfv)) then
try
if SUCCEEDED(pfv.GetFolder(IPersistFolder2, ppf2)) then
try
if SUCCEEDED(ppf2.GetCurFolder(pidlFolder)) then
try
if not SHGetPathFromIDList(pidlFolder, Result) then
StrCopy(Result, '<?? ???????>');
finally
CoTaskMemFree(pidlFolder);
end;
finally
ppf2 := nil;
end;
finally
pfv := nil;
end;
finally
psv := nil;
end;
finally
psb := nil;
end;
finally
psp := nil;
end;
Break;
end;
finally
pwba := nil;
end;
finally
pdisp := nil;
end;
end;
finally
psw := nil;
end;
end;
end;


2. GetCurrentItem : بدست آوردن آیتم انتخاب شده

function GetCurrentItem : TMChar;
var
hwndFind : HWND;
psw : IShellWindows;
pdisp : IDispatch;
X : Integer;
pwba : IWebBrowserApp;
psp : IServiceProvider;
psb : IShellBrowser;
psv : IShellView;
pfv : IFolderView;
ppf2 : IPersistFolder2;
pidlFolder : PItemIDList;
iFocus : Integer;
pidlItem : PItemIDList;
psf : IShellFolder;
Str : TStrRet;
begin
hwndFind := GetForegroundWindow;
Result[0] := #0;
if SUCCEEDED(CoCreateInstance(CLASS_ShellWindows, nil, CLSCTX_ALL, IID_IShellWindows, psw)) then
begin
try
for X := 0 to psw.Count - 1 do
begin
pdisp := psw.Item(X);
try
if SUCCEEDED(pdisp.QueryInterface(IID_IWebBrowserApp, pwba)) then
try
if pwba.get_HWND = hwndFind then
begin
if SUCCEEDED(pwba.QueryInterface(IServiceProvider, psp)) then
try
if SUCCEEDED(psp.QueryService(SID_STopLevelBrowser, IID_IShellBrowser, psb)) then
try
if SUCCEEDED(psb.QueryActiveShellView(psv)) then
try
if SUCCEEDED(psv.QueryInterface(IID_IFolderView, pfv)) then
try
if SUCCEEDED(pfv.GetFolder(IPersistFolder2, ppf2)) then
try
if SUCCEEDED(ppf2.GetCurFolder(pidlFolder)) then
try
if SUCCEEDED(pfv.GetFocusedItem(iFocus)) then
begin
if SUCCEEDED(pfv.Item(iFocus, pidlItem)) then
try
if SUCCEEDED(ppf2.QueryInterface(IID_IShellFolder, psf)) then
try
if SUCCEEDED(psf.GetDisplayNameOf(pidlItem, SHGDN_INFOLDER, Str)) then
StrRetToBuf(@Str, Pointer(pidlItem), Result, MAX_PATH);
finally
psf := nil;
end;
finally
CoTaskMemFree(pidlItem);
end;
end;
finally
CoTaskMemFree(pidlFolder);
end;
finally
ppf2 := nil;
end;
finally
pfv := nil;
end;
finally
psv := nil;
end;
finally
psb := nil;
end;
finally
psp := nil;
end;
Break;
end;
finally
pwba := nil;
end;
finally
pdisp := nil;
end;
end;
finally
psw := nil;
end;
end;
end;

خروجی توابع بالا از نوع TMChar هست که به عنوان یک آرایه از نوع Char تعریف شده :

type
TMChar = array[0..MAX_PATH] of Char;
این توابع از چند Unit استفاده می کنند که در دلفی موجود نیستند !! ، یک Unit به نام ShlwApi.pas که می تونید از این لینک (http://www.koders.com/delphi/fid730F2C34D1F8D72AC1E132C8D447CB2AC2C1D237.aspx) دانلود کنید و همینطور 2 یونیت به نامهای JwaShlObj.pas و JwaShlDisp.pas که در مجموعه ی " JEDI Windows API (http://sourceforge.net/projects/jedi-apilib/files/JEDI%20Windows%20API/) " قرار دارن ...
مجموعه ی JEDI Windows API شامل دو بخش به نامهای " JEDI API Library " و " Security Code Library " هست که اولی برای کار ما کافیه ، مورد دوم مجموعه ای شامل دستورات امنیتی ویندوز هست ...
چون سایت SourceForge امکان دانلود رو به ایرانی ها نمی ده ، می تونید JEDI API Library رو از لینکهای زیر دانلود کنید :

سایت 4Shared

http://www.4shared.com/file/yJSgrRqW/JWAPI_22.html

سایت ParsaSpace

http://parsaspace.com/files/5430528884/.html

یونیت اول ( ShlwApi.pas ) رو از لینکی که براش قرار دادم دانلود کنید و در پوشه ی Lib دلفی قرار بدید ، در مورد دو Unit دیگه هم وقتی مجموعه JEDI رو دانلود می کنید و از حالت فشرده خارج می کنید درون پوشه ی JWAPI 2.2 ، دو پوشه به نامهای " Common " و " Win32API " قرار داره ، کافیه مسیر این دو پوشه رو به قسمت " Library Path " در قسمت Environment Options در دلفی اضافه کنید ، در این صورت می تونید از Unit های این مجموعه به راحتی استفاده کنید ...

برای راحتی کار دوستان ، این دو تابع رو درون یک Unit به نام " GEAP.pas " قرار دادم و ضمیمه کردم ، کافیه Unit رو به پروژتون اضافه کنید ، در نهایت می تونید مثلا در یک Timer به صورت زیر ازش استفاده کنید :
uses
GEAP;
...
procedure TForm1.Timer1Timer(Sender: TObject);
var
Path, Item : TMChar;
begin
Path := GetCurrentPath;
Item := GetCurrentItem;
Edit1.Text := String(Path + Item);
end;

یک برنامه ی نمونه هم ضمیمه کردم ...

امیدوارم مفید بوده باشه ...

موفق باشید ...

[مهران رسا]

همه کارهایی که گفتید انجام شد منتها :


[DCC Error] JwaUrlMon.pas(2276): E2003 Undeclared identifier: 'IXMLElement'

[Mahmood_M]

همه کارهایی که گفتید انجام شد منتها :


[DCC Error] JwaUrlMon.pas(2276): E2003 Undeclared identifier: 'IXMLElement'
اگر مراحلی که گفته شده رو درست انجام داده باشید نباید مشکلی باشه ، احتمالا از دلفی 2010 استفاده می کنید ، درسته ؟ لطفا بگید که دقیقا چی کار کردید برای ثبت مسیر مجموعه ی JEDI در Library دلفی ...
سایر دوستان هم این مشکل رو دارن ؟

درضمن : یک مثال هم ضمیمه کردم ...

موفق باشید ...

[Mask]

حاج محمود دمت گرم.
اجراش که کردم یه 2000 تایی از این eroooooor ها اومد.

[Mahmood_M]

حاج محمود دمت گرم.
اجراش که کردم یه 2000 تایی از این eroooooor ها اومد.
برخی از توابعی که مربوط به Shell Interface ویندوز هستند به یک سری فایلهای DLL در ویندوز نیاز دارند که البته این فایلها به صورت پیشفرض در ویندوز هستند ! ، اما ممکنه نسخه ی اونها نسخه ی مناسب نباشه ، مثلا دستور QueryActiveShellView که در سورس برنامه استفاده شده به نسخه ی 4 یا بالاتر فایل Shell32.dll نیاز داره ...

احتمال داره مشکل از همین موارد باشه ، ولی من بدون مشکل سورس رو کامپایل و اجرا کردم ( ویندوز من هم XP سرویس پک 2 هست )

شما سورس رو در دلفی باز کنید و برنامه رو از طریق دلفی اجرا کنید و ببینید که این Error دقیقا در هنگام اجرای چه دستوری نمایش داده میشه ( Interval مربوط به Timer رو هم زیاد کنید تا یک دفعه چندین Error ظاهر نشه )

اگر دوستان دیگه هم این مشکل رو دارند لطفا اعلام کنن تا راه حلی پیدا کنیم ...

موفق باشید ...

[Mask]

این فایل Shell32.dll سیستم من ورژنش اینه:


6.00.2900.5512 (xpsp.080413-2105)

[مهران رسا]

اگر مراحلی که گفته شده رو درست انجام داده باشید نباید مشکلی باشه ، احتمالا از دلفی 2010 استفاده می کنید ، درسته ؟ لطفا بگید که دقیقا چی کار کردید برای ثبت مسیر مجموعه ی JEDI در Library دلفی ...
سایر دوستان هم این مشکل رو دارن ؟

درضمن : یک مثال هم ضمیمه کردم ...

موفق باشید ...

بله از دلفی 2010 استفاده می کنم .



کلید F6 رو زدم . عبارت Env رو تایپ کردم .
Environment Options Page رو باز کردم .
در دو قسمت Library-Win32 و Library Translated و از گزینه Library Patch مسیر دو پوشه گفته شده رو اضافه کردم (" Common " و " Win32API " از JEDI Windows API)
فایل ShlwApi.pas هم در پوشه Bin دلفی قرار دادم .

[Mask]

با سلام
وقتی کامپوننت هارو به برنامه دلفی معرفی کردم و برنامه رو با دلفی خودم کامپایل کردم دیگه ارور نیومد.
اما مشکل اینجاست بعد از چند دقیقه که برنامه درست کار میکنه یهو ارور ها سرازیر میشه.
بعدش اومدم و دوباره برنامه رو کامپایل کردم و الان که برنامه رو با دلفی اجرا میکنم به خط زیر گیر میده و اجرا نمیشه.

[Veyskarami]

اینم بدون استفاده از یونیت های JEDI
http://www.nldelphi.com/Forum/attachment.php?attachmentid=2467&d=1110104233