Delphi XE4做一个超小的浏览器.(做一个超级小的WebBrowser)

用DelphiXE4开发一个40KB的浏览器.

刚好有个需求是要访问一个网页,但是程序的体积又不能太大.
DelphiXE4以后编译出的代码体积越来越大.我一直都是追着最新的Delphi版本,所以不可能退回早期版本.
研究了一下,发现Classes,Rtti,Themes,Controls,Forms这个单元是高高位于体积之首的.
空工程:
System.Classes 398,080 CODE
System.Rtti 293,860 CODE
Vcl.Themes 243,644 CODE
Vcl.Controls 130,056 CODE
Vcl.Forms 121,104 CODE

那么,如果想要做一个非常小的浏览器首先就要避开这个单元.那么系统提供的TWebbrowser控件就不能用了,因为即便你是用SDK写程序,如果使用TWebBrowser也会引入VCL的代码,另外Classes等单元也不能被避免.
那么我们就要自己实现一个WebBrowser控件,直接从TObject派生,除了Windows单元其他什么单元也不要引用,因为ActiveX,SHDocVw等单元依然会引入其他体积比较大的单元.
所以把和IWebBrowser2相关的Interface声明从Ole2,ActiveX,SHDocVw三个单元拷贝过来.因为这些接口的声明中大量的使用了OleVariant,而Delphi的编译器在编译这些OleVariant的时候又会自动引入Variants单元(Delphi compiler magic).Variants单元又会导致其他单元的大量使用.

所以为了避免OleVariant被Delphi”魔法编译”技术引入Variants单元,就要用回OleVariant原本的数据结构替换OleVariant.其实很简单,在前面声明一下OleVariant = TVarData;即可.TVarData就是System单元中OleVariant原本的样子.

剩下的事情就简单了,TMicroWebBrowser = class(TObject, IUnknown, IDispatch, IOleClientSite,
IOleInPlaceSite)只要实现这些接口就行了,不知道如何实现的就返回E_NOTIMPL告诉系统:”我没实现”就好了.
但有些又不行,例如IOleInPlaceSite.OnPosRectChange方法最开始我返回没实现,结果IWebBrowser2的Set_Top,Set_Left,Set_Width,Set_Height几个方法就会报错.困惑了好一会儿.

这个单元DelphiXE4中Debug版本编译出来也就不到5KB
MicroWebBrowser 4,696 CODE
MicroWebBrowser 48 DATA
MicroWebBrowser 20 ICODE
MicroWebBrowser 20 BSS

这样有了这个非常小的MicroWebBrowser也就有了我们用SDK直接写体积非常小的浏览器的基础了.
用SDK直接写一个Windows程序,在主界面上嵌入我们的MicroWebBrowser.

program wb;
uses
  Windows,
  Messages,
  MicroWebBrowser in 'MicroWebBrowser.pas';

const
  WBName = 'Delphi小小浏览器';
var
  gWb: TMicroWebBrowser;
  MainHwnd, hUrlText, hButton: HWND;
  txtProc, BtnProc: LONG;

procedure NavigateTxtUrl();
var
  tmpStr: string;
  l: Integer;
  hr : HRESULT;
begin
  l := GetWindowTextLength(hUrlText) + 10;
  SetLength(tmpStr, l);
  GetWindowText(hUrlText, PChar(tmpStr), l);
  tmpStr := PChar(tmpStr);
  gWb.Navigate(tmpStr);
  hr := gWb.WaitComplete(5000);
  if (hr = S_OK)or (hr = ERROR_TIMEOUT) then
  begin
    tmpStr := gWb.WebBrowser.Get_LocationURL();
    SetWindowText(hUrlText, PChar(tmpStr));
    tmpStr := WBName +' - '+ gWb.WebBrowser.Get_LocationName;
    SetWindowText(MainHwnd, PChar(tmpStr));
  end
  else
  begin
    tmpStr := WBName;
    SetWindowText(MainHwnd, PChar(tmpStr));
  end;
end;

// 窗口过程
function WndProc(HWND: THandle; Message: Longint; wParam: wParam;
  lParam: lParam): LRESULT; stdcall;
const
  BlankUrl = 'about:blank';
  UrlTextHeight = 30;
  ButtonWidth = 50;
  procedure ReLayout(const Width, Height: WORD);
  begin
    SetWindowPos(hUrlText, HWND_TOP, 0, 0, Width - ButtonWidth,
      UrlTextHeight, 0);
    SetWindowPos(hButton, HWND_TOP, Width - ButtonWidth, 0, ButtonWidth,
      UrlTextHeight, 0);
    gWb.SetBounds(0, UrlTextHeight, Width, Height - UrlTextHeight);
  end;

