分享
 
 
 

谈Delphi 下Internet 编程技巧(二)

王朝delphi·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

谈Delphi 下Internet 编程技巧(二)

作者:吕杨

E-Mail:lyboy99@sina.com

讲过第一节后,我再给大家介绍Delphi中的TWebBrowser控件的常用使用方法和技巧。从Delphi5开始,TwebBrowser组件中封装有MS IE AcitveX控件,并从Netmasters中替换了THTML组件。Delphi5没有全部加入TwebBrowser控件,我们可以先卸去原有的TwebBrowser组件后从新按安装MS IE ActiveX控件 ;方法是首先:选择Component菜单 -> Install Packages 出现(如图1-1)画面,选择Internet Explorer Components 选项后,按

Remove按钮 ,将原TwebBrowser控件卸载掉,然后再 ,选择 Import ActiveX Control菜单,如(图1-2)后,出现(图1-3)的画面,选择Microsoft internet controls(version 1.1)项后,Install , 安装后你会发现在ActiveX组件菜单中多了WebBrowse_V1 和WebBrowse二个控件。

[图1-1]

[图1-2]

[图1-3]

以TWebBrowser(IE5浏览器控件)为例,介绍以下控件的常用的属性。

有些属性在TwebBrowser_V1控件中没有,是TwebBrowser控件中新增的,我在下面的列表中已经注明。

TwebBrowser控件常用属性表:

属性:

介绍:

GoBack

后退到上一个页面

GoForward

前进到下一个页面

GoHome

调用默认的主页页面

GoSearch

调用默认的搜索页面

Navigate(const URL: WideString;

var Flags, TargetFrameName, PostData,

Headers: OleVariant)

调用指定页面,具体参数如下:

URL:指定页面的URL。Flags:

Word类型,作用还不清楚,可设为0。

TargetFrameName:WideString,

打开页面所在的Frame,为空字符串时在当前的

Frame中打开;TargetFrameName

指定的Frame存在时在Frame中打开;

TargetFrameName指定的Frame

不存在时则新建一个窗口打开,此时就相当

于调用外部的IE浏览器了。

PostData:boolean,是否允许发送数据。

Headers:WideString,

要发送的URL请求的头部数据

Refresh

刷新当前页面

Stop

停止调用或打开当前页面

LocationName属性(WideString)

当前位置的名称

LocationURL属性(WideString)

当前位置的URL

Busy属性(Boolean),

是否正忙

Visible: 属性(Boolean)

浏览器窗口是否可见

StatusBar属性(Boolean)

是否显示状态栏,TWebBrowser新增

StatusText: 属性(WideString)

状态栏内容,TWebBrowser新增

ToolBar: 属性(SYSINT)

工具栏中的内容,TWebBrowser新增

MenuBar: 属性(Boolean)

是否显示菜单条,TWebBrowser新增

FullScreen: 属性(Boolean)

是否全屏显示,TWebBrowser新增

Offline: 属性(Boolean)

是否脱机浏览,TWebBrowser新增

AddressBar: 属性(Boolean)

是否显示地址栏,TWebBrowser新增

TwebBrowser常见事件表:

OnStatusTextChange = procedure

(Sender: TObject; const Text: WideString)

of object;

在状态栏提示信息变化时发生,参数Text为当前状态栏提示信息,我们可以根据该信息来更新我们自己的状态栏提示信息或处理其它的事务

OnProgressChange = procedure(Sender: TObject; Progress, ProgressMax: Integer) of object;

在打开页面的进度变化时发生,参数Progress为当前进度,ProgressMax为总进度,可以根据这两个参数来更新状态栏提示信息或处理其它的事务

OnCommandStateChange = procedure(Sender: TObject; Command: Integer; Enable: WordBool) of object;

当执行新的命令时发生,Command为命令标识,Enable为是否允许执行该命令.

OnTitleChange = procedure(Sender: TObject; const Text: WideString) of object;

在页面的标题发生变化时发生,Text为当前标题

OnPropertyChange = procedure(Sender: TObject; const Property_: WideString) of object;

在页面的属性发生变化时发生,Property_为属性名称 OnDownloadComplete: TNotifyEvent

在下载页面完成后发生

OnDownloadBegin: TNotifyEvent

在下载页面开始前发生.

介绍过TwebBrowser控件的属性后,我在给大家介绍一下应用TwebBrowser控件的一些编程技巧。

1.显示一个GIF动画

如果你找不到显示GIF动画的控件,下面的一个函数可以解决你的燃眉之急

procedure ShowGIF( GIFFileName : String );

var

TargetFrameName,PostData,Heads,Flags : OleVariant;

URL : widestring;

begin

TargetFrameName := '';{指定Frame的空字符串时,

则在当前Frame中打开动画文件}

PostData := false;{不发送数据}

Heads := '';{Header信息为空}

