Как извлечь историю посещений IE? , Надо показывать и выборочно удалять историю посещений IE.

Надо написать эту прогу на Delphi 7.

Она хранится в Dat-файлах непонятного формата обычно в папке %userprofile%\local settings\history.

Может есть какие-то функции типа GetExplorerHistoryItem?

Ещё вариант: запустить Explorer с параметром "%userprofile%\local settings\history" и как-то заставить его отображать содержимое в форме моего приложения, при этом надо скрыть элементы управления и чтобы он реагировал на мышку (чтобы можно было удалять).

Подскажите, как решить задачу?

Спасибо.

Ну примерно так:

////////////////////////////////////////////////////////////////////////////////
//
//  ****************************************************************************
//  * Unit Name : IEHistory
//  * Purpose   : Демо отображения истории браузера
//  * Author    : Александр (Rouse_) Багель
//  * Copyright : © Fangorn Wizards Lab 1998 - 2007
//  * Version   : 1.00
//  * Home Page : http://rouse.drkb.ru
//  ****************************************************************************
//
 
program IEHistory;
 
{$APPTYPE CONSOLE}
 
uses
  Windows,
  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;
 
  function Translate(Value: String): String;
  begin
    SetLength(Result, Length(Value));
    AnsiToOem(@Value[1], @Result[1]);
  end;
 
var
  History: IUrlHistoryStg;
  Enum: IEnumSTATURL;
  Url: TSTATURL;
  uFetched: ULONG;
begin
  if Succeeded(CoInitialize(nil)) then
  try
    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(Translate('Заголовок отсутствует.'))
        else
          Writeln(Translate(Url.pwcsTitle));
        Write('>> ');
        Writeln(Url.pwcsUrl);
      end;        
    finally
      History := nil;
    end;
  finally
    CoUninitialize;
  end;
  Readln;
end.

Спасибо за исходник.

Только нужно вместо Writeln(Url.pwcsUrl) писать Writeln(Translate(Url.pwcsUrl)), а то выводит только 1-ю букву.

Не получилось удалить URL. Напишите пример, как удалить из полученного списка выбранный URL.

И ещё вопрос: нет ли подобного способа для Cookies?

Спасибо.

Цитата AlekseyKopylov @ 27.03.07, 07:43

Только нужно вместо Writeln(Url.pwcsUrl) писать Writeln(Translate(Url.pwcsUrl)), а то выводит только 1-ю букву.

У меня выводит все нормально
Правда у меня 2006-ой Дельфи, а в структуре юникод, не знаю как семерка с ним работает.

Цитата AlekseyKopylov @ 27.03.07, 07:43

Не получилось удалить URL. Напишите пример, как удалить из полученного списка выбранный URL.

Вызови метод History.DeleteUrl()

Добавлено 27.03.07, 07:47

Цитата AlekseyKopylov @ 27.03.07, 07:43

нет ли подобного способа для Cookies?

А они в виде файлов лежат... С ними то что не так? Получить куку с нужного адреса можно через InternetGetCookie()

С куками можно и через файлы, да.

Вызываю History.DeleteUrl('http://mail.ru',0), прога или вылетает без сообщений, или вызывает ошибку. Пробовал в try заключить, то же самое.

Может не такие параметры надо использовать?


Спасибо.

никаких параметров не нужно... History.DeleteUrl('http://mail.ru',0) отрабатывает без ошибок.

Добавлено 27.03.07, 08:16
Ты кстати не забывай что работа ведется с юникодными строками а не с Анси

Спасибо, всё работает. Я сдуру сунул вызов после History := nil :)

Опять проблема. Хочу вывести в ListBox. Создал обычное приложение.

unit Unit1;
 
interface
 
uses
  ActiveX, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    UrlList: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure UrlListKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
 
{$R *.dfm}
 
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;
  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;
 
//------------------------------------------------------------------------------
 
implementation
 
function Translate(Value: String): String;
  begin
    SetLength(Result, Length(Value));
    AnsiToOem(@Value[1], @Result[1]);
  end;
 
//------------------------------------------------------------------------------
 
var
  History: IUrlHistoryStg;
  Enum: IEnumSTATURL;
  Url: TSTATURL;
  uFetched: ULONG;
  Urls: array of PWideChar;
  Count: integer = 0;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  if Succeeded(CoInitialize(nil)) then
  try
    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;
        UrlList.Items.Add(Url.pwcsUrl);
      end;
    finally
      History := nil;
    end;
  finally
    CoUninitialize;  //Проблема
  end;
 
end;
 
end.

Всё выводится, но при закрытии приложения вылезает ошибка: Access Violation... Read at address..."
и затем "Runtime Error 216 at 00403102".

Если не вызывать CoUninitialize, то не вылезает. Но тогда Explorer не замечает удаления элементов History.

Через IMalloc сначала освободи все данные которые тебе Enum.Next вернул...

Не могу найти информацию про IMalloc :(

Как им пользоваться?

Спасибо.

http://msdn2.microsoft.com/en-us/library/ms678425.aspx
Метод Free данного интерфейса применить к каждому Url полученному вызовом Enum.Next()

Надо было написать Enum := nil, тогда ошибка пропадает. А этому IMalloc.Free надо указатель, а указателей тут вроде нет.

Цитата AlekseyKopylov @ 27.03.07, 11:20

А этому IMalloc.Free надо указатель, а указателей тут вроде нет.

    pwcsUrl: PWChar;
    pwcsTitle: PWChar;

Пробовал применить IMalloc.Free к pwcsUrl и pwcsTitle: вылезает ошибка. Просто присваиваю им nil.

Сейчас программа не глючит (ошибки не выскакивают), но ведёт себя странно: удаляю урлы, они в ней больше не появляются после перезапуска. Но в IE в History всё равно всё остаётся, как будто не удалял.