2. 技术人生
    3. 谈Delphi 下Internet 编程技巧(二)

    谈Delphi 下Internet 编程技巧(二)

    技术2022-05-11  172

    谈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.

     

     

     

    专利

    最新回复(0)