Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2007年03月18日] [更新 2014年04月09日]　Delphi サンプルプログラム集
   
760_インターネット ( IE ) のキャッシュのリストを取得
動作確認等 Windows 7 U64(SP1) + Delphi XE Pro + IE 10
760_InternetCacheHistroy.zip　[6,121 KB]　2014年04月09日版 (EXE 同梱)



  • 2014年04月08日
  • キャッシュの種類別のサンプルとし，取得と削除も別のサンプルとした



インターネット ( IE ) のキャッシュ等のリストの取得と削除


IE (インターネットエクスプローラ) のキャッシュは，Temporary Internet Files という特殊フォルダとその階層下のフォルダに格納されます．
このキャッシュの操作専用の Windows API があります．本ページはそれらの関数を使用したサンプルです．次のような手順で処理しています．
  • FindFirstUrlCacheEntry 関数で最初のエントリとキャッシュのハンドルを取得する
    この時，キャッシュ全体か，クッキーだけか，履歴だけかを指定できる
  • FindNextUrlCacheEntry 関数で，戻り値が False になるまで次のエントリを検索する
  • URL 等の情報は，TInternetCacheEntryInfo レコード型のメンバーから取り出す
これらの関数を使用する際，まず，情報取得に必要なバッファのサイズを，それらの関数自身を使用して取得し，必要なメモリを確保します．サイズを取得しないで，自動取得で操作すると，[Wininet キャッシュの列挙について] の記事にあるように，二重に取得してしまうことがあるようです．

キャッシュのリストの取得では，ボタンクリックのコード内で全て処理しています．キャッシュの削除のサンプルでは，最初のエントリと，次のエントリの操作を，関数内関数として別にしています．

キャッシュ内の項目は，該当するファイルを削除しただけでは削除できません．エントリポイントという情報も削除する必要があります．そのため，FindFirstUrlCacheEntry, FindNextUrlCacheEntry 等を使用して，DeleteUrlCacheEntry 関数でキャッシュの削除を行っています．

履歴の取得と削除は，それぞれ，IUrlHistoryStg と IUrlHistoryStg2 というインターフェイスを使用する方法もあります．これらのインターフェイスを使用すると，簡単なコードで操作可能です．
これらのインターフェイスは，Delphi XE 以降で使用可能です．





01_IE のキャッシュ内のリストを取得


IE のキャッシュのリストを列挙するサンプルです．クッキーは取得しないようにしています．


  • 図1
  • 設計時画面

  • 図2
  • 実行例

リスト1
IE のキャッシュ内のリストを取得
このコードでは，クッキーを取得対象から除外している		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Memo1: TMemo;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses WinInet;

{$R *.dfm}

//=============================================================================
//  IEのキャッシュのリストを取得
//  クッキーの情報は除外している
//  usesにWinInetが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  lpEntryInfo : PInternetCacheEntryInfo;
  hCache      : Cardinal;
  dwEntrySize : Cardinal;
  dwLastError : Cardinal;
  FilePath    : String;
begin
  Screen.Cursor := crHourGlass;
  Memo1.Lines.BeginUpdate;
  Memo1.Lines.Clear;

  //最初のエントリの情報取得に必要なサイズをdwEntrySizeに取得
  dwEntrySize := 0;
  FindFirstUrlCacheEntry(nil, TInternetCacheEntryInfo(nil^), dwEntrySize);
  //メモリを確保して最初のエントリの情報を取得
  GetMem(lpEntryInfo, dwEntrySize);
  hCache := FindFirstUrlCacheEntry(nil, lpEntryInfo^, dwEntrySize);

  if hCache <> 0 then begin
    //Cookieの分は除く
    if (lpEntryInfo^.CacheEntryType and COOKIE_CACHE_ENTRY) = 0 then begin
      FilePath := lpEntryInfo^.lpszLocalFileName;
      if Trim(FilePath) <> '' then begin
        Memo1.Lines.Add(lpEntryInfo^.lpszLocalFileName);
      end;
    end;
    FreeMem(lpEntryInfo);

    //次のエントリの情報を取得
    repeat
      //情報の取得に必要なサイズを取得
      dwEntrySize := 0;
      FindNextUrlCacheEntry(hCache, TInternetCacheEntryInfo(nil^), dwEntrySize);
      dwLastError := GetLastError;
      //メモリを確保して，実際に情報を取得
      if dwLastError = ERROR_INSUFFICIENT_BUFFER then begin
        GetMem(lpEntryInfo, dwEntrySize);
        if FindNextUrlCacheEntry(hCache, lpEntryInfo^, dwEntrySize) then begin
          //Cookieの分は除く
          if (lpEntryInfo^.CacheEntryType and COOKIE_CACHE_ENTRY) = 0 then begin
            FilePath := lpEntryInfo^.lpszLocalFileName;
            if Trim(FilePath) <> '' then begin
              Memo1.Lines.Add(lpEntryInfo^.lpszLocalFileName);
            end;
          end;
        end;
        FreeMem(lpEntryInfo);
      end;
    until dwLastError = ERROR_NO_MORE_ITEMS;
    FindCloseUrlCache(hCache);
  end else begin
    FreeMem(lpEntryInfo);
  end;

  Memo1.Lines.EndUpdate;
  Screen.Cursor := crDefault;
  Label1.Caption := '総数 :  ' + IntToStr(Memo1.Lines.Count);
