DelphiXE4开发一个40KB的浏览器


用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我想体积会更小一些吧.不过因为太麻烦,还没有验证.

最后附上全部源代码.

http://pan.baidu.com/s/1GdC40


来源:http://www.raysoftware.cn/?p=241


联系电话:
020-00000000
联系电话:
020-00000000
联系电话:
020-12345678