var
  rMain: TRect;
begin

  if HWND = hButton then
  begin
    Case Message of
      WM_LBUTTONUP:
        begin
          NavigateTxtUrl();
        end;
    end;
    result := CallWindowProc(Pointer(BtnProc), HWND, Message, wParam, lParam);
  end
  else if HWND = hUrlText then
  begin
    Case Message of
      WM_KEYDOWN:
        begin
          if wParam = VK_RETURN then
            NavigateTxtUrl();
        end;
    end;
    result := CallWindowProc(Pointer(txtProc), HWND, Message, wParam, lParam);
  end
  else
  begin
    Case Message of
      WM_CREATE:
        begin
          GetClientRect(HWND, rMain);
          hUrlText := CreateWindowEx(0, 'EDIT', BlankUrl,
            WS_CHILD or WS_VISIBLE or WS_BORDER, 0, 0, 0, 0, HWND, 0,
            hInstance, nil);
          txtProc := SetWindowLong(hUrlText, GWL_WNDPROC, LONG(@WndProc));
          hButton := CreateWindowEx(0, 'BUTTON', '访问', WS_CHILD or WS_VISIBLE or
            WS_BORDER, 0, 0, 0, 0, HWND, 0, hInstance, nil);
          BtnProc := SetWindowLong(hButton, GWL_WNDPROC, LONG(@WndProc));
          gWb := TMicroWebBrowser.Create(HWND, rMain.Left,
            rMain.Top + UrlTextHeight, rMain.Right - rMain.Left,
            rMain.Height - (rMain.Top + UrlTextHeight));
          ReLayout(rMain.Right - rMain.Left, rMain.Bottom - rMain.Top);
          gWb.Navigate(BlankUrl);
          // gWb.Navigate('http://www.baidu.com');
        end;
      WM_SIZE:
        begin
          if (gWb <> nil) and (gWb.WebBrowser <> nil) then
          begin
            ReLayout(WORD(lParam), HiWord(lParam));
          end;
        end;
      WM_DESTROY:
        begin
          gWb.Free;
          PostQuitMessage(0);
          result := 1;
          exit;
        end;
    end;
    result := DefWindowProc(HWND, Message, wParam, lParam);
  end;
end;

var
  WndClass: TWndClass = (style: 0; lpfnWndProc: @WndProc; cbClsExtra: 0;
    cbWndExtra: 0; hInstance: 0; hIcon: 0; hCursor: 0; hbrBackground: 0;
    lpszMenuName: nil; lpszClassName: 'TWebBrowser');

var
  msg: Tmsg;

begin
  if RegisterClass(WndClass) <> 0 then
  begin
    MainHwnd := CreateWindowEx(0, WndClass.lpszClassName, WbName,
      ws_OverlappedWindow, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT,
      CW_USEDEFAULT, 0, 0, hInstance, nil);
    if MainHwnd <> 0 then
    begin
      ShowWindow(MainHwnd, sw_ShowNormal);
      UpdateWindow(MainHwnd);
      while GetMessage(msg, 0, 0, 0) do
      begin
        TranslateMessage(msg);
        DIspatchMessage(msg);
      end;
      ExitCOde := msg.wParam;
    end;
  end;

end.

那么我们试着编译一下,Release版本体积是52KB.
还有哪里可以减肥呢,那就是RTTI,Delphi2010以后加入了RTTI信息,这个东西非常有用,我们可以在运行时知道任何类型信息,结构体有什么成员等等.但是今天我们为了让体积更小,就要去掉RTTI信息.
在工程的开始处加入
{$WEAKLINKRTTI ON}
{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])}
再编译,Release版本体积变成了42KB.
不过因为没有Manifest文件,也就没有XP,Vista的界面风格.按钮输入框什么的跟Windows95差不多.

那么我们就加入Manifest文件.

在编译,体积略微增长,到了44KB.
最后,如果你有更小的意愿,可以用UPX压缩一下,可以看到一个十几KB的小浏览器.

当然,还有一种更为极限的缩小体积的办法,就连TObject也不用,直接构造指针数组,array of Pointer.把这个当做Interface的虚方法表VMT.手工打造一个IWebBrowser2的Interface出来.然后实现一些函数例如:
function _AddRef(Self : Pointer): Integer;
begin
Result := -1;
end;
然后把这些函数对应到前面的Pointer的Array上去,拼出完整的VMT.
因为不使用TObject我想体积会更小一些吧.不过因为太麻烦,还没有验证.

