Demo 2

 

 

unit Cacheunit;

interface

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

type
TForm1 = class(TForm)
ListBox1: TListBox;
RetrieveBtn: TButton;
Panel1: TPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
procedure ListBox1Click(Sender: TObject);
procedure RetrieveBtnClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;


function GetUrlCacheEntryInfo(lpszUrlName: PChar; lpCacheEntryInfo:
PInternetCacheEntryInfo; var lpdwCacheEntryInfoBufferSize: DWORD): BOOL; stdcall;

function FindFirstUrlCacheEntry(lpszUrlSearchPattern: PChar;
lpFirstCacheEntryInfo: PInternetCacheEntryInfo;
var lpdwFirstCacheEntryInfoBufferSize: DWORD): THandle; stdcall;

function FindNextUrlCacheEntry(hEnumHandle: THandle; lpNextCacheEntryInfo:
PInternetCacheEntryInfo; var lpdwNextCacheEntryInfoBufferSize: DWORD): BOOL; stdcall;


var
Form1: TForm1;


implementation

{$R *.DFM}


const
URLHISTORY_CACHE_ENTRY = $00200000;
winetdll = 'wininet.dll';

function FindFirstUrlCacheEntry; external winetdll name 'FindFirstUrlCacheEntryA';
function FindNextUrlCacheEntry; external winetdll name 'FindNextUrlCacheEntryA';
function GetUrlCacheEntryInfo; external winetdll name 'GetUrlCacheEntryInfoA';



function FileTimeToDt(Ft: TFileTime): string;
var
l: Integer;
lft: TFileTime;
begin
FileTimeToLocalFiletime(Ft, lft);
if FileTimeToDosDateTime(lft, Longrec(l).Hi, Longrec(l).Lo) then
result := DateTimeToStr(FiledateToDatetime(l)) else
result := '';
end;



procedure TForm1.ListBox1Click(Sender: TObject);
var
T: PInternetCacheEntryInfo;
D: Cardinal;
begin
D := 0;
GetUrlCacheEntryInfo(Pchar(Listbox1.Items[ListBox1.ItemIndex]), T, D); //Get BufferSize
GetMem(T, D);
GetUrlCacheEntryInfo(Pchar(Listbox1.Items[ListBox1.ItemIndex]), T, D);
Label1.Caption := 'Last time accessed: ' + FileTimeToDt(T^.LastAccessTime);
Label2.Caption := 'Last time syncronized: ' + FileTimeToDt(T^.LastSyncTime);
Label3.Caption := 'Last time modified: ' + FileTimeToDt(T^.LastModifiedTime);
Label4.Caption := 'Expires: ' + FileTimeToDt(T^.ExpireTime);
Label5.Caption := 'Visited: ' + IntToStr(T^.dwHitRate);
Label6.Caption := 'URL: ' + Copy(T^.lpszSourceUrlName, Pos('@', T^.lpszSourceUrlName) + 1, MAX_PATH);
FreeMem(T, D);
end;

procedure TForm1.RetrieveBtnClick(Sender: TObject);
var
T: PInternetCacheEntryInfo;
D: Cardinal;
H: THandle;
begin
D := 0;
H := FindFirstUrlCacheEntry(nil, nil, D); //Get bufferSize
GetMem(T, D);
if D > 0 then T^.dwStructSize := D;
H := FindFirstUrlCacheEntry(nil, T, D);
if GetLastError <> 0 then
repeat
if (T^.CacheEntryType = T^.CacheEntryType or URLHISTORY_CACHE_ENTRY) then
Listbox1.Items.Add(T^.lpszSourceUrlName);
Freemem(T, D);
D := 0;
FindNextUrlCacheEntry(H, nil, D); //Get BufferSize
GetMem(T, D);
if D > 0 then T^.dwStructSize := D;
until not FindNextUrlCacheEntry(H, T, D);
FreeMem(T, D);
FindCloseUrlCache(H);
Listbox1.ItemIndex := 0;
Listbox1Click(sender);
end;

end.