Internet Explorer 历史计数

Question

如何获取 Internet Explorer 历史记录的计数？我可以在 vb 中使用 Shell.Application 来实现它，但在 delphi 中却不能。 我找到了一个带有“CLSID_CUrlHistory”的代码，其中显示了所有缓存条目。

---

我尝试转换相同的内容，但我遗漏了一些内容，请查看以下答案并纠正我出错的地方

Procedure ListIeHistory;

Const
HISTORY_LIST = 34;
ITEM_NAME = 0;
ITEM_DATE = 2;

var
ShellSession        : OleVariant;
ShellHistory        : OleVariant;
ShellEntry          : OleVariant;
ShellHistoryFolder  : OleVariant;
ShellCollection     : OleVariant;
oEnum               : IEnumvariant;
iValue              : LongWord;

Begin
    result:='';
    ShellSession:= CreateOleObject('Shell.Application');
    ShellHistory    := ShellSession.Namespace(HISTORY_LIST);
    ShellHistoryFolder:= ShellHistory.self;
    ShellCollection  := ShellHistory.Items;
    oEnum         := IUnknown(ShellCollection._NewEnum) as IEnumVariant;

    while oEnum.Next(1, ShellEntry, iValue) = 0 do
        begin
                 form1.Memo1.Lines.Add(vartostr(ShellEntry.Name));
        end;
end;

由 TLama 编辑

请注意，此代码有没有错误处理（我现在很忙），所以将其作为灵感。但是你确定这是你想要的吗？我想如果你按照我的答案中的代码并过滤一些项目（最有可能是句点），你会得到相同的结果。

这将浏览 C:\Users\TLama\AppData\Local\Microsoft\Windows\History 目录，因此我认为您丢失了一些历史记录项目（不是我；-），但我没有时间研究历史条目的来源。

请注意，要使用 IUrlHistoryStg 接口是正确的方法，而不是这个。

uses
  ComObj;

procedure TForm1.Button1Click(Sender: TObject);
var
  URL: string;
  Visited: string;
  I, J, K: Integer;
  Shell: OleVariant;
  Item: OleVariant;
  SiteFolder: OleVariant;
  SiteItem: OleVariant;
  PageFolder: OleVariant;
  PageItem: OleVariant;
  Folder: OleVariant;
const
  ITEM_NAME = 0;
  ITEM_DATE = 2;
  HISTORY_LIST = 34;
begin
  Shell := CreateOleObject('Shell.Application');
  Folder := Shell.NameSpace(HISTORY_LIST);
  Memo1.Lines.Add('Location: ' + Folder.Self.Path);

  for I := 0 to Folder.Items.Count - 1 do
  begin
    Item := Folder.Items.Item(I);
    Memo1.Lines.Add('Period: ' + Item.Name);

    if Item.IsFolder then
    begin
      SiteFolder := Item.GetFolder;
      for J := 0 to SiteFolder.Items.Count - 1 do
      begin
        SiteItem := SiteFolder.Items.Item(J);
        Memo1.Lines.Add('Site: ' + SiteItem.Name);

        if SiteItem.IsFolder then
        begin
          PageFolder := SiteItem.GetFolder;
          for K := 0 to PageFolder.Items.Count - 1 do
          begin
            PageItem := PageFolder.Items.Item(K);
            URL := PageFolder.GetDetailsOf(PageItem, ITEM_NAME);
            Visited := PageFolder.GetDetailsOf(PageItem, ITEM_DATE);
            Memo1.Lines.Add('URL: ' + URL + '; Visited: ' + Visited);
          end;
        end;
      end;
    end;
  end;
end;

Answer 1

根据jeffamaphone的建议进行完全重写，以使用IUrlHistoryStg 接口。它似乎返回与此更新之前的代码相同或非常相似的结果（我没有验证）。

下面的代码应该将当前用户的 Internet Explorer 历史记录中的所有 URL 打印到备注框中，然后显示一个包含其计数的消息框（很容易修改此代码以仅计算条目数）

uses
  ComObj, ActiveX;

type
  TStatURL = record
    cbSize: DWORD;
    pwcsUrl: LPWSTR;
    pwcsTitle: LPWSTR;
    ftLastVisited: FILETIME;
    ftLastUpdated: FILETIME;
    ftExpires: FILETIME;
    dwFlags: DWORD;
  end;
  IEnumStatURL = interface(IUnknown)
    ['{3C374A42-BAE4-11CF-BF7D-00AA006946EE}']
    function Next(celt: ULONG; var elt: TStatURL; var pceltFetched: ULONG): HRESULT; stdcall;
    function Skip(celt: ULONG): 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: DWORD): HRESULT; stdcall;
    function DeleteUrl(pocsUrl: PWideChar; dwFlags: DWORD): HRESULT; stdcall;
    function QueryUrl(pocsUrl: PWideChar; dwFlags: DWORD; 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;

const
  CLSID_CUrlHistory: TGUID = '{3C374A40-BAE4-11CF-BF7D-00AA006946EE}';

implementation

procedure TForm1.Button1Click(Sender: TObject);
var
  I: Cardinal;
  StatURL: TStatURL;
  EnumStatURL: IEnumStatURL;
  UrlHistoryStg: IUrlHistoryStg;
begin
  Memo1.Clear;
  Memo1.Lines.BeginUpdate;
  try
    UrlHistoryStg := CreateComObject(CLSID_CUrlHistory) as IUrlHistoryStg;
    if UrlHistoryStg.EnumUrls(EnumStatURL) = S_OK then
    begin
      while EnumStatURL.Next(1, StatURL, I) = S_OK do
      begin
        if I = 1 then
          Memo1.Lines.Add(StatURL.pwcsUrl);
      end;
    end;
  finally
    Memo1.Lines.EndUpdate;
  end;
  ShowMessage(IntToStr(Memo1.Lines.Count) + ' URLs found in history');
end;

： IEnumSTATURL.Next 方法，您必须将其传递给值为 1 的 celt 参数，否则您将陷入无限循环。