一个关于IE Cache的工具单元,希望有些帮助{...................................................................
Author : Per Linds?Larsen {[email protected])
Christian Lovis for lib dynamic linking {[email protected]]
UPDATES : http://www.euromind.com/iedelphi
Copyright :
source : IE CACHE Component v 1.02
First release : January 26, 2000
Last release : January 14, 2001
Unit Type : WinInet MS lib wrapper
Compiler :
Comment :
Dependances :
...................................................................}
unit IECache;interfaceuses
wininet, Windows, Messages, SysUtils, Classes;const CACHEGROUP_ATTRIBUTE_GET_ALL = $FFFFFFFF;
CACHEGROUP_ATTRIBUTE_BASIC = $00000001;
CACHEGROUP_ATTRIBUTE_FLAG = $00000002;
CACHEGROUP_ATTRIBUTE_TYPE = $00000004;
CACHEGROUP_ATTRIBUTE_QUOTA = $00000008;
CACHEGROUP_ATTRIBUTE_GROUPNAME = $00000010;
CACHEGROUP_ATTRIBUTE_STORAGE = $00000020; CACHEGROUP_FLAG_NONPURGEABLE = $00000001;
CACHEGROUP_FLAG_GIDONLY = $00000004; CACHEGROUP_FLAG_FLUSHURL_ONDELETE = $00000002; CACHEGROUP_SEARCH_ALL = $00000000;
CACHEGROUP_SEARCH_BYURL = $00000001; CACHEGROUP_TYPE_INVALID = $00000001; CACHEGROUP_READWRITE_MASK = CACHEGROUP_ATTRIBUTE_TYPE or
CACHEGROUP_ATTRIBUTE_QUOTA or
CACHEGROUP_ATTRIBUTE_GROUPNAME or
CACHEGROUP_ATTRIBUTE_STORAGE; GROUPNAME_MAX_LENGTH = 120;
GROUP_OWNER_STORAGE_SIZE = 4;type PInternetCacheTimeStamps = ^TInternetCacheTimeStamps;
TInternetCacheTimeStamps = record
ftExpires: TFileTime;
ftLastModified: TFileTime;
end;
PInternetCacheGroupInfo = ^TInternetCacheGroupInfo;
TInternetCacheGroupInfo = record
dwGroupSize: DWORD;
dwGroupFlags: DWORD;
dwGroupType: DWORD;
dwDiskUsage: DWORD;
dwDiskQuota: DWORD;
dwOwnerStorage: array[0..GROUP_OWNER_STORAGE_SIZE - 1] of DWORD;
szGroupName: array[0..GROUPNAME_MAX_LENGTH - 1] of AnsiChar;
end;
TEntryInfo = record
SourceUrlName: string;
LocalFileName: string;
EntryType: DWORD;
UseCount: DWORD;
HitRate: DWORD;
FSize: DWORD;
LastModifiedTime: TDateTime;
ExpireTime: TDateTime;
LastAccessTime: TDateTime;
LastSyncTime: TDateTime;
HeaderInfo: string;
FileExtension: string;
ExemptDelta: DWORD;
end; TGroupInfo = record
DiskUsage: DWORD;
DiskQuota: DWORD;
OwnerStorage: array[0..GROUP_OWNER_STORAGE_SIZE - 1] of DWORD;
GroupName: string;
end; TContent = record
Buffer: Pointer;
BufferLength: Integer;
end;
TFilterOption = (NORMAL_ENTRY,
STABLE_ENTRY,
STICKY_ENTRY,
COOKIE_ENTRY,
URLHISTORY_ENTRY,
TRACK_OFFLINE_ENTRY,
TRACK_ONLINE_ENTRY,
SPARSE_ENTRY,
OCX_ENTRY); TFilterOptions = set of TFilterOption; TOnEntryEvent = procedure(Sender: TObject; var Cancel: Boolean) of object; TOnGroupEvent = procedure(Sender: TObject; GroupID: GROUPID; var Cancel: Boolean) of object;
TSearchPattern = (spAll, spCookies, spHistory, spUrl); TIECache = class(TComponent)
private
FSearchPattern: TSearchPattern;
FOnEntry: TOnEntryEvent;
FOnGroup: TOnGroupEvent;
GrpHandle: THandle;
H: THandle;
FCancel: Boolean;
FFilterOptions: TFilterOptions;
FFilterOptionValue: Cardinal;
procedure SetFilterOptions(const Value: TFilterOptions);
procedure UpdateFilterOptionValue;
procedure GetEntryValues(Info: PInternetCacheEntryInfo);
procedure ClearEntryValues;
protected { Protected declarations }
public
GroupInfo: TGroupInfo;
EntryInfo: TEntryInfo;
Content: TContent;
constructor Create(AOwner: TComponent); override;
function CreateGroup: INT64;
function DeleteGroup(GroupID: INT64): DWORD;
function GetGroupInfo(GroupID: INT64): DWORD;
function SetGroupInfo(GroupID: INT64): DWORD; 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 CopyFileToCache(UrlName, FileName: Pchar): string;
function CopyFileToCache(Url, FileName: string; CacheType: DWORD; Expire: TDateTime): DWORD;
procedure ClearAllEntries;
{ Public declarations }
published
property FilterOptions: TFilterOptions read FFilterOptions write SetFilterOptions;
property SearchPattern: TSearchpattern read FSearchpattern write FSearchPattern;
property LibraryFound: boolean read getLibraryFound;
property OnEntry: TOnEntryEvent read FOnEntry write FOnEntry;
property OnGroup: TOnGroupEvent read FOnGroup write FOnGroup;
{ Published declarations }
end;procedure Register;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
implementation
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Author : Per Linds?Larsen {[email protected])
Christian Lovis for lib dynamic linking {[email protected]]
UPDATES : http://www.euromind.com/iedelphi
Copyright :
source : IE CACHE Component v 1.02
First release : January 26, 2000
Last release : January 14, 2001
Unit Type : WinInet MS lib wrapper
Compiler :
Comment :
Dependances :
...................................................................}
unit IECache;interfaceuses
wininet, Windows, Messages, SysUtils, Classes;const CACHEGROUP_ATTRIBUTE_GET_ALL = $FFFFFFFF;
CACHEGROUP_ATTRIBUTE_BASIC = $00000001;
CACHEGROUP_ATTRIBUTE_FLAG = $00000002;
CACHEGROUP_ATTRIBUTE_TYPE = $00000004;
CACHEGROUP_ATTRIBUTE_QUOTA = $00000008;
CACHEGROUP_ATTRIBUTE_GROUPNAME = $00000010;
CACHEGROUP_ATTRIBUTE_STORAGE = $00000020; CACHEGROUP_FLAG_NONPURGEABLE = $00000001;
CACHEGROUP_FLAG_GIDONLY = $00000004; CACHEGROUP_FLAG_FLUSHURL_ONDELETE = $00000002; CACHEGROUP_SEARCH_ALL = $00000000;
CACHEGROUP_SEARCH_BYURL = $00000001; CACHEGROUP_TYPE_INVALID = $00000001; CACHEGROUP_READWRITE_MASK = CACHEGROUP_ATTRIBUTE_TYPE or
CACHEGROUP_ATTRIBUTE_QUOTA or
CACHEGROUP_ATTRIBUTE_GROUPNAME or
CACHEGROUP_ATTRIBUTE_STORAGE; GROUPNAME_MAX_LENGTH = 120;
GROUP_OWNER_STORAGE_SIZE = 4;type PInternetCacheTimeStamps = ^TInternetCacheTimeStamps;
TInternetCacheTimeStamps = record
ftExpires: TFileTime;
ftLastModified: TFileTime;
end;
PInternetCacheGroupInfo = ^TInternetCacheGroupInfo;
TInternetCacheGroupInfo = record
dwGroupSize: DWORD;
dwGroupFlags: DWORD;
dwGroupType: DWORD;
dwDiskUsage: DWORD;
dwDiskQuota: DWORD;
dwOwnerStorage: array[0..GROUP_OWNER_STORAGE_SIZE - 1] of DWORD;
szGroupName: array[0..GROUPNAME_MAX_LENGTH - 1] of AnsiChar;
end;
TEntryInfo = record
SourceUrlName: string;
LocalFileName: string;
EntryType: DWORD;
UseCount: DWORD;
HitRate: DWORD;
FSize: DWORD;
LastModifiedTime: TDateTime;
ExpireTime: TDateTime;
LastAccessTime: TDateTime;
LastSyncTime: TDateTime;
HeaderInfo: string;
FileExtension: string;
ExemptDelta: DWORD;
end; TGroupInfo = record
DiskUsage: DWORD;
DiskQuota: DWORD;
OwnerStorage: array[0..GROUP_OWNER_STORAGE_SIZE - 1] of DWORD;
GroupName: string;
end; TContent = record
Buffer: Pointer;
BufferLength: Integer;
end;
TFilterOption = (NORMAL_ENTRY,
STABLE_ENTRY,
STICKY_ENTRY,
COOKIE_ENTRY,
URLHISTORY_ENTRY,
TRACK_OFFLINE_ENTRY,
TRACK_ONLINE_ENTRY,
SPARSE_ENTRY,
OCX_ENTRY); TFilterOptions = set of TFilterOption; TOnEntryEvent = procedure(Sender: TObject; var Cancel: Boolean) of object; TOnGroupEvent = procedure(Sender: TObject; GroupID: GROUPID; var Cancel: Boolean) of object;
TSearchPattern = (spAll, spCookies, spHistory, spUrl); TIECache = class(TComponent)
private
FSearchPattern: TSearchPattern;
FOnEntry: TOnEntryEvent;
FOnGroup: TOnGroupEvent;
GrpHandle: THandle;
H: THandle;
FCancel: Boolean;
FFilterOptions: TFilterOptions;
FFilterOptionValue: Cardinal;
procedure SetFilterOptions(const Value: TFilterOptions);
procedure UpdateFilterOptionValue;
procedure GetEntryValues(Info: PInternetCacheEntryInfo);
procedure ClearEntryValues;
protected { Protected declarations }
public
GroupInfo: TGroupInfo;
EntryInfo: TEntryInfo;
Content: TContent;
constructor Create(AOwner: TComponent); override;
function CreateGroup: INT64;
function DeleteGroup(GroupID: INT64): DWORD;
function GetGroupInfo(GroupID: INT64): DWORD;
function SetGroupInfo(GroupID: INT64): DWORD; 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 CopyFileToCache(UrlName, FileName: Pchar): string;
function CopyFileToCache(Url, FileName: string; CacheType: DWORD; Expire: TDateTime): DWORD;
procedure ClearAllEntries;
{ Public declarations }
published
property FilterOptions: TFilterOptions read FFilterOptions write SetFilterOptions;
property SearchPattern: TSearchpattern read FSearchpattern write FSearchPattern;
property LibraryFound: boolean read getLibraryFound;
property OnEntry: TOnEntryEvent read FOnEntry write FOnEntry;
property OnGroup: TOnGroupEvent read FOnGroup write FOnGroup;
{ Published declarations }
end;procedure Register;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
implementation
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
解决方案 »
- dbgrideh导出到excel后,excel能否自动调整列宽?
- 请问DbGrid中如何一直显示DbcheckBox?
- TStream和String类型如何互相转换
- 关于当前路径以及书的问题。
- excel的注册问题,高分征询,高手请出手
- delphi7 的报表控件在哪里,我怎么没找到
- IBM笔记本电脑,怎么才能进CIOS,或者能让它由光驱启动就可以了!在先等待,马上解决马上给分
- 报表问题?
- 我创建了一个线程,程序调试时老是出现“尚未调用coinitiallize”,怎么办???
- Packed record 和 Record的区别,欢迎讨论Delphi的内存管理
- 怎样在Dephi中实现Pc喇叭响?我用chr(7)不能实现!用汇编也不行,因为in 和out 语句出错,谁能教我怎么做?
- 对于字符串得判断可以用CASE吗?
function(dwFlags, dwFilter: DWORD;
lpSearchCondition: Pointer; dwSearchCondition: DWORD;
var Group: Int64; lpReserved: Pointer): THandle; stdcall; tFindNextUrlCacheGroup =
function(hFind: THandle; var GroupID: Int64; lpReserved: Pointer): BOOL; stdcall; tSetUrlCacheGroupAttribute =
function(gid: Int64; dwFlags, dwAttributes: DWORD; var lpGroupInfo: TInternetCacheGroupInfo;
lpReserved: Pointer): BOOL; stdcall; tGetUrlCacheGroupAttribute =
function(gid: Int64; dwFlags, dwAttributes: DWORD;
var GroupInfo: TInternetCacheGroupInfo; var dwGroupInfo: DWORD; lpReserved: Pointer): BOOL; stdcall;var
FindFirstUrlCacheGroup: tFindFirstUrlCacheGroup;
FindNextUrlCacheGroup: tFindNextUrlCacheGroup;
GetUrlCacheGroupAttribute: tGetUrlCacheGroupAttribute;
SetUrlCacheGroupAttribute: tSetUrlCacheGroupAttribute;const
winetdll = 'wininet.dll';var
winInetLibFound: 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;
end;
end;
end;
except
end;
end;
end; // function initializeWinInet : boolean; //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~function FileTimeToDateTime(Ft: TFileTime): TDateTime;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
var
St: TSystemTime;
lft: TFileTime;
begin
Result := 0;
if FileTimeToLocalFiletime(Ft, lft) then
if FileTimeToSyStemTime(lft, st) then
Result := SystemTimeTODateTime(st);
end; //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function DateTimeToFileTime(Dt: TDateTime): TFileTime;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
var
St: TSystemTime;
lft: TFileTime;
begin
DateTimeToSystemTime(Dt, ST);
if SystemTimeToFileTime(st, lft) then LocalFileTimeToFileTime(lft, Result);
end;//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
// TIECache
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~constructor TIECache.Create(AOwner: TComponent);
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
begin
inherited;
Content.Buffer := nil;
ClearEntryValues;
// Identical to URLCACHE_FIND_DEFAULT_FILTER
FFilterOptions := [NORMAL_ENTRY, COOKIE_ENTRY, URLHISTORY_ENTRY,
TRACK_OFFLINE_ENTRY, TRACK_ONLINE_ENTRY, STICKY_ENTRY];
end; // constructor TIECache.Create(AOwner: TComponent);
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~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.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.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.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.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
with GroupInfo do begin
DiskUsage := info.dwDiskUsage;
DiskQuota := info.dwDiskQuota;
move(info.dwOwnerStorage, OwnerStorage, Sizeof(OwnerStorage));
GroupName := info.szGroupName;
end;
end; //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~