Версия для печати
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум на Исходниках.RU > Delphi: Система, Windows API > Как извлечь историю посещений IE?


Автор: AlekseyKopylov 27.03.07, 05:29
Надо написать эту прогу на Delphi 7.

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

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

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

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

Спасибо.

Автор: Rouse_ 27.03.07, 06:39
Ну примерно так:

<{CODE_COLLAPSE_OFF}><{CODE_WRAP_OFF}>
    ////////////////////////////////////////////////////////////////////////////////
    //
    //  ****************************************************************************
    //  * 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.

Автор: AlekseyKopylov 27.03.07, 07:43
Спасибо за исходник.

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

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

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

Спасибо.

Автор: Rouse_ 27.03.07, 07:45
Цитата AlekseyKopylov @
Только нужно вместо Writeln(Url.pwcsUrl) писать Writeln(Translate(Url.pwcsUrl)), а то выводит только 1-ю букву.

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

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

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

Добавлено
Цитата AlekseyKopylov @
нет ли подобного способа для Cookies?

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

Автор: AlekseyKopylov 27.03.07, 07:55
С куками можно и через файлы, да.

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

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


Спасибо.

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

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

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

Автор: AlekseyKopylov 27.03.07, 09:19
Опять проблема. Хочу вывести в ListBox. Создал обычное приложение.

<{CODE_COLLAPSE_OFF}><{CODE_WRAP_OFF}>
    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.

Автор: Rouse_ 27.03.07, 09:45
Через IMalloc сначала освободи все данные которые тебе Enum.Next вернул...

Автор: AlekseyKopylov 27.03.07, 10:04
Не могу найти информацию про IMalloc :(

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

Спасибо.

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

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

Автор: Rouse_ 27.03.07, 11:37
Цитата AlekseyKopylov @
А этому IMalloc.Free надо указатель, а указателей тут вроде нет.

<{CODE_COLLAPSE_OFF}><{CODE_WRAP_OFF}>
        pwcsUrl: PWChar;
        pwcsTitle: PWChar;

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

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

Powered by Invision Power Board (https://www.invisionboard.com)
© Invision Power Services (https://www.invisionpower.com)