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 以降で使用可能です.
IE のキャッシュのリストを列挙するサンプルです.クッキーは取得しないようにしています.
リスト1
IE のキャッシュ内のリストを取得
このコードでは,クッキーを取得対象から除外している
copy code
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 のキャッシャフォルダ内のプロパティの項目名
copy code
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 .
IE のキャッシュ内の画像だけを取得します.取得するのは拡張子が .GIF, .JPG, .PNG の画像だけとしています.
取得した画像ファイル名を選択すると,その画像を TImage に表示します.
図5
設計時画面
図6
実行結果
リスト3
IE のキャッシュの画像だけを取得して表示
copy code
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 .
本ページの最初のサンプルでは,クッキーの分を取得対象から除外していました.今度は,IE のキャッシュ内のクッキーの分だけを取得してみます.
取得したクッキーのファイル名を選択すると,その内容を TMemo に表示します.
図7
設計時画面
図8
実行結果
copy code
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 .
IE のキャッシュ内の履歴を取得します.表示するのは,インターネットアドレスです.
表示中の項目をダブルクリックすると,その URL を,既定のブラウザで表示します.
このサンプルでは,ローカルのファイルの場合,日本語部分は文字化けします.原因と対処方法については不明です.次項の IUrlHistoryStg インターフェイス使用 を使用する方法では文字化けは確認していません.発生しないようです.
copy code
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 以降専用です.
リスト6
IE の履歴のリストを取得 - IUrlHistoryStg インターフェイス使用
copy code
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 .
IE のキャッシュをクリア,削除します.ただし,クッキーの情報は削除しないようにしています.
図12
設計時画面
copy code
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 .
IE のキャッシュのクッキーだけを削除するサンプルです.
図13
設計時画面
copy code
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 .
図14
設計時画面
copy code
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 インターフェイス使用
copy code
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 .
キャッシャのエントリの情報には,日付時刻の値がいくつかあります.これらの値は TFileTime 型となっています.Delphi の TDateTime 型にするには変換が必要です.
下のコードはその例です.キャッシュの履歴を取得して,ウェブページのタイトルと取得日時を取得します.TFileTime 型から TDateTime 型に変換する関数を作成して使用しています.
[備考]
下の図は,履歴を削除した後,Google で Delphi という語句を 50 件検索した結果を,連続して表示した時の履歴を表示したものです.取得数が 50 よりも多いのは,ウェブページが別のファイルを読み込んでいるためです.それらのファイルに必ずしも html タグがあるとは限りません.
図16
実行結果
リスト11
日付時刻のメンバーの値を TDateTime 型に変換する例
copy code
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 .