end;

end.



02_IE のキャッシャフォルダ内のプロパティの項目名


FindFirstUrlCacheEntry, FindNextUrlCacheEntry から取得可能な項目は，TInternetCacheEntryInfo レコード型に定義してあります．これは，winInet.pas で定義されていて，下のマイクロソフトの記事の構造体と同じです．
一方，TShell や項目識別子から取得できる項目名は少し違います．下のコードは，このことを確認するためのサンプルです．SHGetFolderPath 関数を使用して，IE のキャッシュのフォルダのフルパスを取得します．そして，TShell オブジェクトを使用して，プロパティの項目名を列挙します．

本ページのサンプルは，全て，名前またはインターネットアドレスしか取得していません．


図3
設計時画面
図4
実行結果

リスト2
IE のキャッシャフォルダ内のプロパティの項目名		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, OleServer, Shell32_TLB;

type
  TForm1 = class(TForm)
    Shell1: TShell;
    Panel1: TPanel;
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ShlObj, ShellAPI;

{$R *.dfm}

//=============================================================================
//  IEのキャッシュのリストのプロパティ名を取得して表示
//  usesにShlObj, ShellAPIが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  Buff       : array [0..MAX_PATH] of Char;
  FolderPath : String;
  SHFolder   : Shell32_TLB.Folder;
  i          : Integer;
  AValue     : String;
