FAQ VCL
Браузер

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как извлечь историю посещений IE?

uses
  {...,} ActiveX;

const
  IID_IUrlHistoryStg2: TGUID = '{AFA0DC11-C313-11d0-831A-00C04FD5AE38}';
  CLSID_CUrlHistory: TGUID = '{3C374A40-BAE4-11CF-BF7D-00AA006946EE}';

type
  TSTATURL = record
    cbSize: DWORD;           // Размер структуры
    pwcsUrl: PWChar;         // То, что было посещено
    pwcsTitle: PWChar;       // Заголовок
    ftLastVisited: FILETIME; // Время последнего визита
    ftLastUpdated: FILETIME; // Время последнего обновления
    ftExpires: FILETIME;     // Дата устаревания
    dwFlags: DWORD;          // Флаги STATURL_QUERYFLAG_ISCACHED или STATURL_QUERYFLAG_TOPLEVEL
  end;

  IEnumSTATURL = interface(IUnknown)
    ['{3C374A42-BAE4-11CF-BF7D-00AA006946EE}']
    function Next(celt: Integer; out elt; pceltFetched: PLongint): HRESULT; stdcall;
    function Skip(celt: Longint): HRESULT; stdcall;
    function Reset: HResult; stdcall;
    function Clone(out ppenum: IEnumSTATURL): HResult; stdcall;
    function SetFilter(poszFilter: PWideChar; dwFlags: DWORD): HResult; stdcall;
  end;

  IUrlHistoryStg = interface(IUnknown)
    ['{3C374A41-BAE4-11CF-BF7D-00AA006946EE}']
    function AddUrl(pocsUrl: PWideChar; pocsTitle: PWideChar; dwFlags: Integer): HResult; stdcall;
    function DeleteUrl(pocsUrl: PWideChar; dwFlags: Integer): HResult; stdcall;
    function QueryUrl(pocsUrl: PWideChar; dwFlags: Integer; var lpSTATURL: TSTATURL): HResult; stdcall;
    function BindToObject(pocsUrl: PWideChar; var riid: TIID; out ppvOut: Pointer): HResult; stdcall;
    function EnumUrls(out ppenum: IEnumSTATURL): HResult; stdcall;
  end;

var
  History: IUrlHistoryStg;
  Enum: IEnumSTATURL;
  Url: TSTATURL;
  uFetched: ULONG;

implementation

procedure TForm1.Button1Click(Sender: TObject);
begin
   if Succeeded( CoInitialize( nil ) ) then
   try
      AssignFile( Output, 'c:\ie_history.txt' );
      Rewrite( Output );
      if Succeeded( CoCreateInstance( CLSID_CUrlHistory, nil,
         CLSCTX_INPROC_SERVER, IID_IUrlHistoryStg2, History ) ) then
      try
         if Succeeded( History.EnumUrls( Enum ) ) then
         while Succeeded( Enum.Next( 1, Url, @uFetched ) ) do
         begin
            if uFetched = 0 then Break;
            if Length( Url.pwcsTitle ) = 0 then
               Writeln( Output, 'Заголовок отсутствует.' )
            else
               Writeln( Output, Url.pwcsTitle );
            Write( Output, '>> ' );
            Writeln( Output, Url.pwcsUrl );
         end;
      finally
         History := nil;
      end;
   finally
      CloseFile( Output );
      CoUninitialize;
   end;
   ShowMessage( 'Готово!' );
end;


Как найти экземпляр IE, в котором открыт указанный URL?

{.$DEFINE COSHWND}
uses
  SHDocVw{$IFNDEF COSHWND}, ActiveX{$ENDIF};

function TryGetWebBrowser(const URL: WideString; out Browser: IWebBrowser2): Boolean;
var
  Handle: HWND;
  ShWnd: IShellWindows;
  Location: OleVariant;
  Unused: OleVariant;
  WndIface: IDispatch;
begin
   {$IFDEF COSHWND}
   ShWnd := CoShellWindows.Create;
   if Assigned(ShWnd) then
   {$ELSE}
   if Succeeded(CoCreateInstance(CLASS_ShellWindows, nil, CLSCTX_LOCAL_SERVER, IID_IShellWindows, ShWnd)) then
   {$ENDIF}
   begin
     Location := URL;
     Unused := Unassigned;

     try
       WndIface := ShWnd.FindWindowSW(Location, Unused, SWC_BROWSER, Integer(Handle), SWFO_NEEDDISPATCH);
       Result := Assigned(WndIface) and Succeeded(WndIface.QueryInterface(IWebBrowser2, Browser));
     finally
       ShWnd := nil;
     end;
   end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Browser: IWebBrowser2;
begin
  if TryGetWebBrowser('http://ya.ru/', Browser) then
    ShowMessage('Экземпляр IE найден');
end;

При использовании материала - ссылка на сайт обязательна