最后附上全部源代码.
WebBrowser

此条目发表在Delphi, 未分类分类目录。将固定链接加入收藏夹。

Delphi XE4做一个超小的浏览器.(做一个超级小的WebBrowser)》有 30 条评论

  1. siow说:

    不得不顶,Delphi2007编译完只有28k

  2. bellsouth说:

    顶一下 盼望 FM中有webbrwoser出现。。不知道等到什么时候呢

  3. diystar说:

    大牛。我有一个下载歌词的DLL,只有极少代码,编译却有500K,不知道有什么方法可以精简一下,博主帮忙看下:http://files.cnblogs.com/diystar/GetLRC_test.rar

    • admin说:

      我看了一下你的代码.
      为了和你的D6接近,我安装了Delphi2007,并用Delphi2007编译.
      因为我没有TNT组件包,去掉TNT后编译出来409KB
      去掉Indy控件,编译出来220KB

      改好的代码已经发到你的邮箱

      目前编译后最大的是XML部分导致的.如果可以使用一些第三方的XML代码可以在进一步缩小.

  4. xgwzw说:

    这个浏览器的访问速度很快 加上前后 切换 以及历史 收藏的话 ,就是很好用的浏览器了,不知道你有没有改进的想法,反正目前的速度是最快了 比ie 遨游 firefox什么的快多了,如果有时间加上这个功能 就可以不用其他的浏览器看新闻了,因为你的这个太快了!

  5. xgwzw说:

    感谢武大侠的发布,确实是一个浏览器神器啊!

  6. kylix说:

    武老大,请问如何绑定事件啊?如 DocumentComplete事件等。
    看了下代码应该是 invoke 函数里面添加就可以了吧?但是俺看的不太懂,
    能否给个具体的例子,如DocumentComplete 事件的。
    谢谢!

    • admin说:

      你看到有个Events的属性吗,是个IDispatch.
      你只要自己实现一个这个接口的实现即可.然后设置给这个属性.
      当发生事件的时候你这个接口的Invoke方法就会被调到.
      然后根据DispID就可以知道是什么事件.
      例如DispID= DISPID_DOCUMENTCOMPLETE就是你说的DocumentComplete 事件.

  7. 喜欢一个人说:

    老大有没有尝试过在线程中操作webbrowser?
    貌似会有冲突,做一些操作比如赋值啥的,总是异常跳出……

  8. 匿名说:

    很有意思!!!!

  9. 喜欢一个人说:

    老大我又来啦。。。不知道为什么一遇到webbrowser的问题就想起这篇文章。。
    这次带来一个新问题,但是可能比较棘手。。就是怎么操作安全控件下的元素?
    比如说这个登陆页面http://www2.baidu.com/如何赋值?

  10. Anonymous说:

    直接使用ATL,用D7+KOL System DCU单元替换编译后只有13.5K,UPX后只有9.5K,加上Manifest文件也只有10k。

  11. 一如当初说:

    在浏览器中无法通过快捷键复制文字,如何解决呢?
    比如打开百度,在搜索栏随便输入,按Ctrl+C复制,然后在记事本中Ctrl+V无法拷贝

  12. mymantis说:

    您好,请问下,如何去掉加载后浏览器窗口可能会出现的滚动条,还有浏览器的窗口边框如何去掉?

  13. ying32说:

    好东西啊,解决了在FMX下没有浏览器的尴尬

  14. vincent说:

    感謝分享
    單 run wb.exe 會出現病毒警訊
    我在 Win7 X64 下 用XE6 run 也會出現病毒警訊
    Avira Antivirus 擋的
    HEUR/APC(Cloud)

    • vincent说:

      1.用64bit build 就可以執行
      但是 防毒會自動跳出scan
      2.會是 IE7 還是其他版本?
      nidbox.com 會檢測為IE7
      也有測為IE8
      我主機是IE11

      • admin说:

        1.报毒这个没办法了,现在很多木马都是Delphi写的.
        以至于杀毒软件纷纷把一些特征加到毒库,导致很多Delphi开发的软件被误报.比如空From上放个按钮,编译出来就被报病毒.
        2.Webbrowser的IE内核的版本号默认是IE7,IE8,如果是高版本要设置注册表.具体怎么弄注册表请自己百度

发表评论

电子邮件地址不会被公开。

您可以使用这些HTML标签和属性: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <strike> <strong>

你必须启用JavaScript