begin
  Memo1.Lines.Clear;
  Memo1.Lines.BeginUpdate;

  FillChar(Buff, SizeOf(Buff), #0);
  if SHGetFolderPath(0, CSIDL_INTERNET_CACHE , 0, 0, @Buff) = S_OK then begin
    FolderPath := Buff;
    SHFolder   := Shell1.NameSpace(FolderPath);

    //プロパティの数だけループして項目名を追加
    for i := 0 to SHFolder.Items.Count - 1 do begin
      AValue := SHFolder.GetDetailsOf(varNull, i);
      Memo1.Lines.Add(AValue);
    end;
  end;
  Memo1.Lines.EndUpdate;
end;

end.



03_IE のキャッシュの画像だけを取得して表示


IE のキャッシュ内の画像だけを取得します．取得するのは拡張子が .GIF, .JPG, .PNG の画像だけとしています.
取得した画像ファイル名を選択すると，その画像を TImage に表示します．


図5
設計時画面
図6
実行結果
  • 項目を選択すると，その画像を表示

リスト3
IE のキャッシュの画像だけを取得して表示		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Label1: TLabel;
    Image1: TImage;
    Splitter1: TSplitter;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ListBox1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses WinInet;

{$R *.dfm}

//=============================================================================
//  フォームを閉じる時はTListboxのObjectのオブジェクトも解放
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  i : Integer;
begin
  for i := 0 to ListBox1.Items.Count - 1 do begin
    Dispose(PString(ListBox1.Items.Objects[i]));
  end;
end;

//=============================================================================
//  IEのキャッシュから画像だけを取得
//  usesにWinInetが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);

  //---------------------------------------------------------------------------
  //  TListBoxのObjectプロパティに格納する文字列を生成
  //---------------------------------------------------------------------------
  function NewItemStr(S: String): PString;
  begin
    New(Result);
    Result^ := S;
  end;
  //---------------------------------------------------------------------------

var
  lpEntryInfo  : PInternetCacheEntryInfo;
  hCache       : Cardinal;
  dwEntrySize  : Cardinal;
  dwLastError  : Cardinal;
  FileFullPath : string;
  FileName     : String;
  FileExt      : String;
begin
  Screen.Cursor := crHourGlass;
  ListBox1.Items.BeginUpdate;
  ListBox1.Items.Clear;

  //最初のエントリの情報取得に必要なサイズをdwEntrySizeに取得
  dwEntrySize := 0;
  FindFirstUrlCacheEntry(nil, TInternetCacheEntryInfo(nil^), dwEntrySize);
  //メモリを確保して最初のエントリの情報を取得
  GetMem(lpEntryInfo, dwEntrySize);
  hCache := FindFirstUrlCacheEntry(nil, lpEntryInfo^, dwEntrySize);

  if hCache <> 0 then begin
    //名前とローカルファイルのパス名を取得してListBox1のItemに格納
    FileFullPath := lpEntryInfo^.lpszLocalFileName;
    FileName     := ExtractFileName(FileFullPath);
    FileExt      := UpperCase(ExtractFileExt(FileName));
    if (FileExt = '.GIF') or (FileExt = '.JPG') or (FileExt = '.PNG') then begin
      ListBox1.Items.AddObject(FileName, TObject(NewItemStr(FileFullPath)));
    end;
    FreeMem(lpEntryInfo);

    //次のエントリの情報を取得
    repeat
      //情報の取得に必要なサイズを取得
      dwEntrySize := 0;
      FindNextUrlCacheEntry(hCache, TInternetCacheEntryInfo(nil^), dwEntrySize);
      dwLastError := GetLastError;
      //メモリを確保して，実際に情報を取得
      if dwLastError = ERROR_INSUFFICIENT_BUFFER then begin
        GetMem(lpEntryInfo, dwEntrySize);
        if FindNextUrlCacheEntry(hCache, lpEntryInfo^, dwEntrySize) then begin
          //名前とローカルファイルのパス名を取得してListBox1のItemに格納
          FileFullPath := lpEntryInfo^.lpszLocalFileName;
          FileName     := ExtractFileName(FileFullPath);
          FileExt      := UpperCase(ExtractFileExt(FileName));
          if (FileExt = '.GIF') or (FileExt = '.JPG') or (FileExt = '.PNG') then begin
            ListBox1.Items.AddObject(FileName, TObject(NewItemStr(FileFullPath)));
          end;
        end;
        FreeMem(lpEntryInfo);
      end;
    until dwLastError = ERROR_NO_MORE_ITEMS;
    FindCloseUrlCache(hCache);
  end else begin
    FreeMem(lpEntryInfo);
  end;

  ListBox1.Items.EndUpdate;
  Screen.Cursor := crDefault;
  Label1.Caption := '総数 :  ' + IntToStr(ListBox1.Items.Count);
end;

//=============================================================================
//  Listbox1のItemを選択したら，該当する画像をTImageに表示
//=============================================================================
procedure TForm1.ListBox1Click(Sender: TObject);
var
  AIndex   : Integer;
  FilePath : String;
  WIC      : TWICImage;
begin
  Image1.Picture.Assign(nil);
  AIndex := ListBox1.ItemIndex;
  if AIndex < 0 then exit;

  FilePath := PString(ListBox1.Items.Objects[AIndex])^;
  WIC := TWICImage.Create;
  try
    WIC.LoadFromFile(FilePath);
    Image1.Picture.Assign(WIc);
  finally
    FreeAndNil(WIC);
  end;
end;

end.



04_IE のクッキーのリストを取得


本ページの最初のサンプルでは，クッキーの分を取得対象から除外していました．今度は，IE のキャッシュ内のクッキーの分だけを取得してみます．
取得したクッキーのファイル名を選択すると，その内容を TMemo に表示します．


図7
設計時画面
図8
実行結果
  • 選択したクッキーファイルの内容を表示

リスト4
IE のクッキーのリストを取得		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Label1: TLabel;
    Splitter1: TSplitter;
    ListBox1: TListBox;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ListBox1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses WinInet;

{$R *.dfm}

//=============================================================================
//  フォームを閉じる時はTListboxのObjectのオブジェクトも解放
//=============================================================================
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
  i : Integer;
begin
  for i := 0 to ListBox1.Items.Count - 1 do begin
    Dispose(PString(ListBox1.Items.Objects[i]));
  end;
end;

//=============================================================================
//  IEのキャッシュからクッキーの情報を取得
//  usesにWinInetが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);

  //---------------------------------------------------------------------------
  //  TListBoxのObjectプロパティに格納する文字列を生成
  //---------------------------------------------------------------------------
  function NewItemStr(S: String): PString;
  begin
    New(Result);
    Result^ := S;
  end;
  //---------------------------------------------------------------------------

var
  lpEntryInfo  : PInternetCacheEntryInfo;
  hCache       : Cardinal;
  dwEntrySize  : Cardinal;
  dwLastError  : Cardinal;
  FileFullPath : string;
  FileName     : String;
  FileExt      : String;
begin
  Screen.Cursor := crHourGlass;
  ListBox1.Items.BeginUpdate;
  ListBox1.Items.Clear;

  //最初のエントリの情報取得に必要なサイズをdwEntrySizeに取得
  dwEntrySize := 0;
  FindFirstUrlCacheEntry('cookie:', TInternetCacheEntryInfo(nil^), dwEntrySize);
  //メモリを確保して最初のエントリの情報を取得
  GetMem(lpEntryInfo, dwEntrySize);
  hCache := FindFirstUrlCacheEntry('cookie:', lpEntryInfo^, dwEntrySize);

  if hCache <> 0 then begin
    //名前とローカルファイルのパス名を取得してListBox1のItemに格納
    FileFullPath := lpEntryInfo^.lpszLocalFileName;
    FileName     := ExtractFileName(FileFullPath);
    FileExt      := UpperCase(ExtractFileExt(FileName));
    ListBox1.Items.AddObject(FileName, TObject(NewItemStr(FileFullPath)));
    FreeMem(lpEntryInfo);

    //次のエントリの情報を取得
    repeat
      //情報の取得に必要なサイズを取得
      dwEntrySize := 0;
      FindNextUrlCacheEntry(hCache, TInternetCacheEntryInfo(nil^), dwEntrySize);
      dwLastError := GetLastError;
      //メモリを確保して，実際に情報を取得
      if dwLastError = ERROR_INSUFFICIENT_BUFFER then begin
        GetMem(lpEntryInfo, dwEntrySize);
        if FindNextUrlCacheEntry(hCache, lpEntryInfo^, dwEntrySize) then begin
          //名前とローカルファイルのパス名を取得してListBox1のItemに格納
          FileFullPath := lpEntryInfo^.lpszLocalFileName;
          FileName     := ExtractFileName(FileFullPath);
          FileExt      := UpperCase(ExtractFileExt(FileName));
          ListBox1.Items.AddObject(FileName, TObject(NewItemStr(FileFullPath)));
        end;
        FreeMem(lpEntryInfo);
      end;
    until dwLastError = ERROR_NO_MORE_ITEMS;
    FindCloseUrlCache(hCache);
  end else begin
    FreeMem(lpEntryInfo);
  end;

  ListBox1.Items.EndUpdate;
  Screen.Cursor := crDefault;
  Label1.Caption := '総数 :  ' + IntToStr(ListBox1.Items.Count);
end;

//=============================================================================
//  Listbox1のItemを選択したら，該当するクッキーファイルの内容を表示
//=============================================================================
procedure TForm1.ListBox1Click(Sender: TObject);
var
  AIndex   : Integer;
  FilePath : String;
begin
  Memo1.Lines.Clear;

  AIndex := ListBox1.ItemIndex;
  if AIndex < 0 then exit;

  Memo1.Lines.BeginUpdate;

  FilePath := PString(ListBox1.Items.Objects[AIndex])^;
  Memo1.Lines.LoadFromFile(FilePath);

  Memo1.Lines.EndUpdate;
end;

end.



05_IE の履歴のリストを取得


IE のキャッシュ内の履歴を取得します．表示するのは，インターネットアドレスです．
表示中の項目をダブルクリックすると，その URL を，既定のブラウザで表示します．
このサンプルでは，ローカルのファイルの場合，日本語部分は文字化けします．原因と対処方法については不明です．次項の IUrlHistoryStg インターフェイス使用 を使用する方法では文字化けは確認していません．発生しないようです．


  • 図9
  • 設計時画面

  • 図10
  • 実行例

リスト5
IE の履歴のリストを取得		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Label1: TLabel;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses WinInet, ShellAPI;

{$R *.dfm}

//=============================================================================
//  IEの履歴のリストを取得
//  usesにWinInetが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  lpEntryInfo  : PInternetCacheEntryInfo;
  hCache       : Cardinal;
  dwEntrySize  : Cardinal;
  dwLastError  : Cardinal;
  UrlPath      : String;
begin
  Screen.Cursor := crHourGlass;
  ListBox1.Items.BeginUpdate;
  ListBox1.Items.Clear;

  //最初のエントリの情報取得に必要なサイズをdwEntrySizeに取得
  dwEntrySize := 0;
  FindFirstUrlCacheEntry('visited:', TInternetCacheEntryInfo(nil^), dwEntrySize);
  //メモリを確保して最初のエントリの情報を取得
  GetMem(lpEntryInfo, dwEntrySize);
  hCache := FindFirstUrlCacheEntry('visited:', lpEntryInfo^, dwEntrySize);

  if hCache <> 0 then begin
    //URLのアドレスをListBox1のItemに格納
    UrlPath := lpEntryInfo^.lpszSourceUrlName;
    ListBox1.Items.Add(UrlPath);
    FreeMem(lpEntryInfo);

    //次のエントリの情報を取得
    repeat
      //情報の取得に必要なサイズを取得
      dwEntrySize := 0;
      FindNextUrlCacheEntry(hCache, TInternetCacheEntryInfo(nil^), dwEntrySize);
      dwLastError := GetLastError;
      //メモリを確保して，実際に情報を取得
      if dwLastError = ERROR_INSUFFICIENT_BUFFER then begin
        GetMem(lpEntryInfo, dwEntrySize);
        if FindNextUrlCacheEntry(hCache, lpEntryInfo^, dwEntrySize) then begin
          //URLのアドレスをListBox1のItemに格納
          UrlPath := lpEntryInfo^.lpszSourceUrlName;
          ListBox1.Items.Add(UrlPath);
        end;
        FreeMem(lpEntryInfo);
      end;
    until dwLastError = ERROR_NO_MORE_ITEMS;
    FindCloseUrlCache(hCache);
  end else begin
    FreeMem(lpEntryInfo);
  end;

  ListBox1.Items.EndUpdate;
  Screen.Cursor := crDefault;
  Label1.Caption := '総数 :  ' + IntToStr(ListBox1.Items.Count);
end;

//=============================================================================
//  Listbox1のItemを選択したら，該当URLのページを既定のブラウザで表示
//  usesにShellAPIが必要
//=============================================================================
procedure TForm1.ListBox1DblClick(Sender: TObject);
var
  AIndex   : Integer;
  iPos     : Integer;
  UrlPath : String;
begin
  AIndex := ListBox1.ItemIndex;
  if AIndex < 0 then exit;

  UrlPath := ListBox1.Items[AIndex];

  iPos := Pos('@', UrlPath);
  if iPos > 0 then begin
    UrlPath := Copy(UrlPath, iPos + 1, Length(UrlPath));
    ShellExecute(0, 'open', PChar(UrlPath), nil, nil,SW_SHOW);
  end;
end;

end.



06_IE の履歴のリストを取得  -  IUrlHistoryStg インターフェイス使用


同じく履歴のリストを取得するサンプルですが，IUrlHistoryStg インターフェイス使用する例です．
IUrlHistoryStg インターフェイスのオブジェクトを生成して，EnumStatURL で列挙します．
本サンプルでは，STATURL 構造体の pwcsUrl の値である URL だけをリスト表示しています．

上のサンプルでは，ローカルファイルの日本語が文字化けしましたが，本サンプルの方法では文字化けしないようです．このサンプルコードは，Delphi XE 以降専用です．


  • 図11
  • 実行例

リスト6
IE の履歴のリストを取得 - IUrlHistoryStg インターフェイス使用		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Label1: TLabel;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ShellAPI, ComObj, ShlObj, UrlHist;

{$R *.dfm}

//=============================================================================
//  IEの履歴のリストを取得
//  IUrlHistoryStgインターフェイスを使用してIEnumStatURLで列挙
//  usesにComObj, ShlObj, UrlHistが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  UrlHistoryStg : IUrlHistoryStg;
  EnumStatURL   : IEnumStatURL;
  StatURL       : TStatURL;
  iFetched      : ULONG;
begin
  Screen.Cursor := crHourGlass;
  ListBox1.Items.BeginUpdate;
  ListBox1.Items.Clear;

  //IUrlHistoryStgオブジェクトを生成
  UrlHistoryStg := CreateComObject(CLSID_CUrlHistory) as IUrlHistoryStg;

  if UrlHistoryStg.EnumUrls(EnumStatURL) = S_OK then begin
    //フィルタ処理．必要なければこのSetFilterは不要
    //EnumStatURL.SetFilter('https', STATURL_QUERYFLAG_TOPLEVEL);
    while EnumStatURL.Next(1, StatURL, iFetched) = S_OK do begin
      if iFetched = 1 then ListBox1.Items.Add(StatURL.pwcsUrl);
    end;
  end;

  ListBox1.Items.EndUpdate;
  Screen.Cursor := crDefault;
  Label1.Caption := '総数 :  ' + IntToStr(ListBox1.Items.Count);
end;

//=============================================================================
//  Listbox1のItemを選択したら，該当URLのページを既定のブラウザで表示
//  usesにShellAPIが必要
//=============================================================================
procedure TForm1.ListBox1DblClick(Sender: TObject);
var
  AIndex  : Integer;
  UrlPath : String;
begin
  AIndex := ListBox1.ItemIndex;
  if AIndex < 0 then exit;

  UrlPath := ListBox1.Items[AIndex];
  ShellExecute(0, 'open', PChar(UrlPath), nil, nil, SW_SHOW);
end;

end.



07_IE のキャッシュのクッキー以外を削除


IE のキャッシュをクリア，削除します．ただし，クッキーの情報は削除しないようにしています．


図12
設計時画面

リスト7
IE のキャッシュのクッキー以外を削除		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses WinInet;

{$R *.dfm}

//=============================================================================
//  IEのキャッシュを削除
//  Cookieの分は除外
//  usesにWinInetが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);

  //---------------------------------------------------------------------------
  //  キャッシュの最初のエントリの操作
  //  成功するとS_OK を返し，引数にキャッシュのハンドルの値を返す
  //  このハンドルを次のエントリの検索に使用する
  //---------------------------------------------------------------------------
  function DeleteFirstCacheEntry(var hCache: Cardinal): DWORD;
  var
    lpEntryInfo : PInternetCacheEntryInfo;
    dwEntrySize : Cardinal;
  begin
    Result := S_OK;

    //キャッシャのファイルの情報取得に必要なサイズをdwEntrySizeに取得
    dwEntrySize := 0;
    FindFirstUrlCacheEntry(nil, TInternetCacheEntryInfo(nil^), dwEntrySize);
    //メモリを確保して最初のキャッシャのファイルの情報を取得
    GetMem(lpEntryInfo, dwEntrySize);
    try
      hCache := FindFirstUrlCacheEntry(nil, lpEntryInfo^, dwEntrySize);
      if (hCache = 0) then begin
        Result := GetLastError;
      end else begin
        //エントリを削除
        //Cookieの分は除く
        if (lpEntryInfo^.CacheEntryType and COOKIE_CACHE_ENTRY) = 0 then begin
          DeleteUrlCacheEntry(lpEntryInfo^.lpszSourceUrlname);
        end;
      end;
    finally
      FreeMem(lpEntryInfo);
    end;
  end;

  //---------------------------------------------------------------------------
  //  2番目以降のキャッシュのエントリを検索
  //  引数にはFindFirstUrlCacheEntry関数で取得したキャッシュのハンドル値を渡す
  //---------------------------------------------------------------------------
  function DeleteNextCacheEntry(hCache: THandle): DWORD;
  var
    lpEntryInfo : PInternetCacheEntryInfo;
    dwEntrySize : Cardinal;
  begin
    Result := S_OK;

    //情報の取得に必要なサイズを取得
    dwEntrySize := 0;
    FindNextUrlCacheEntry(hCache, TInternetCacheEntryInfo(nil^), dwEntrySize);
    //メモリを確保して，実際に情報を取得
    GetMem(lpEntryInfo, dwEntrySize);
    try
      if not FindNextUrlCacheEntry(hCache, lpEntryInfo^, dwEntrySize) then begin
        Result := GetLastError;
      end else begin
        //エントリを削除
        //Cookieの分は除く
        if (lpEntryInfo^.CacheEntryType and COOKIE_CACHE_ENTRY) = 0 then begin
          DeleteUrlCacheEntry(lpEntryInfo^.lpszSourceUrlname);
        end;
      end;
    finally
      FreeMem(lpEntryInfo);
    end;
  end;
  //---------------------------------------------------------------------------

var
  hCache : Cardinal;
begin
  Screen.Cursor := crHourGlass;

  if DeleteFirstCacheEntry(hCache) = S_OK then begin
    repeat
    until DeleteNextCacheEntry(hCache) = ERROR_NO_MORE_ITEMS;
    FindCloseUrlCache(hCache);
  end;

  Screen.Cursor := crDefault;
  MessageBox(Handle, '削除しました', '結果', MB_ICONINFORMATION);
end;

end.



08_IE のクッキーを削除


IE のキャッシュのクッキーだけを削除するサンプルです．


図13
設計時画面

リスト8
IE のクッキーを削除		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses WinInet;

{$R *.dfm}

//=============================================================================
//  IEのクッキーを削除
//  usesにWinInetが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);

  //---------------------------------------------------------------------------
  //  キャッシュの最初のエントリの操作
  //  Cardinalには以下の値をを渡す
  //  空文字   全てのキャッシュを削除する場合
  //  cookie:  クッキーの削除する場合(最後がコロンなので注意)
  //  visited: 履歴を削除する場合(最後がコロンなので注意)
  //
  //  成功するとS_OK を返し，引数にキャッシュのハンドルの値を返す
  //  このハンドルを次のエントリの検索に使用する
  //---------------------------------------------------------------------------
  function DeleteFirstCacheEntryEx(var hCache: Cardinal; CacheKind: String): DWORD;
  var
    lpEntryInfo : PInternetCacheEntryInfo;
    dwEntrySize : Cardinal;
  begin
    Result := S_OK;

    //キャッシャのファイルの情報取得に必要なサイズをdwEntrySizeに取得
    dwEntrySize := 0;
    FindFirstUrlCacheEntry(PChar(CacheKind), TInternetCacheEntryInfo(nil^), dwEntrySize);
    //メモリを確保して最初のキャッシャの情報を取得
    GetMem(lpEntryInfo, dwEntrySize);
    try
      hCache := FindFirstUrlCacheEntry(PChar(CacheKind), lpEntryInfo^, dwEntrySize);
      if (hCache = 0) then begin
        Result := GetLastError;
      end else begin
        //エントリを削除
        DeleteUrlCacheEntry(lpEntryInfo^.lpszSourceUrlname);
      end;
    finally
      FreeMem(lpEntryInfo);
    end;
  end;

  //---------------------------------------------------------------------------
  //  2番目以降のキャッシュのエントリを検索
  //  引数にはFindFirstUrlCacheEntry関数で取得したキャッシュのハンドル値を渡す
  //---------------------------------------------------------------------------
  function DeleteNextCacheEntryEx(hCache: THandle): DWORD;
  var
    lpEntryInfo : PInternetCacheEntryInfo;
    dwEntrySize : Cardinal;
  begin
    Result := S_OK;

    //情報の取得に必要なサイズを取得
    dwEntrySize := 0;
    FindNextUrlCacheEntry(hCache, TInternetCacheEntryInfo(nil^), dwEntrySize);
    //メモリを確保して，実際に情報を取得
    GetMem(lpEntryInfo, dwEntrySize);
    try
      if not FindNextUrlCacheEntry(hCache, lpEntryInfo^, dwEntrySize) then begin
        Result := GetLastError;
      end else begin
        //エントリを削除
        DeleteUrlCacheEntry(lpEntryInfo^.lpszSourceUrlname);
      end;
    finally
      FreeMem(lpEntryInfo);
    end;
  end;
  //---------------------------------------------------------------------------

var
  hCache : Cardinal;
begin
  Screen.Cursor := crHourGlass;

  if DeleteFirstCacheEntryEx(hCache, 'cookie:') = S_OK then begin
    repeat
    until DeleteNextCacheEntryEx(hCache) = ERROR_NO_MORE_ITEMS;
    FindCloseUrlCache(hCache);
  end;

  Screen.Cursor := crDefault;
  MessageBox(Handle, '削除しました', '結果', MB_ICONINFORMATION);
end;

end.



09_IE の履歴を削除


IE のキャッシュの履歴を削除するサンプルです．


図14
設計時画面

リスト9
IE の履歴を削除		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses WinInet;

{$R *.dfm}

//=============================================================================
//  IEの履歴を削除
//  usesにWinInetが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);

  //---------------------------------------------------------------------------
  //  キャッシュの最初のエントリの操作
  //  Cardinalには以下の値をを渡す
  //  空文字   全てのキャッシュを削除する場合
  //  cookie:  クッキーの削除する場合(最後がコロンなので注意)
  //  visited: 履歴を削除する場合(最後がコロンなので注意)
  //
  //  成功するとS_OK を返し，引数にキャッシュのハンドルの値を返す
  //  このハンドルを次のエントリの検索に使用する
  //---------------------------------------------------------------------------
  function DeleteFirstCacheEntryEx(var hCache: Cardinal; CacheKind: String): DWORD;
  var
    lpEntryInfo : PInternetCacheEntryInfo;
    dwEntrySize : Cardinal;
  begin
    Result := S_OK;

    //キャッシャのファイルの情報取得に必要なサイズをdwEntrySizeに取得
    dwEntrySize := 0;
    FindFirstUrlCacheEntry(PChar(CacheKind), TInternetCacheEntryInfo(nil^), dwEntrySize);
    //メモリを確保して最初のキャッシャの情報を取得
    GetMem(lpEntryInfo, dwEntrySize);
    try
      hCache := FindFirstUrlCacheEntry(PChar(CacheKind), lpEntryInfo^, dwEntrySize);
      if (hCache = 0) then begin
        Result := GetLastError;
      end else begin
        //エントリを削除
        DeleteUrlCacheEntry(lpEntryInfo^.lpszSourceUrlname);
      end;
    finally
      FreeMem(lpEntryInfo);
    end;
  end;

  //---------------------------------------------------------------------------
  //  2番目以降のキャッシュのエントリを検索
  //  引数にはFindFirstUrlCacheEntry関数で取得したキャッシュのハンドル値を渡す
  //---------------------------------------------------------------------------
  function DeleteNextCacheEntryEx(hCache: THandle): DWORD;
  var
    lpEntryInfo : PInternetCacheEntryInfo;
    dwEntrySize : Cardinal;
  begin
    Result := S_OK;

    //情報の取得に必要なサイズを取得
    dwEntrySize := 0;
    FindNextUrlCacheEntry(hCache, TInternetCacheEntryInfo(nil^), dwEntrySize);
    //メモリを確保して，実際に情報を取得
    GetMem(lpEntryInfo, dwEntrySize);
    try
      if not FindNextUrlCacheEntry(hCache, lpEntryInfo^, dwEntrySize) then begin
        Result := GetLastError;
      end else begin
        //エントリを削除
        DeleteUrlCacheEntry(lpEntryInfo^.lpszSourceUrlname);
      end;
    finally
      FreeMem(lpEntryInfo);
    end;
  end;
  //---------------------------------------------------------------------------

var
  hCache : Cardinal;
begin
  Screen.Cursor := crHourGlass;

  if DeleteFirstCacheEntryEx(hCache, 'visited:') = S_OK then begin
    repeat
    until DeleteNextCacheEntryEx(hCache) = ERROR_NO_MORE_ITEMS;
    FindCloseUrlCache(hCache);
  end;

  Screen.Cursor := crDefault;
  MessageBox(Handle, '削除しました', '結果', MB_ICONINFORMATION);
end;

end.



10_IE の履歴を削除 -  IUrlHistoryStg2 インターフェイス使用


同じく履歴を削除するサンプルですが，IUrlHistoryStg2 インターフェイス使用する例です． IUrlHistoryStg2 のオブジェクトを生成して，ClearHistory メソッドで削除します．
このサンプルコードは，Delphi XE 以降専用です．


図15
設計時画面

リスト10
IE の履歴を削除 - IUrlHistoryStg2 インターフェイス使用		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ComObj, ShlObj, UrlHist;

{$R *.dfm}

//=============================================================================
//  IEの履歴を削除
//  IUrlHistoryStg2インターフェイスを使用
//  usesにComObj, ShlObj, UrlHistが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  HistoryStg : IUrlHistoryStg2;
begin
  Screen.Cursor := crHourGlass;

  //IUrlHistoryStg2オブジェクトを生成
  HistoryStg := CreateComObject(CLSID_CUrlHistory) as IUrlHistoryStg2;
  //履歴をクリア
  HistoryStg.ClearHistory;

  Screen.Cursor := crDefault;
  MessageBox(Handle, '削除しました', '結果', MB_ICONINFORMATION);
end;

end.



11_日付時刻メンバーの値は変換が必要


キャッシャのエントリの情報には，日付時刻の値がいくつかあります．これらの値は TFileTime 型となっています．Delphi の TDateTime 型にするには変換が必要です．
下のコードはその例です．キャッシュの履歴を取得して，ウェブページのタイトルと取得日時を取得します．TFileTime 型から TDateTime 型に変換する関数を作成して使用しています．


[備考]
下の図は，履歴を削除した後，Google で Delphi という語句を 50 件検索した結果を，連続して表示した時の履歴を表示したものです．取得数が 50 よりも多いのは，ウェブページが別のファイルを読み込んでいるためです．それらのファイルに必ずしも html タグがあるとは限りません．


図16
実行結果

リスト11
日付時刻のメンバーの値を TDateTime 型に変換する例		 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Label1: TLabel;
    ListView1: TListView;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses ComObj, ShlObj, UrlHist;

{$R *.dfm}

//=----------------------------------------------------------------------------
//  TFileTime型の値をDelphiのTDateTime型に変換する関数
//=----------------------------------------------------------------------------
function FileTimeToDateTime(ATime: TFileTime): TDateTime;
var
  SystemTime : TSystemTime;
  TempTime   : TFileTime;
begin
  try
    //FileTime形式(世界協定時刻)を地域にあわせる
    FileTimeToLocalFileTime(ATime, TempTime);
    //FileTime形式をSystemTime形式にする
    FileTimeToSystemTime(TempTime, SystemTime);
    //SystemTime形式をDelphiのTDateTime形式に変換
    Result := SystemTimeToDateTime(SystemTime);
  except
    Result := 0;
  end;
end;

//=============================================================================
//  IEの履歴のリストを取得
//  IUrlHistoryStgインターフェイスを使用してIEnumStatURLで列挙
//
//  日付時刻メンバーの処理例
//  キャッシュのエントリ関係の構造体の日付実国はTFileTime型なので変換が必要
//  usesにComObj, ShlObj, UrlHistが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  aColumn       : TListColumn;
  aItem         : TListItem;
  UrlHistoryStg : IUrlHistoryStg;
  EnumStatURL   : IEnumStatURL;
  StatURL       : TStatURL;
  iFetched      : ULONG;
  VisitTime     : TDateTime;
begin
  Screen.Cursor := crHourGlass;

  ListView1.ViewStyle := vsReport;
  aColumn         := ListView1.Columns.Add;
  aColumn.Caption := 'タイトル';
  aColumn.Width   := 250;
  aColumn         := ListView1.Columns.Add;
  aColumn.Caption := '取得日時';
  aColumn.Width   := 120;

  ListView1.Items.BeginUpdate;
  ListView1.Items.Clear;

  //IUrlHistoryStgオブジェクトを生成
  UrlHistoryStg := CreateComObject(CLSID_CUrlHistory) as IUrlHistoryStg;

  if UrlHistoryStg.EnumUrls(EnumStatURL) = S_OK then begin
    while EnumStatURL.Next(1, StatURL, iFetched) = S_OK do begin
      if iFetched = 1 then begin
        aItem         := ListView1.Items.Add;
        aItem.Caption := StatURL.pwcsTitle;
        VisitTime     := FileTimeToDateTime(StatURL.ftLastVisited);
        aItem.SubItems.Add(DateTimeToStr(VisitTime));
      end;
    end;
  end;

  ListView1.Items.EndUpdate;
  Screen.Cursor := crDefault;
  Label1.Caption := '総数 :  ' + IntToStr(ListView1.Items.Count);
end;

end.