こんにちは、ぜえた です。

Internet Explorer(3.0以上)のキャッシュファイルを列挙するサンプルです。
バッファの処理がちょっと面倒なのでラッパーを作りました。

例として、キャッシュの中の URLをすべて列挙するものと、キャッシュされた
ローカルファイルの名前から、元の URLを取得するものをあげます。

参照：
  http://msdn.microsoft.com/workshop/networking/wininet/overview/cache.asp
  nifty:FDELPHI/MES/11/8971 のツリー。

uses WinInet;

type
  TEnumCacheFilesProc = function(lpCacheEntry: PInternetCacheEntryInfo;
    Param: Pointer): Boolean; //列挙を続けるには Trueを返すこと。

function EnumCacheFiles(lpszUrlSearchPattern: PAnsiChar;
    Proc: TEnumCacheFilesProc; Param: Pointer): Boolean;
label
  again, retry;
var
  dwStructSize: DWORD;
  dwEntrySize: DWORD;
  lpCacheEntry: PInternetCacheEntryInfo;
  hCacheDir: THandle;
begin
  dwStructSize := MAX_CACHE_ENTRY_INFO_SIZE;
  dwEntrySize := dwStructSize;
  GetMem(lpCacheEntry, dwEntrySize);
  hCacheDir := 0;
  try
    lpCacheEntry^.dwStructSize := dwEntrySize;
again:
    hCacheDir := FindFirstUrlCacheEntry(lpszUrlSearchPattern, lpCacheEntry^,
                                        dwEntrySize);
    if hCacheDir = 0 then begin
      case GetLastError of
        ERROR_NO_MORE_ITEMS: begin
          //列挙が終わったので、正常終了。
          Result := True;
          Exit;
        end;
        ERROR_INSUFFICIENT_BUFFER: begin
          //バッファの容量が足りないので、増やしてリトライ。
          dwStructSize := dwEntrySize;
          ReallocMem(lpCacheEntry, dwEntrySize);
          lpCacheEntry^.dwStructSize := dwStructSize;
          goto again;
        end;
      else
        //不明なエラー、異常終了。
        Result := False;
        Exit;
      end;
    end;
    while True do begin
      if not Proc(lpCacheEntry, Param) then begin
        //Procから Falseが返ったので、列挙を中止し、終了。
        Result := True;
        Exit;
      end;
      dwEntrySize := dwStructSize;
retry:
      if not FindNextUrlCacheEntry(hCacheDir, lpCacheEntry^,
                                   dwEntrySize) then begin
        case GetLastError of
          ERROR_NO_MORE_ITEMS: begin
            //列挙が終わったので、正常終了。
            Result := True;
            Exit;
          end;
          ERROR_INSUFFICIENT_BUFFER: begin
            //バッファの容量が足りないので、増やしてリトライ。
            dwStructSize := dwEntrySize;
            ReallocMem(lpCacheEntry, dwEntrySize);
            lpCacheEntry^.dwStructSize := dwStructSize;
            goto retry;
          end;
        else
          //不明なエラー、異常終了。
          Result := False;
          Exit;
        end;
      end;
    end;
  finally
    FindCloseUrlCache(hCacheDir);
    FreeMem(lpCacheEntry);
  end;
end;

//●例１：キャッシュの中の URLをすべて列挙する。
function AddUrl(lpCacheEntry: PInternetCacheEntryInfo;
   Param: Pointer): Boolean;
begin
  Result := True;
  with lpCacheEntry^ do begin
    if (CacheEntryType and NORMAL_CACHE_ENTRY <> 0) then begin
      TStrings(Param).Add(lpszSourceUrlName);
    end;
  end;
end;

procedure GetCachedUrls(Urls: TStrings);
begin
  Urls.BeginUpdate;
  try
    EnumCacheFiles(nil, AddUrl, Urls);
  finally
    Urls.EndUpdate;
  end;
end;

//●例２：ローカルファイル名から、元の URLを取得する。
type
  PSearchCacheFileNameParam = ^TSearchCacheFileNameParam;
  TSearchCacheFileNameParam = record
    CacheFileName: string;
    Url: string;
  end;

function SearchCacheFileName(lpCacheEntry: PInternetCacheEntryInfo;
   Param: Pointer): Boolean;
begin
  Result := True;
  with lpCacheEntry^, PSearchCacheFileNameParam(Param)^ do begin
    if (CacheEntryType and NORMAL_CACHE_ENTRY <> 0) then begin
      if AnsiCompareFileName(lpszLocalFileName, CacheFileName) = 0 then begin
        Url := lpszSourceUrlName;
        Result := False;
      end;
    end;
  end;
end;

function CacheFileNameToSourceUrl(const CacheFileName: string): 
string;
var
  Param: TSearchCacheFileNameParam;
begin
  Param.CacheFileName := CacheFileName;
  Param.Url := '';
  EnumCacheFiles(nil, SearchCacheFileName, @Param);
  Result := Param.Url;
end;

                                                    ぜえた (QZC05100)
 



Original document by ぜえた          氏 ID:(QZC05100)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。