گرفتن ادرس پوشه جاری در Explorer.exe

[lord_viper]

با سلام

گاهی اوقات در برنامه ها نیاز به این پیدا میکنیم که بدونیم الان کاربر در چه پوشه ای قرار داره بعنی ادرس پوشه ای که الان در windows Explorer توسط کاربر در حال مشاهده هست چه ادرسی هست این ادرس چه در برنامه های امنیتی مثل انتی ویروسها و چه ضد امنیتی مثل ویروسها کاربرد داره
3نمونه از این کد

خواندن ادرس از ExplorerBar

کد:

procedure TForm1.Button1Click(Sender: TObject);
Var
Adwnd:hwnd;
Len:integer;
text:string;
begin
Adwnd:=FindWindow('CabinetWClass',nil);
Adwnd:=FindWindowEx(Adwnd,0,'WorkerW',nil);
Adwnd:=FindWindowEx(Adwnd,0,'ReBarWindow32',nil);
Adwnd:=FindWindowEx(Adwnd,0,'ComboBoxEx32',nil);
Adwnd:=FindWindowEx(Adwnd,0,'ComboBox',nil);
Adwnd:=FindWindowEx(Adwnd,0,'Edit',nil);
Len := SendMessage(Adwnd,$000E,0,0);
SetLength(Text,Len);
SendMessage(Adwnd,$000D,Len+1,LongInt(@Text[1]));
ShowMessage(text);
end;

بدست اوردن ادرس جاری با استفاده از shell.application

کد:

procedure TForm1.Button4Click(Sender: TObject);
const
SID_IShellFolderView = '{31C147B6-0ADE-4A3C-B514-DDF932EF6D17}';
var
Shell, Win, Doc: OleVariant;
i:Integer;
begin

Shell := CreateOleObject('Shell.Application');

for i := 0 to Shell.Windows.Count - 1 do
begin
Win := Shell.Windows.Item(i);
Doc := Win.Document;
if Supports(Doc, StringToGUID(SID_IShellFolderView)) then
begin
ShowMessage('Path='+Doc.Folder.Items.Item.Path);
end;

استفاده از IDispatch و shell32 برای بدست اوردن ادرس جاری

کد:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,JwaShLWAPI,JwaShlObj,JwaShlDisp,ActiveX,SHDocVw, StdCtrls,
  ExtCtrls;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
type
  TMChar = array[0..MAX_PATH] of Char;
var
  Form1: TForm1;

implementation

{$R *.dfm}
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;
procedure TForm1.Timer1Timer(Sender: TObject);
var
  path:tmchar;
begin
  path:= GetCurrentPath;
Caption:=string(path);
end;
end.

یونیتهای JwaShLWAPI,JwaShlObj,JwaShlDisp مربوط به مجموعه JVCL میباشد که میتوانید از سایت ان دریافت کنید

کد:

http://sourceforge.net/projects/jvcl/files/