Flags := 0;{Flags设为0}

URL := GIFFileName;

with formGIF.webbrowser do{在指定窗口中的

IE浏览器控件中显示动画}

begin

navigate(URL,Flags,TargetFrameName

,PostData,Heads);{显示动画文件}

end;

end;

2.删除IE的历史记录

很想知道如何实现删除IE的历史记录的吧,下面一段程序事例将介绍如何编写

uses wininet;

procedure TForm1.Button1Click(Sender: TObject);

var

cache_info:PInternetCacheEntryInfo;

cbSizeOf_Cache_info:dword;

hw:hwnd;

buf:tstrings;

begin

new(cache_info);

hw:=FindFirstUrlCacheEntryEx(nil,0,NORMAL_CACHE_ENTRY or URLHISTORY_CACHE_ENTRY,0,cache_info,@cbSizeOf_Cache_info,nil,nil,nil);

if hw<>0 then

begin

DeleteUrlCacheEntry(cache_info.lpszSourceUrlName);

while FindNextUrlCacheEntryEx(hw,cache_info,@cbSizeOf_Cache_info,nil,nil,nil) do

DeleteUrlCacheEntry(cache_info.lpszSourceUrlName);

end;

FindCloseUrlCache(hw);

dispose(cache_info);

end;

//方法二

type

TSTATURL = record

cbSize: DWORD;

pwcsUrl: DWORD;

pwcsTitle: DWORD;

ftLastVisited: FILETIME;

ftLastUpdated: FILETIME;

ftExpires: FILETIME;

dwFlags: DWORD;

end;

type

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;

type

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: TGUID; out ppvOut: Pointer): HResult; stdcall;

function EnumUrls(out ppenum: IEnumSTATURL): HResult; stdcall;

end;

type

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;

function ClearIEHistory:integer;

const

CLSID_CUrlHistory: TGUID = '{3C374A40-BAE4-11CF-BF7D-00AA006946EE}';

var

IEHistory:IUrlHistoryStg2;

begin

IEHistory:=CreateComObject(CLSID_CUrlHistory) as IUrlHistoryStg2;

IEHistory.ClearHistory;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ClearIEHistory;

end;

3.添加到收藏夹和整理收藏夹

const

CLSID_ShellUIHelper: TGUID = '{64AB4BB7-111E-11D1-8F79-00C04FC2FBE1}';

var

p:procedure(Handle: THandle; Path: PChar); stdcall;

procedure TForm1.OrganizeFavorite(Sender: Tobject);

var

H: HWnd;

begin

H := LoadLibrary(PChar('shdocvw.dll'));

if H <> 0 then

begin

p := GetProcAddress(H, PChar('DoOrganizeFavDlg'));

if Assigned(p) then p(Application.Handle, PChar(FavFolder));

end;

FreeLibrary(h);

end;

procedure TForm1.AddFavorite(Sender: TObject);

var

ShellUIHelper: ISHellUIHelper;

url, title: Olevariant;

begin

Title := Webbrowser1.LocationName;

Url := Webbrowser1.LocationUrl;

if Url <> '' then

begin

ShellUIHelper := CreateComObject(CLSID_SHELLUIHELPER) as IShellUIHelper;

ShellUIHelper.AddFavorite(url, title);

end;

end;

4.直接从TWebBrowser得到网页源码及Html

Memo1.Lines.Add(IHtmlDocument2(WebBrowser1.Document).Body.OuterHtml);

如果,用TWebBrowser浏览HTML文件的时候要将其保存为文本文件就很简单了,

Memo1.Lines.Add(IHtmlDocument2(WebBrowser1.Document).Body.OuterText);

5.获取IE地址栏的handle

var

Form1: TForm1;

implementation

{$R *.DFM}

Function GetURL(H:hwnd;lparam:longint):boolean;stdcall;

var str,url:array [0..254] of char;

begin

getclassname(h,@str,255);

if strpas(@str)='ComboBoxEx32' then // ComboBoxEx32可以改成Edit.

begin

SendMessage(h,WM_GETTEXT,255,LongInt(@url));

SendMessage(h,WM_SETTEXT,255,longint(pchar('http://www.sina.com.cn')));

Sendmessage(h,WM_KEYDOWN,VK_Return,1);

form1.ListBox1.Items.Add(strpas(@url));

end;

result:=true;

end;

function callbackproc(H:HWnd;lparam:longint):Boolean;stdcall;

var str:array [1..255] of char;

begin

getclassname(h,@str,255);

if ((strpas(@str)='CabinetWClass') or (strpas(@str)='IEFrame')) then

begin

Enumchildwindows(h,@GetURL,0);

end;

result:=true;

end;

procedure TForm1.findbuttonClick(Sender: TObject);

begin

listbox1.Clear;

Enumwindows(@callbackproc,0);

end;

end.

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有