谈Delphi 下Internet 编程技巧(二)

delphi 专栏收录该内容
4 篇文章 0 订阅

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:指定页面的URLFlags

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

TargetFrameNameWideString

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

Frame中打开;TargetFrameName

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

TargetFrameName指定的Frame

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

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

PostDataboolean,是否允许发送数据。

HeadersWideString

要发送的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.

 

 

 

  • 0
    点赞
  • 0
    评论
  • 0
    收藏
  • 一键三连
    一键三连
  • 扫一扫,分享海报

相关推荐
©️2020 CSDN 皮肤主题: 大白 设计师:CSDN官方博客 返回首页
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、C币套餐、付费专栏及课程。

余额充值