نمایش نتایج 1 تا 9 از 9

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

Threaded View

پست قبلی پست قبلی   پست بعدی پست بعدی
  1. #1

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

    با سلام ...
    پیرو سئوال پرسیده شده در این تاپیک ، بنده یک جستجویی کردم و از چند منبع ، اطلاعاتی بدست آوردم که در نهایت جوابی برای اون سئوال پیدا شد ... !
    با جستجویی که کردم یک 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 که می تونید از این لینک دانلود کنید و همینطور 2 یونیت به نامهای JwaShlObj.pas و JwaShlDisp.pas که در مجموعه ی " JEDI Windows API " قرار دارن ...
    مجموعه ی 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;


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

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

    موفق باشید ...
    فایل های ضمیمه فایل های ضمیمه
    آخرین ویرایش به وسیله Mahmood_M : سه شنبه 31 فروردین 1389 در 17:48 عصر

برچسب های این تاپیک

قوانین ایجاد تاپیک در تالار

  • شما نمی توانید تاپیک جدید ایجاد کنید
  • شما نمی توانید به تاپیک ها پاسخ دهید
  • شما نمی توانید ضمیمه ارسال کنید
  • شما نمی توانید پاسخ هایتان را ویرایش کنید
  •