function AddUrlToGroup(GroupID: INT64;
Url: string): DWORD;
function RemoveUrlFromGroup(GroupID: INT64;
Url: string): DWORD;
function FindFirstGroup(var GroupID: Int64): DWORD;
function FindNextGroup(var GroupID: Int64): BOOL;
function RetrieveGroups: DWORD;
function CreateEntry(Url, FileExtension: string;
ExpectedFileSize: DWORD;
var FName: string): DWORD;
function DeleteEntry(Url: string): DWORD;
function FindFirstEntry(GroupID: INT64): DWORD;
function FindNextEntry: DWORD;
function CloseFindEntry: BOOL;
procedure RetrieveEntries(GroupID: INT64);
function GetEntryInfo(Url: string): DWORD;
function GetEntryContent(Url: string): DWORD;
function SetEntryInfo(Url: string): DWORD;
function getLibraryFound: boolean;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function initializeWinInet: boolean;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
var
fPointer: tFarProc;
hInst: tHandle;
begin
if winInetLibFound then
result := true else
begin
result := false;
hInst := loadLibrary(winetdll);
if hInst > 0 then
try
fPointer := getProcAddress(hInst, 'FindFirstUrlCacheGroup');
if fPointer <> nil then
begin
FindFirstUrlCacheGroup := tFindFirstUrlCacheGroup(fPointer);
fPointer := getProcAddress(hInst, 'FindNextUrlCacheGroup');
if fPointer <> nil then
begin
FindNextUrlCacheGroup := tFindNextUrlCacheGroup(fPointer);
fPointer := getProcAddress(hInst, 'GetUrlCacheGroupAttributeA');
if fPointer <> nil then
begin
GetUrlCacheGroupAttribute := tGetUrlCacheGroupAttribute(fPointer);
fPointer := getProcAddress(hInst, 'SetUrlCacheGroupAttributeA');
if fPointer <> nil then
begin
SetUrlCacheGroupAttribute := tSetUrlCacheGroupAttribute(fPointer);
fPointer := getProcAddress(hInst, 'FindFirstUrlCacheEntryExA');
if fPointer <> nil then
result := true;
end;
// SetUrlCacheGroupAttribute
end;
// GetUrlCacheGroupAttribute
end;
// FindNextUrlCacheGroup
end;
// FindFirstUrlCacheGroup
except
end;
// loadLib
winInetLibFound := result;
end;
end;
// function initializeWinInet : boolean;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function FileTimeToDateTime(Ft: TFileTime): TDateTime;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
var
St: TSystemTime;
lft: TFileTime;
begin
result := 0;
try
if FileTimeToLocalFiletime(Ft, lft) then
if FileTimeToSyStemTime(lft, st) then
Result := SystemTimeTODateTime(st);
except
end;
end;
// function FileTimeToDateTime(Ft: TFileTime): TDateTime;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function DateTimeToFileTime(Dt: TDateTime): TFileTime;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
var
St: TSystemTime;
lft: TFileTime;
begin
try
DateTimeToSystemTime(Dt, ST);
if SystemTimeToFileTime(st, lft) then
LocalFileTimeToFileTime(lft, Result);
except
result.dwLowDateTime := 0;
result.dwHighDateTime := 0;
end;
end;
// function DateTimeToFileTime(Dt: TDateTime): TFileTime;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function TIECache.getLibraryFound: boolean;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
begin
result := initializeWinInet;
end;
// function TIECache.getLibraryFound : boolean;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function TIECache.RemoveUrlFromGroup(GroupID: INT64;
Url: string): DWORD;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
begin
Result := S_OK;
if not initializeWinInet then
begin
Result := ERROR_FILE_NOT_FOUND;
Exit;
end;
if not SetUrlCacheEntryGroup(Pchar(Url), INTERNET_CACHE_GROUP_REMOVE, GroupID, nil, 0, nil)
then
Result := GetLastError;
end;
// function TIECache.RemoveUrlFromGroup(GroupID: INT64;
Url: string): DWORD;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function TIECache.AddUrlToGroup(GroupID: INT64;
Url: string): DWORD;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
begin
Result := S_OK;
if not initializeWinInet then
begin
Result := ERROR_FILE_NOT_FOUND;
Exit;
end;
if not SetUrlCacheEntryGroup(Pchar(Url), INTERNET_CACHE_GROUP_ADD, GroupID, nil, 0, nil)
then
Result := GetLastError;
end;
// function TIECache.AddUrlToGroup(GroupID: INT64;
Url: string): DWORD;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function TIECache.CopyFileToCache(Url, FileName: string;
CacheType: DWORD;
Expire: TDateTime): DWORD;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
var
FName: string;
Ext: string;
F: file of Byte;
Size: DWORD;
begin
if not initializeWinInet then
begin
Result := ERROR_FILE_NOT_FOUND;
Exit;
end;
if not FileExists(FileName) then
begin
Result := ERROR_FILE_NOT_FOUND;
Exit;
end;
AssignFile(F, FileName);
Reset(F);
Size := FileSize(F);
CloseFile(F);
Ext := ExtractFileExt(FileName);
Ext := Copy(Ext, 2, Length(ext));
Result := CreateEntry(Url, Ext, Size, FName);
if Result <> S_OK then
Exit;
if not windows.copyfile(PChar(FileName), Pchar(FName), FALSE) then
begin
Result := GetLastError;
Exit;
end;
if not CommitUrlCacheEntry(Pchar(Url), Pchar(Fname), DateTimeToFileTime(Expire), DateTimeToFileTime(now), CacheType, nil, 0, Pchar(Ext), 0)
then
Result := GetLastError;
end;
// function TIECache.CopyFileToCache(Url, FileName: string;
CacheType: DWORD;
Expire: TDateTime): DWORD;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function TIECache.CreateEntry(Url, FileExtension: string;
ExpectedFileSize: DWORD;
var FName: string): DWORD;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
var
PC: array[0..MAX_PATH] of Char;
begin
PC := '';
Result := S_OK;
if not initializeWinInet then
begin
Result := ERROR_FILE_NOT_FOUND;
Exit;
end;
if not CreateUrlCacheEntry(Pchar(url), ExpectedFileSize, Pchar(FileExtension), PC, 0) then
result := GetLastError else
FName := StrPas(PC);
end;
// function TIECache.CreateEntry(Url, FileExtension: string;
ExpectedFileSize: DWORD;
var FName: string): DWORD;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function TIECache.GetGroupInfo(GroupID: INT64): DWORD;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
var
info: TInternetCacheGroupInfo;
dw: DWORD;
begin
Result := S_OK;
if not initializeWinInet then
begin
Result := ERROR_FILE_NOT_FOUND;
Exit;
end;
dw := Sizeof(TInternetCacheGroupInfo);
if not GetUrlCacheGroupAttribute(GroupID, 0, CACHEGROUP_ATTRIBUTE_GET_ALL, info, dw, nil)
then
Result := GetLastError else
// function TIECache.GetGroupInfo(GroupID: INT64): DWORD;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function TIECache.SetGroupInfo(GroupID: INT64): DWORD;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
var
info: TInternetCacheGroupInfo;
begin
Result := S_OK;
if not initializeWinInet then
begin
Result := ERROR_FILE_NOT_FOUND;
Exit;
end;
info.dwGroupSize := SizeOf(Info);
info.dwGroupFlags := CACHEGROUP_FLAG_NONPURGEABLE;
info.dwGroupType := CACHEGROUP_TYPE_INVALID;
info.dwDiskQuota := GroupInfo.DiskQuota;
move(GroupInfwnerStorage, info.dwOwnerStorage, Sizeof(info.dwOwnerStorage));
move(GroupInfo.Groupname[1], info.szGroupName[0], length(GroupInfo.Groupname));
if not SetUrlCacheGroupAttribute(GroupID, 0, CACHEGROUP_READWRITE_MASK, info, nil)
then
Result := GetLastError;
end;
// function TIECache.SetGroupInfo(GroupID: INT64): DWORD;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function TIECache.CreateGroup: INT64;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
begin
if not initializeWinInet then
begin
Result := ERROR_FILE_NOT_FOUND;
Exit;
end;
Result := CreateUrlCacheGroup(0, nil);
end;
// function TIECache.CreateGroup: INT64;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function TIECache.DeleteGroup(GroupID: INT64): DWORD;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
begin
Result := S_OK;
if not initializeWinInet then
begin
Result := ERROR_FILE_NOT_FOUND;
Exit;
end;
if not DeleteUrlCacheGroup(GroupID, CACHEGROUP_FLAG_FLUSHURL_ONDELETE, nil)
then
Result := GetLastError;
end;
// function TIECache.DeleteGroup(GroupID: INT64): DWORD;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function TIECache.SetEntryInfo(Url: string): DWORD;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
var
info: TInternetCacheEntryInfo;
fc: DWORD;
begin
Result := S_OK;
if not initializeWinInet then
begin
Result := ERROR_FILE_NOT_FOUND;
Exit;
end;
fc := CACHE_ENTRY_ATTRIBUTE_FC +
CACHE_ENTRY_HITRATE_FC +
CACHE_ENTRY_MODTIME_FC +
CACHE_ENTRY_EXPTIME_FC +
CACHE_ENTRY_ACCTIME_FC +
CACHE_ENTRY_SYNCTIME_FC +
CACHE_ENTRY_EXEMPT_DELTA_FC;
with infodo
if not SetUrlCacheEntryInfo(Pchar(url), info, fc) then
Result := GetLastError;
end;
// function TIECache.SetEntryInfo(Url: string): DWORD;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function TIECache.GetEntryInfo(Url: string): DWORD;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
var
D: DWORD;
T: PInternetCacheEntryInfo;
begin
Result := S_OK;
if not initializeWinInet then
begin
Result := ERROR_FILE_NOT_FOUND;
Exit;
end;
GetUrlCacheEntryInfoEx(Pchar(Url), nil, @D, nil, nil, nil, 0);
GetMem(T, D);
try
if GetUrlCacheEntryInfoEx(Pchar(Url), T, @D, nil, nil, nil, 0)
then
GetEntryValues(t) else
Result := GetLastError;
finally
Freemem(T, D);
end;
end;
// function TIECache.GetEntryInfo(Url: string): DWORD;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function TIECache.GetEntryContent(Url: string): DWORD;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
var
Hr: THandle;
D: Cardinal;
T: PInternetCacheEntryInfo;
begin
result := S_OK;
if not initializeWinInet then
begin
Result := ERROR_FILE_NOT_FOUND;
Exit;
end;
D := 0;
T:=nil;
RetrieveUrlCacheEntryStream(PChar(Url), T^, D, TRUE, 0);
Getmem(T, D);
try
hr := THandle(RetrieveUrlCacheEntryStream(PChar(Url), T^, D, TRUE, 0));
if Hr <> 0 then
begin
Content.BufferLength := T^.dwSizeLow + 1;
GetEntryValues(T);
Getmem(Content.Buffer, Content.BufferLength);
Fillchar(Content.Buffer^, Content.BufferLength, #0);
if not ReadUrlCacheEntryStream(Hr, 0, Content.Buffer, T^.DwSizeLow, 0)
then
Result := GetLastError;
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function TIECache.FindNextGroup(var GroupID: Int64): BOOL;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
begin
if not initializeWinInet then
begin
Result := false;
Exit;
end;
Result := FindNextUrlCacheGroup(GrpHandle, GroupID, nil);
GetGroupInfo(GroupID);
end;
// function TIECache.FindNextGroup(var GroupID: Int64): BOOL;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function TIECache.FindFirstGroup(var GroupID: Int64): DWORD;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
begin
if not initializeWinInet then
begin
Result := ERROR_FILE_NOT_FOUND;
Exit;
end;
GrpHandle := FindFirstUrlCacheGroup(0, 0, nil, 0, GroupID, nil);
if GrpHandle <> 0 then
result := S_OK else
Result := GetLastError;
if result = S_OK then
GetGroupInfo(GroupID);
end;
// function TIECache.FindFirstGroup(var GroupID: Int64): DWORD;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function TIECache.RetrieveGroups: DWORD;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
var
GroupID: INT64;
Res: DWORD;
NewGroup, Cancel: Boolean;
begin
Result := S_OK;
if not initializeWinInet then
begin
Result := ERROR_FILE_NOT_FOUND;
Exit;
end;
Cancel := False;
NewGroup := True;
Res := FindFirstGroup(GroupID);
if Res = S_OK then
begin
GetGroupInfo(GroupID);
if Assigned(FOngroup) then
FOnGroup(self, GroupID, FCancel);
while not Cancel and NewGroupdo
begin
NewGroup := FindNextGroup(GroupID);
GetGroupInfo(GroupID);
if Assigned(FOngroup) and NewGroup then
FOnGroup(self, GroupID, Cancel);
end;
end else
result := GetLastError;
end;
// function TIECache.RetrieveGroups: DWORD;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function TIECache.DeleteEntry(Url: string): DWORD;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
begin
Result := S_OK;
if not initializeWinInet then
exit;
if not DeleteUrlCacheEntry(PChar(Url)) then
Result := GetLastError
else
ClearEntryValues;
end;
// function TIECache.DeleteEntry(Url: string): DWORD;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TIECache.ClearAllEntries;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
var
hr: DWord;
begin
if not initializeWinInet then
Exit;
if FindFirstEntry(0) = S_OK then
begin
repeat
DeleteEntry(EntryInfo.SourceUrlName);
hr := FindNextEntry;
until hr = ERROR_NO_MORE_ITEMS;
end;
FindCloseUrlCache(H);
end;
// procedure TIECache.ClearAllEntries;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TIECache.ClearEntryValues;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
begin
if not initializeWinInet then
Exit;
Content.Buffer := nil;
Content.BufferLength := 0;
with EntryInfodo
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function TIECache.FindFirstEntry(GroupID: INT64): DWORD;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
const
Pattern: array[TSearchPattern] of PChar = (nil, 'Cookie:', 'Visited:', '');
var
T: PInternetCacheEntryInfo;
D: DWORD;
begin
Result := S_OK;
if not initializeWinInet then
begin
Result := ERROR_FILE_NOT_FOUND;
Exit;
end;
H := 0;
D := 0;
FindFirstUrlCacheEntryEx(Pattern[SearchPattern], 0, FFilterOptionValue, GroupID, nil, @D, nil, nil, nil);
GetMem(T, D);
try
H := FindFirstUrlCacheEntryEx(Pattern[SearchPattern], 0, FFilterOptionValue, GroupID, T, @D, nil, nil, nil);
if (H = 0) then
Result := GetLastError else
GetEntryValues(T);
finally
FreeMem(T, D)
end;
end;
// function TIECache.FindFirstEntry(GroupID: INT64): DWORD;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function TIECache.FindNextEntry: DWORD;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
var
T: PInternetCacheEntryInfo;
D: DWORD;
begin
Result := S_OK;
if not initializeWinInet then
begin
Result := ERROR_FILE_NOT_FOUND;
Exit;
end;
D := 0;
FindnextUrlCacheEntryEx(H, nil, @D, nil, nil, nil);
GetMem(T, D);
try
if not FindNextUrlCacheEntryEx(H, T, @D, nil, nil, nil)
then
Result := GetLastError else
GetEntryValues(T);
finally
FreeMem(T, D)
end;
end;
// function TIECache.FindNextEntry: DWORD;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TIECache.RetrieveEntries(GroupID: INT64);
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
var
HR: DWORD;
begin
if not initializeWinInet then
Exit;
FCancel := False;
hr := FindFirstEntry(GroupID);
if (hr = S_OK) then
begin
if Assigned(FOnEntry) then
with EntryInfodo
FOnEntry(self, FCancel);
while (hr = S_OK) and not FCanceldo
begin
hr := FindNextEntry;
if (hr = S_OK) and Assigned(FOnEntry) then
with EntryInfodo
FOnEntry(self, FCancel);
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function TIECache.CloseFindEntry: BOOL;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
begin
if not initializeWinInet then
begin
Result := false;
Exit;
end;
Result := FindCloseUrlCache(H);
end;
// function TIECache.CloseFindEntry: BOOL;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TIECache.SetFilterOptions(const Value: TFilterOptions);
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
begin
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TIECache.UpdateFilterOptionValue;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
const
acardFilterOptionValues: array[TFilterOption] of Cardinal = (
$00000001, $00000002, $00000004, $00100000, $00200000,
$00000010, $00000020, $00010000, $00020000);
var
i: TFilterOption;
begin
FFilterOptionValue := 0;
if (FFilterOptions <> []) then
for i := Low(TFilterOption) to High(TFilterOption)do
if (i in FFilterOptions) then
Inc(FFilterOptionValue, acardFilterOptionValues);
end;
//procedure TIECache.UpdateFilterOptionValue;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure Register;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
begin
procedure TForm1.Button1Click(Sender: TObject);
begin
IECache1.SearchPattern := spAll;
//e.g.: set SearchPattern:=spCookies if you only want to delete cookies
IECache1.ClearAllEntries;
Listbox1.Items.Clear;
IECache1.SearchPattern := spAll;
IECache1.RetrieveEntries(0);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
close;
end;
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
Listbox1.Items.Clear;
with IECache1do
begin
case RadioGroup1.ItemIndex of
0: SearchPattern := spAll;
1: SearchPattern := spCookies;
2: SearchPattern := spHistory;
3: SearchPattern := spUrl;
end;
RetrieveEntries(0);
end;
end;
function DTString(DT: TDatetime): string;
begin
if DT < 0 then
Result := '' else
Result := DateTimeToStr(DT);
end;
procedure TForm1.ListBox1Click(Sender: TObject);
var
x: Olevariant;
begin
while webbrowser1.busydo
application.processmessages;
If Listbox1.Items.Count>0 then
IECache1.GetEntryInfo(Listbox1.Items[Listbox1.Itemindex]);
with IECache1.EntryInfodo