请问如何取得IE浏览器曾浏览的所有网页地址? ( 积分: 150 )

  • 主题发起人 主题发起人 郭庆北
  • 开始时间 开始时间

郭庆北

Unregistered / Unconfirmed
GUEST, unregistred user!
我想取得IE浏览过的所有网页地址,不知怎样去做?谢谢,我只有190分了,给你150分。
 
我想取得IE浏览过的所有网页地址,不知怎样去做?谢谢,我只有190分了,给你150分。
 
http://www.euromind.com/iedelphi/urlhistory.htm
 
//注: ListView1添加三列
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, wininet;

type
TForm1 = class(TForm)
Button1: TButton;
ListView1: TListView;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure AddInfo(lpEntryInfo: PInternetCacheEntryInfo; id: Integer);
end;

var
Form1: TForm1;

implementation
var
stop: boolean = false;
{$R *.DFM}
procedure TForm1.AddInfo(lpEntryInfo: PInternetCacheEntryInfo; id: Integer);
begin
with ListView1.Items do
begin
Try
BeginUpdate;
with Add do
begin
Caption := IntToStr(id);
SubItems.add(lpEntryInfo^.lpszSourceUrlName);
SubItems.add(lpEntryInfo^.lpszLocalFileName);
end;
Finally
EndUpdate;
end;//try
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
lpEntryInfo: PInternetCacheEntryInfo;
hCacheDir: LongWord;
dwEntrySize, dwLastError: LongWord;
id: Integer;
begin
stop := false;
id := 0;
ListView1.Items.Clear;
dwEntrySize := 0;
{取回缓冲区需要的空间大小}
FindFirstUrlCacheEntry(nil, TInternetCacheEntryInfo(nil^), dwEntrySize);
{分配dwEntrySize字节的内存}
GetMem(lpEntryInfo, dwEntrySize);
{检索第一个}
hCacheDir := FindFirstUrlCacheEntry(nil, lpEntryInfo^, dwEntrySize);
if hCacheDir <> 0 then
begin
AddInfo(lpEntryInfo, id);
Inc(id);
end;
{释放内存}
FreeMem(lpEntryInfo);

{检索下一个}
repeat
dwEntrySize := 0;
{取回缓冲区所需要的空间大小}
FindNextUrlCacheEntry(hCacheDir, TInternetCacheEntryInfo(nil^), dwEntrySize);
dwLastError := GetLastError();
if dwLastError = ERROR_INSUFFICIENT_BUFFER then//如果成功
begin
GetMem(lpEntryInfo, dwEntrySize);
if FindNextUrlCacheEntry(hCacheDir, lpEntryInfo^, dwEntrySize) then
begin
AddInfo(lpEntryInfo, id);
Inc(id);
end;
FreeMem(lpEntryInfo);
end;
Application.ProcessMessages;
until (dwLastError = ERROR_NO_MORE_ITEMS) or stop;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
stop := true;
end;

end.
 

Similar threads

D
回复
0
查看
943
DelphiTeacher的专栏
D
D
回复
0
查看
882
DelphiTeacher的专栏
D
D
回复
0
查看
959
DelphiTeacher的专栏
D
D
回复
0
查看
786
DelphiTeacher的专栏
D
后退
顶部