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