{$WARNINGS OFF}

unit Unit1;

interface

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

type
TForm1 = class(TForm)
   Panel3: TPanel;
   ListBox1: TListBox;
   sbA: TScrollBox;
   Image1: TImage;
   Panel1: TPanel;
   Panel2: TPanel;
   SpeedButton1: TSpeedButton;
   SpeedButton2: TSpeedButton;
   PopupMenu1: TPopupMenu;
   Cookies1: TMenuItem;
   N1: TMenuItem;
   N3: TMenuItem;
   N4: TMenuItem;
   N5: TMenuItem;
   N6: TMenuItem;
   JPG1: TMenuItem;
   BMP1: TMenuItem;
   GIF1: TMenuItem;
   N2: TMenuItem;
   N7: TMenuItem;
   N8: TMenuItem;
   N9: TMenuItem;
   N10: TMenuItem;
   N11: TMenuItem;
   N12: TMenuItem;
   N13: TMenuItem;

   procedure ListBox1Click(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure SpeedButton1Click(Sender: TObject);
   procedure SpeedButton2Click(Sender: TObject);
   procedure FormResize(Sender: TObject);
   procedure FormShow(Sender: TObject);
   procedure Cookies1Click(Sender: TObject);
   procedure N1Click(Sender: TObject);
   procedure N13Click(Sender: TObject);
private
   procedure GetInternetCacheFiles(AList: TStringList);
   procedure DeleteInternetCacheFiles;
   procedure DisposeListBoxObject;
   procedure BList(Sender: TObject);
public
   end;

type
TSTATURL = record
   cbSize: DWORD;
   pwcsUrl: DWORD;
   pwcsTitle: DWORD;
   ftLastVisited: FILETIME;
   ftLastUpdated: FILETIME;
   ftExpires: FILETIME;
   dwFlags: DWORD;
end;

IEnumSTATURL = interface(IUnknown)
   ['{3C374A42-BAE4-11CF-BF7D-00AA006946EE}']
   function Next(celt: Integer; out elt; pceltFetched: PLongint): HRESULT; stdcall;
   function Skip(celt: Longint): 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: Integer): HResult; stdcall;
   function DeleteUrl(pocsUrl: PWideChar;
   dwFlags: Integer): HResult; stdcall;
   function QueryUrl(pocsUrl: PWideChar; dwFlags: Integer;
   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;

IUrlHistoryStg2 = interface(IUrlHistoryStg)
   ['{AFA0DC11-C313-11D0-831A-00C04FD5AE38}']
   function AddUrlAndNotify(pocsUrl: PWideChar; pocsTitle: PWideChar;
   dwFlags: Integer; fWriteHistory: Integer; var poctNotify: Pointer;
   const punkISFolder: IUnknown): HResult; stdcall;
   function ClearHistory: HResult; stdcall;
end;

var
Form1: TForm1;

implementation

uses jpeg, ComObj, WinInet, HTTPApp;

{$R *.dfm}

procedure ClearInternetExplorerHistroy;
const CLSID_CUrlHistory: TGUID = '{3C374A40-BAE4-11CF-BF7D-00AA006946EE}';
var
stg: IUrlHistoryStg2;
begin
stg := CreateComObject(CLSID_CUrlHistory) as IUrlHistoryStg2;
stg.ClearHistory;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
DisposeListBoxObject;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
var
AFilePath: string;
jpg: TJpegImage;
begin
if ListBox1.Items.Count = 0 then exit;

Caption := format('IE缓存图片查看器 [%d/%d]', [listbox1.itemindex + 1, listbox1.Count]);
AFilePath := PString(ListBox1.Items.Objects[ListBox1.ItemIndex])^;
Image1.Picture.Assign(nil);
Jpg := TJpegImage.Create;
Jpg.LoadFromFile(AFilePath);

sbA.HorzScrollBar.Position := jpg.Width; //
sbA.VertScrollBar.Position := jpg.Height;
Image1.Width := jpg.Width; //
Image1.Height := jpg.Height;
Image1.Top := (sba.height - jpg.Height) div 2;
Image1.Left := (sba.width - jpg.Width) div 2;
Image1.Picture.Assign(jpg);
jpg.free;
end;

procedure TForm1.DisposeListBoxObject;
var
i: integer;
begin
for i := 0 to ListBox1.Items.Count - 1 do begin
   Dispose(PString(ListBox1.Items.Objects[i]));
end;
end;

procedure TForm1.GetInternetCacheFiles(AList: TStringList);
var
lpEntryInfo: PInternetCacheEntryInfo;
hCacheDir: LongWord;
dwEntrySize: LongWord;
dwLastError: LongWord;
begin
AList.Clear;
dwEntrySize := 0;
FindFirstUrlCacheEntry(nil, TInternetCacheEntryInfo(nil^), dwEntrySize);
GetMem(lpEntryInfo, dwEntrySize);
hCacheDir := FindFirstUrlCacheEntry(nil, lpEntryInfo^, dwEntrySize);
if hCacheDir <> 0 then begin
  // lpEntryInfo^.LastModifiedTime
   AList.Add(string(lpEntryInfo^.lpszLocalFileName));
   FreeMem(lpEntryInfo);
   repeat
   dwEntrySize := 0;
   FindNextUrlCacheEntry(hCacheDir, TInternetCacheEntryInfo(nil^), dwEntrySize);
   dwLastError := GetLastError();
   if GetLastError = ERROR_INSUFFICIENT_BUFFER then begin
   GetMem(lpEntryInfo, dwEntrySize);
   if FindNextUrlCacheEntry(hCacheDir, lpEntryInfo^, dwEntrySize) then begin
   AList.Add(string(lpEntryInfo^.lpszLocalFileName));
   end;
   FreeMem(lpEntryInfo);
   end;
   until dwLastError = ERROR_NO_MORE_ITEMS;
end else begin
   FreeMem(lpEntryInfo);
end;
end;

procedure TForm1.DeleteInternetCacheFiles;
var
lpEntryInfo: PInternetCacheEntryInfo;
hCacheDir: LongWord;
dwEntrySize: LongWord;
dwLastError: LongWord;
begin
dwEntrySize := 0;
FindFirstUrlCacheEntry(nil, TInternetCacheEntryInfo(nil^), dwEntrySize);
GetMem(lpEntryInfo, dwEntrySize);
hCacheDir := FindFirstUrlCacheEntry(nil, lpEntryInfo^, dwEntrySize);
if hCacheDir <> 0 then begin
   if (lpEntryInfo^.CacheEntryType and COOKIE_CACHE_ENTRY) = 0 then begin
   DeleteUrlCacheEntry(lpEntryInfo^.lpszSourceUrlName);
   end;
   FreeMem(lpEntryInfo);

   repeat
   dwEntrySize := 0;
   FindNextUrlCacheEntry(hCacheDir, TInternetCacheEntryInfo(nil^), dwEntrySize);
   dwLastError := GetLastError();
   if GetLastError = ERROR_INSUFFICIENT_BUFFER then begin
   GetMem(lpEntryInfo, dwEntrySize);
   if FindNextUrlCacheEntry(hCacheDir, lpEntryInfo^, dwEntrySize) then begin
   if (lpEntryInfo^.CacheEntryType and COOKIE_CACHE_ENTRY) = 0 then begin
   DeleteUrlCacheEntry(lpEntryInfo^.lpszSourceUrlName);
   end;
   end;
   FreeMem(lpEntryInfo);
   end;
   until dwLastError = ERROR_NO_MORE_ITEMS;
end else begin
   FreeMem(lpEntryInfo);
end;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
if listbox1.ItemIndex < 1 then exit;
listbox1.ItemIndex := listbox1.ItemIndex - 1;
ListBox1Click(Sender);

end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin

if listbox1.ItemIndex = listbox1.items.count then exit;
listbox1.ItemIndex := listbox1.ItemIndex + 1;
ListBox1Click(Sender);
end;

procedure TForm1.BList(Sender: TObject);
var
APathList: TStringList;
AFileName: string;
i: Integer;
begin
if ListBox1.Items.Count = 0 then DisposeListBoxObject;
ListBox1.Items.Clear;
APathList := TStringList.Create;
try
   GetInternetCacheFiles(APathList);
   with ListBox1.Items do begin
   BeginUpdate;
   for i := 0 to APathList.Count - 1 do begin
   AFileName := UnixPathToDosPath(APathList[i]);
   if ExtractFileExt(AFileName) = '.jpg' then begin
   AddObject(ExtractFileName(AFileName), TObject(NewStr(AFileName)));
   end;
   end;
   EndUpdate;
   // Caption := format('IE缓存图片查看器 [%d/%d]', [listbox1.itemindex+1, listbox1.Count]);
   end;
finally
   FreeAndNil(APathList);
end;
listbox1.itemindex := 0;
ListBox1Click(Sender);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
panel2.Top := 0;
panel2.Left := panel1.width div 2 - panel2.Width div 2;
Image1.Top := (sba.height - Image1.Height) div 2;
Image1.Left := (sba.width - Image1.Width) div 2;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
BList(Sender);
end;

procedure TForm1.Cookies1Click(Sender: TObject);
begin
DeleteInternetCacheFiles;
end;

procedure TForm1.N1Click(Sender: TObject);
begin
ClearInternetExplorerHistroy;
end;

procedure TForm1.N13Click(Sender: TObject);
begin
if listbox1.Width = 0 then
begin
   listbox1.Width := 200 ;
   N13.Checked := true;
end else
begin
   listbox1.Width := 0;
   N13.Checked := false;
end;
Image1.Top := (sba.height - Image1.Height) div 2;
Image1.Left := (sba.width - Image1.Width) div 2;
end;

end.