////////////////////////////////////////////////////////////////////////////////

//

//  ****************************************************************************

//  * 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.