Mahmood_M
سه شنبه 31 فروردین 1389, 16:39 عصر
با سلام ...
پیرو سئوال پرسیده شده در این تاپیک (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;
یک برنامه ی نمونه هم ضمیمه کردم ...
امیدوارم مفید بوده باشه ...
موفق باشید ...
پیرو سئوال پرسیده شده در این تاپیک (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;
یک برنامه ی نمونه هم ضمیمه کردم ...
امیدوارم مفید بوده باشه ...
موفق باشید ...