【前言】
Outlook Express是一款大家比较熟悉的邮件工具，其HTML编辑器一直是众多程序员竞相模仿的目标。作者最近在一个项目的开发中，开始接触HTML编辑器的设计，并遇到了很多的难题。目前网络上关于IE编程的文章中，涉及MSHTML编辑器的部分，又大多集中在VC领域，用Delphi作为解决方案的少之又少。在经过一番艰难的摸索之后，作者积累了一些成功的经验。并撰成此文，希望与大家共同探讨。
注：本文将涉及到COM编程，由于COM的复杂性，不免会有晦涩难懂之嫌。为了让阅读不至于成为一种折磨，作者将尝试另一种写作模式。文章将随着一个叫做W的程序员的编程思路展开，以通俗易懂的叙事方式带领读者一起探讨在MSHTML编辑器的开发过程中可能遇到的一些棘手问题。对于某些需要强调的关键术语，文中将适时的给出注解，以便读者更好的领会。
【学习目标】
通过本文的阅读，读者将可以学习到以下内容：
l 掌握TWebBrowser控件的用法；
l 理解IHTMLDocument2和IDocHostUIHandle接口；
l 探讨在MSHTML中如何加载字符流；
l 找回在MSHTML编辑器中丢失的回车键；
l 实现工具栏的自动感应；
l 自定义MSHTML编辑器强大的粘贴功能；
本文假定读者已经具备初步的COM知识和Delphi接口的编程经验，如果您需要对COM和接口知识作进一步的深入了解，请参考其它相关文章。
【关键字】
TWebBrowser、MSHTML、自动化对象、IHTMLDocument2、IDocHostUIHandler、
FilterDataObject、IDataObject、剪贴板、粘贴
【正文】
一个笑话的启示
在一次程序员大会上，主持人为了活跃气氛，做了个小游戏。他问台下的程序员：如果有谁在小的时候拆过闹钟的请举手。台下的程序员们全都举起了手。主持人又问：那么又有谁后来把闹钟装回去的请举手。举起手来的程序员们又都把手放下了。
这个笑话从侧面说明了一个问题，追根求源正是大多数程序员的天性。缺少追根求源的精神，软件设计就会缺少创新的动力。也正是由于有了追根求源的精神，越来越多的软件新手跨越了初期的彷徨，走上了软件高手的道路。
未来的一天，程序员W所在的软件公司接到一个信息管理系统的设计项目。由于最近W刚参加完公司组织的为期一周的COM培训，于是项目经理Y便把项目中最具挑战的编辑器部分交给他来完成。用户要求实现一个类似Outlook Express（以下简称OE）那样所见即所得式的编辑器，并可以支持多种来源的粘贴操作。尽管W此前对OE编辑器的原理一无所知，但他还是面带微笑并充满自信的接受了挑战。
揭开OE编辑器的面纱
在以往的使用过程中，W发现OE编辑器确实是一款强大的编辑工具。无论是编辑还是粘贴，OE编辑器都能完美的实现所见即所得的效果。OE编辑器本质上是一款HTML编辑器，其中的数据和格式都以HTML代码的形式来保存。W以前曾研究过网页上的HTML编辑器，该编辑器是通过DHTML技术来实现的。那么，OE编辑器和IE浏览器之间是否有什么关系呢？
为了搞清楚这个问题，W调出VC的Spy++探个究竟。拖动Spy++那个神奇的雷达指向OE编辑窗口，Spy++迅速的找到了窗口的类型：“Internet Explorer_Server”，这是个IE服务器窗口类型，这究竟是什么意思呢？
微软的IE浏览器的核心部分是SHDOCVW.DLL和MSHTML.DLL。从下面的Internet Explorer的架构图可以看到，IE其实只是一个外壳程序，真正的浏览网页、记录历史等工作都是由封装在SHDOCVW.DLL中的WebBrowser Control来完成的。而HTML的解析、脚本引擎、java虚拟机、插件宿主等，则由SHDOCVW.DLL通过调用MSHTML.DLL来完成。通过SHDOCVW.DLL提供的丰富接口，网页中的元素可以访问外壳应用程序提供的属性和方法；而通过MSHTML.DLL提供的接口，外壳应用程序则反过来可以访问网页中元素的属性、方法、行为、事件等等。
毫无疑问，OE编辑器正是通过对WebBrowser控件和MSHTML的封装实现了HTML的编辑功能。由于WebBrowser属于ActiveX控件，所以，利用Delphi的ActiveX导入向导，可以轻松的实现对WebBrowser控件的封装。导入后将在Delphi的Import文件夹下自动生成两个TLB文件：SHDocVw_TLB和 MSHTML_TLB。
Delphi自带的TWebBrowser
从Delphi4开始，Delphi就在Internet组件面板上提供TWebBrowser组件，作为对WebBrowser控件的封装。由于Delphi的封装并不能保证和最新的WebBrowser控件版本相一致，建议Delphi7以前的读者先卸载该组件并重新导入Shdocvw.dll，以便使用最新的接口功能，
进入TWebBrowser的神奇世界
感谢Delphi，使得一切都变得如此轻松。W启动Delphi，新建一个项目，在Internet组件面板上找到TWebBrowser组件，然后拖放到窗体上，并重命名为“wbEditor”。由于对TWebBrowser组件缺乏了解，W决定先请教一下公司的Delphi高手老D。
W：老D，你知道TWebBrowser组件的用法吗？
D：这个简单。TWebBrowser有一个Document属性，你看一下，这是个IDispatch接口类型的属性。对了，IDispatch接口你知道吗？
W：（支支吾吾）刚学过，不过没弄懂……
D：简单点说吧。为了给解释型语言——例如Javascript脚本语言——提供调用COM对象服务的能力，于是出现了COM自动化对象。由于解释型语言无法象编译型语言那样实现和COM对象的早期绑定，所以，COM自动化对象便提供了IDispatch接口供自动化客户端调用。通过IDispatch接口，自动化机制中的客户端就可以动态的调用COM自动化对象中的方法了……总之啊，IDispatch接口是实现COM自动化对象机制的关键。你明白吗？
W：（似懂非懂，不过想想反正以后还可以再学）嗯，知道了。然后呢？
D：OK。由于我们并不需要自动化机制，IDispatch接口对我们来说用处不大。但我们可以利用它通过Delphi中的as运算符查询到其它我们想要的接口。例如，IHTMLDocument2接口在编程中用的比较多，用它可以实现大多数的DHTML功能。
W：哦～IHTMLDocument2接口（自言自语）。那如何进入编辑状态呢？
D：答案就在这个IHTMLDocument2接口中。这个接口中有一个disignMode属性，在运行时置为“On”就可以从浏览模式转变为编辑模式了。当然了，前提是必须保证Document不能为空。有个简单的办法，在初始化时，通过TWebBrowser的Navigate方法导航到一个空白页面，有一个busy属性可以用来监测是否加载完毕……
W：哦……哦……（一边听一边敲出下面的代码）运行成功！太感谢了。
procedure TForm1.FormCreate(Sender: TObject);
begin
wbEditor.Navigate('about:blank');
while wbEditor.busy do Application.ProcessMessages;
(wbEditor.Document as IHTMLDocument2).designMode := 'On';
end;
在老D的帮助下，W对TWebBrowser的用法有了一个初步的了解。很显然，接口在TWebBrowser的编程中至关重要。此时，为了加深对接口的了解，W决定对IHTMLDocument2接口做一个深入的了解。
小知识：
在执行TWebBrowser的某个方法以进行某些期望的操作如ExecWB等时候，可能会碰到如“试图激活未注册的丢失目标”或“OLE对象未注册”等错误提示，或者并没有任何出错信息但却得不到希望的结果。这是因为TWebBrowser本身是一个OLE类型的COM组件，你需要在使用TWebBrowser前对OLE进行一些初始化工作，这个工作可以放到单元的initialization和finalization段中来完成。
{uses ActiveX}
initialization
OleInitialize(nil);
finalization
try
OleUninitialize;
except
end;
浅谈IHTMLDocument2接口
背景知识：
为了使用IHTMLDocument2接口，你必须包含MSHTML.pas单元（如果你采用ActiveX导入的方式，这个单元就是MSHTML_TLB.pas）
MSHTML控件的Document对象实现了包括IHTMLDocument2接口在内的多个接口。其中Document对象的常用属性、子集合、方法等都集中在IHTMLDocument2接口中。通过IHTMLDocument2接口，可以利用DHTML的强大功能对网页对象进行各种增删操作和属性的动态改变。
在IHTMLDocument2的接口方法中，有一个特殊的方法引起了W的注意，这就是execCommand方法。很显然，这个方法与命令的调用有关。execCommand方法声明如下：
//对当前文档、选定内容或指定范围执行特定的操作
HRESULT execCommand(
BSTR cmdID,
VARIANT_BOOL showUI,
VARIANT value,
VARIANT_BOOL *pfRet
);
其中，cmdID参数定义了大多数常用的格式化命令。这样，OE编辑器工具栏上的大多数编辑功能完全可以通过这个方法来实现。为了验证自己的想法，W在窗体上新建一个按钮，并写了一些测试代码。运行结果完全符合W的猜测。
procedure TForm1.Button1Click(Sender: TObject);
begin
with wbEditor.Document as IHTMLDocument2 do
begin
//改变字体的前景色
execCommand('ForeColor', False, 'red');
//改变字体的粗细
execCommand('Bold', False, 1);
//打开插入图片对话框，插入图片
execCommand('InsertImage', True, '');
//文本居中
execCommand('JustifyCenter', False, 0);
//执行撤销上一步操作
execCommand('Undo', False, 0);
end;
end;
注：为了确保execCommand调用成功，你必须保证当前页面已经完全加载。
如果考虑效率问题，IOleCommandTarget::Exec方法则可以提供更好的性能。事实上，execCommand命令正是对IOleCommandTarget::Exec方法的一个封装，其目的主要是为了给Script类型的语言提供一个方便的调用入口。通过以下示例学习如何获得对IOleCommandTarget接口的访问并调用Exec方法：
IOleCommandTarget::Exec方法
procedure TForm1.Button2Click(Sender: TObject);
const
CGID_MSHTML: TGUID = '{DE4BA900-59CA-11CF-9592-444553540000}';
begin
(wbEditor.Document as IOleCommandTarget).Exec(
@CGID_MSHTML,
IDM_BOLD, //Bold命令的ID，请参考MSDN有关帮助
OLECMDEXECOPT_DODEFAULT,
0,
POlevariant(nil)^);
end;
再谈Document对象的初始化和赋值
在IHTMLDocument2接口中，Document对象是实现DHTML模型的核心。要实现对Document对象的任何操作，必须要等到Document对象的初始化操作结束之后才能进行。通过Navigate方法，可以实现对Document对象的初始化。需要注意的是，Navigate方法并不能识别常规方式下的相对路径，如果需要导航到某个文件，必须指定绝对路径。
procedure TForm1.InitDocument;
begin
wbEditor.Navigate('about:blank');
while wbEditor.ReadyState <> READYSTATE_COMPLETE do
Application.ProcessMessages;
end;
在Document文档对象完成初始化之后，就可以对Document对象进行赋值。赋值对象既可以是字符串，也可以是内存中的数据流。通过Document对象的IPersistStreamInit接口，就可以实现数据流的加载。
function TForm1.LoadFromStream(const AStream: TStream): HRESULT;
begin
if not Assigned(wbEditor.Document) then
InitDocument;
AStream.seek(0, 0);
Result := (wbEditor.Document as IPersistStreamInit).Load(TStreamadapter.Create(AStream));
end;
利用数据流的加载方法，可以进一步的实现字符串的加载。
function TForm1.LoadFromStrings(const AStrings: TStrings): HRESULT;
var
M: TMemoryStream;
begin
M := TMemoryStream.Create;
try
AStrings.SaveToStream(M);
Result := LoadFromStream(M);
except
Result := S_FALSE;
end;
M.free;
end;
找回被编辑器吃掉的回车
有一个问题从一开始就引起了W的注意，那就是MSHTML编辑器竟然经常不响应回车事件。也就是说，当在编辑器中按下回车时不能产生一个换行——编辑器面对回车按键毫无反应，就好像回车键被它吃掉一样。类似的，象TAB、Delete、BACKSPACE、→、←等快捷键上也会出现这种情况。这真是一件令人匪夷所思的事。
从本质上说，TWebBrowser是一个特殊的OLE控件。虽然Delphi在封装过程中使它继承了TWinControl，但它似乎并没有由此取得TWinControl的自动获得焦点的能力。看来，极有可能是由于Delphi的VCL消息处理机制同OLE之间存在某种冲突，导致了OLE自己吃掉了部分键盘消息。
既然如此，W实现想不出什么更好的办法。要解决这个问题，一个比较合理的解决方案就是直接捕获并处理Windows的消息映射。于是，他尝试写了一个消息处理方法并把这个方法句柄指定给了Application.OnMessage事件。这样，丢失的回车键又回来了。
procedure TForm1.IEMessageHandler(var Msg: TMsg; var Handled: Boolean);
const
StdKeys = [VK_TAB, VK_RETURN]; { 标准键 }
ExtKeys = [VK_DELETE, VK_BACK, VK_LEFT, VK_RIGHT]; { 扩展键 }
fExtended = $01000000; { 扩展键标志 }
begin
Handled := False;
with Msg do
if ((Message >= WM_KEYFIRST) and (Message <= WM_KEYLAST)) and
((wParam in StdKeys) or (GetKeyState(VK_CONTROL) < 0) or
(wParam in ExtKeys) and ((lParam and fExtended) = fExtended)) then
try
if IsChild(wbEditor.Handle, hWnd) then
{ 处理所有的浏览器相关消息 }
begin
with wbEditor.Application as IOleInPlaceActiveObject do
Handled := TranslateAccelerator(Msg) = S_OK;
if not Handled then
begin
Handled := True;
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
except
end;
end; // IEMessageHandler
procedure TForm1.FormCreate(Sender: TObject);
begin
……
Application.OnMessage := IEMessageHandler;
end;
工具栏的动态感应
工具栏已经设计完毕，下一个问题是，如何让工具栏能自动反映编辑器当前选定部分的编辑状态。也就是说，如果当前文本是粗体居中，那么粗体和居中按钮应该处于选中状态。很显然，只要能写出编辑器的OnDisplayChanged事件，一切都将迎刃而解。那么必须得有一个接口方法，当编辑器状态发生改变时，在这个方法中调用OnDisplayChanged事件即可。在MSDN的帮助下，W找到了IDocHostUIHandle接口，并锁定了其中的UpdateUI方法。问题思路已经很清晰：当MSHTML组件的状态发生改变时，该接口中的UpdateUI方法将被调用。
IDocHostUIHandle工作原理：
当MSHTML组件被加载到内存并执行初始化时，MSHTML开始在宿主客户端查询一个叫IDocHostUIHandle的接口实现。如果找到这样的接口实现，MSHTML将在其运行期间，根据需要动态的调用IDocHostUIHandle中的对应方法。
通过对IDocHostUIHandle接口的实现，MSHTML组件将能直接和用户接口界面（UI）进行通信。这样，宿主程序将有机会修改用户界面中的菜单、工具条、以及其它的用户接口元素。
为了实现UpdateUI方法，W决定从TWebBrowser继承并产生一个新的组件，新组件将实现对IDocHostUIHandle的封装，新组件的名字就叫TWebEditor。在UpdateUI的实现中将调用OnDisplayChanged事件句柄——Delphi事件的实现思想实在太妙了。
TWebEditor = class(TWebBrowser, IDocHostUIHandle)
……
private
FOnDisplayChanged: TNotifyEvent; //声明私有事件变量
function UpdateUI: HRESULT; stdcall;
publish
property OnDisplayChanged: TNotifyEvent
read FOnDisplayChanged write FOnDisplayChanged; //声明属性事件
end;
function TEmbeddedED.UpdateUI: HRESULT;
begin
//在编辑器状态改变时，通知宿主程序
if Assigned(FOnDisplayChanged) then
FOnDisplayChanged(self);
Result := S_OK; //表示已经做了处理
end;
编译并安装TWebEditor组件到Internet面板，然后替换TWebBrowser组件。OK，双击OnDisplayChanged事件并编写代码吧。
自定义上下文菜单
很多时候，上下文菜单在编辑器的使用中可以为用户提供更方便的功能调用。但MSHTML编辑器提供的上下文菜单并不是W所希望的。所以，为了让自己的编辑器看起来更专业一点，W需要一个自己的上下文菜单。有了上面对IDocHostUIHandle编程的经历，W很快发现ShowContextMenu接口方法正是自己所需要的。W设计了一个PopupMenu菜单，重命名为ppMenu，然后在新TWebEditor组件中添加以下代码：
……
//声明一个显示上下文事件类型
TShowContextMenuEvent = function(const dwID: DWORD; const ppt: PPOINT;
const pcmdtReserved: IUnknown; const pdispReserved: IDispatch): HRESULT of object;
TWebEditor = class(TWebBrowser, IDocHostUIHandle)
……
private
FOnShowContextMenu: TShowContextMenuEvent; //声明响应上下文菜单私有事件变量
……
function ShowContextMenu(const dwID: DWORD; const ppt: PPOINT;
const pcmdtReserved: IUnknown;
const pdispReserved: IDispatch): HRESULT; stdcall;
publish
property OnShowContextMenu: TShowContextMenuEvent
read FOnShowContextmenu write FOnShowContextmenu; //声明属性事件
end;
function TWebEditor.ShowContextMenu(const dwID: DWORD; const ppt: PPOINT;
const pcmdtReserved: IUnknown; const pdispReserved: IDispatch): HRESULT;
begin
//在MSHTML组件企图显示上下文菜单时，通知宿主程序
if Assigned(FOnShowContextMenu) then
RESULT := FOnShowContextMenu (dwID, ppt, pcmdtreserved, pdispreserved)
else
RESULT := S_FALSE;
end;
[提示：组件需要重新编译并安装（下同）]
在响应wbEditor的OnShowContextMenu事件代码中，返回S_OK将告诉MSHTML组件你将使用自定义菜单，否则返回S_FALSE。
function TForm1.wbEditorShowContextMenu(const dwID: Cardinal;
const ppt: PPoint; const pcmdtReserved: IInterface;
const pdispReserved: IDispatch): HRESULT;
begin
ppMenu.Popup(ppt.X, ppt.Y); //显示自定义菜单
Result := S_OK; //告诉MSHTML组件将显示自定义菜单
end;
剪贴板中的玄机
OE编辑器支持多来源的粘贴功能给W留下的印象很深刻，所以，W对MSHTML编辑器的粘贴能力同样寄予了厚望。但不管如何，他需要做一些测试以验证自己的想法。他设想了一些测试来源：网页、Word文档、Excel表格、图片……
网页的粘贴很顺利，几乎保持原貌；Excel表格也完全正常；图片的粘贴则完全不被编辑器支持——不过可以利用插入图片功能来替代——然而，Word的粘贴却遇到了一些麻烦：如果Word中包含图片或自定义对象，这部分内容将无法显示。是Word的问题吗？W回到OE中，粘贴同样的内容，显示正常。看来，问题还在MSHTML编辑器中。
通过上下文菜单，W打开源文件查看。Word粘贴过来的HTML代码中，充斥了大量的XML代码，图片和对象则被一些奇怪的XML标签所包围，而同样的内容在OE编辑器中却显示为正常的HTML代码。怎么回事？W脑子第一时间蹦出一个很COOL的想法：跟踪剪贴板。
根据剪贴板的原理，在获取剪贴板内容之前，必须指定要获取内容的格式。由于剪贴板中的数据可能存在多种格式，所以有必要对剪贴板的格式类型先做一些了解。W写下了以下的测试代码：
procedure TForm1.Button3Click(Sender: TObject);
var
i: integer;
Buffer: PChar;
s: string;
begin
Memo1.Lines.Clear; //增加了一个Memo控件来跟踪数据
with TClipboard.Create do //利用TClipboard追踪剪贴板
begin
GetMem(Buffer, 20);
for i:=0 to FormatCount - 1 do
begin
GetClipboardFormatName(Formats[i], Buffer, 20);
s := StrPas(Buffer);
Memo1.Lines.Add(Format('%s:%d', [s, Formats[i]]));
end;
FreeMem(Buffer);
Free;
end;
end;
点击Button3，在Memo1文本框中显示出以下的内容：
DataObject:49161
Object Descriptor:49166
Rich Text Format:49312
HTML Format:49394
HTML Format:14
HTML Format:3
PNG:49672
GIF:49536
JFIF:49538
……
很明显，第4行的“HTML Format:
procedure TForm1.Button4Click(Sender: TObject);
var
s: string;
hMem: DWORD;
CF_HTML: DWORD; // 声明一个CF_HTML剪贴板格式
txtPtr: PChar;
begin
CF_HTML := RegisterClipboardFormat('HTML Format'); //注册HTML Format格式
with TClipboard.Create do
begin
hMem := GetAsHandle(CF_HTML);
txtPtr := GlobalLock(hMem);
s := StrPas(txtPtr);
GlobalUnlock(hMem);
Memo1.Lines.Add(s);
Free;
end;
end;
这回终于水落石出。在Memo1中，W见到了Word文档被拷贝以后在剪贴板中以HTML格式存在的真实内容：
Version:1.0
StartHTML:0000000105
EndHTML:0000005323
StartFragment:0000003873
EndFragment:0000005283
<html xmlns:v="urn:schemas-microsoft-com:vml"
xmlns:o="urn:schemas-microsoft-com:office:office"
xmlns:w="urn:schemas-microsoft-com:office:word"
xmlns="http://www.w3.org/TR/REC-html40">
……
<body ……>
<!--StartFragment--><span ……><!--[if gte vml 1]>
<v:shapetype ……>
<v:imagedata src="file:///C:\DOCUME~1\tttk\LOCALS~1\Temp\msohtml1\01\clip_image001.gif"
o:title="el2"/>……
</v:shape><![endif]--><![if !vml]><img width=128 height=128
src="file:///C:\DOCUME~1\tttk\LOCALS~1\Temp\msohtml1\01\clip_image001.gif"
v:shapes="_x0000_i1025"><![endif]></span><!--EndFragment-->
……
（为了节省篇幅，作者删去了大量无用的信息）
W欣喜的发现，HTML中熟悉的<img>标签出现在剪贴板中，虽然在最后的粘贴结果中没有看到img元素，那也一定是里面的<![if]>语句捣的鬼。现在只要把里面的HTML部分提取出来不就行了吗？通过规则表达式的帮助，一切都轻松搞定！
procedure TForm1.FilterData(var S: string);
var
isOffice: Boolean;
begin
with TRegExpr.Create do
begin
isOffice := ExecRegExpr('(?i)xmlns:o="urn:schemas-microsoft-com:office:office"', S);
Expression := '(?i)<!--StartFragment-->(.*)<!--EndFragment-->';
if Exec(S) then S := Match[1];
if isOffice then //trip office document
begin
S := ReplaceRegExpr('(?i)<!--[^>]+?>.+?<[^>]+?-->', S, '');
S := ReplaceRegExpr('(?i)<[^\]|>]*\[[if|endif][^>]+>', S, '');
S := ReplaceRegExpr('(?i)</?[v|o|w]:[^>]+>', S, '');
S := ReplaceRegExpr('(?i)[\r|\n]{2,}', S, ' ');
end;
end;
S := UTF8Decode(S);
end;
注：TRegExpr类是第三方开源的规则表达式类，感兴趣的读者请到http://regexpstudio.com/下载试用。
如何更新修改后的数据？
W没高兴多久。因为他发现，虽然掌握了剪贴板的实际内容，但他依然不知道如何把修改后的数据更新到编辑器中。因为编辑器没有直接的粘贴方法可以调用，W首先想到的是把修改后的数据重新赋值给剪贴板。但如果用户希望多次粘贴，这个方法将显然行不通。如果有这样一个粘贴事件，在这个粘贴事件中提供In和Out两种类型的参数，问题不就解决了吗？那么如何实现这个粘贴事件呢？答案依然在IDocHostUIHandle接口中，W找到了FilterDataObject方法，该方法恰好有两个In和Out类型的参数：
HRESULT FilterDataObject(
IDataObject *pDO,
IDataObject **ppDORet
);
当粘贴操作发生时，MSHTML组件将调用IDocHostUIHandle接口的FilterDataObject方法，并把内存中的数据对象通过pDO参数传入，如果该函数返回S_OK并且ppDORet参数不为NULL，MSHTML组件将尝试从ppDORet接口读出修改后的数据。根据这个想法，W很快的实现了下面的OnPaste事件：
//声明粘贴事件类型
TPasteEvent = function(const pDO: IDataObject;
var ppDORet: IDataObject): HRESULT of object;
TWebEditor = class(TWebBrowser, IDocHostUIHandle, IOleCommandTarget, …)
……
private
……
FOnPaste: TPasteEvent;
function FilterDataObject(const pDO: IDataObject;
var ppDORet: IDataObject): HRESULT; stdcall;
……
publish
//声明粘贴事件属性
property OnPaste: TPasteEvent read FOnPaste write FOnPaste;
……
end;
implementation
function TWebEditor.FilterDataObject(const pDO: IDataObject;
out ppDORet: IDataObject): HRESULT;
begin
{ 如果数据对象被替换，返回 S_OK，否则返回S_FALSE
虽然文档没有明显指出, 这个方法只能用在处理粘贴事件}
if Assigned(FOnPaste) then
Result := FOnPaste(pDO, ppDORet)
else
Result := E_NOTIMPL;
end;
在处理OnPaste事件时，W遇到了新的麻烦。他需要知道两件事，一是如何从pDO参数取得数据；第二是如何把修改后的数据送给ppDORet参数。由于pDO和ppDORet两个都是IDataObject接口类型的参数，那么有必要先考察一下IDataObject接口的用法。
IDataObject接口：
在OLE对象的数据操作方法中，IDataObject接口在传输和转换数据的过程中起到了关键的作用。OLE对象通过调用IDataObject接口对象的相关方法保存需要操作的数据格式、存储媒介等信息。
在传送和接收数据前，OLE对象会根据需要分别填充FORMATETC和STGMEDIUM结构中的相关字段。传送数据时，OLE对象通过多次调用SetData方法来设置要传输数据的多种格式。相反，在获取数据时，OLE对象将先调用QueryGetData方法来查询是否存在指定格式，然后通过GetData方法来取得数据。
在IDataObject接口中，FORMATETC和STGMEDIUM这两个结构类型尤为重要，它们在Delphi中的定义如下：
tagFORMATETC = record
cfFormat: TClipFormat;
ptd: PDVTargetDevice;
dwAspect: Longint;
lindex: Longint;
tymed: Longint;
end;
TFormatEtc = tagFORMATETC;
FORMATETC = TFormatEtc;
tagSTGMEDIUM = record
tymed: Longint;
case Integer of
0: (hBitmap: HBitmap; unkForRelease: Pointer{IUnknown});
1: (hMetaFilePict: THandle);
2: (hEnhMetaFile: THandle);
3: (hGlobal: HGlobal);
4: (lpszFileName: POleStr);
5: (stm: Pointer{IStream});
6: (stg: Pointer{IStorage});
end;
TStgMedium = tagSTGMEDIUM;
STGMEDIUM = TStgMedium;
了解了IDataObject接口的原理之后，接下来的问题变得很清晰。很显然，要实现对数据的过滤，必须要把修改后的数据通过一个IDataObject类型的对象传递给ppDORet参数。因为在Delphi中并没有这样一个实现了IDataObject接口的类可供使用，所以这个类必须自己来实现。根据IDataObject接口的工作原理，这个类中只需要实现IDataObject接口中的QueryGetData、GetData两个方法即可，其它暂时不需要的方法设置成抽象（abstract）即可。
W的设计思路如下：在这个类的构造方法中读入pDO参数对象并保存在私有变量FDataSource中。在QueryGetData方法的实现中只简单的返回S_OK，表示支持任何的格式；最后在GetData方法中先取得FDataSource的数据，并在实现过滤后把数据保存到方法的medium（out类型）参数中。这样，当MSHTML调用ppDORet参数并调用其GetData方法时，将能够从medium参数中取得想要的数据。
type
TDataObject = class(TInterfacedObject, IDataObject)
private
FDataSource: IDataObject;
function GetGlobalData(dataFormat: DWORD): string;
public
constructor Create(pDO: IDataObject);
{ 接口未实现部分全部声明为abstract即可 }
function DAdvise(const formatetc: TFormatEtc; advf: Longint;
const advSink: IAdviseSink;
out dwConnection: Longint): HResult; virtual; stdcall; abstract;
function DUnadvise(dwConnection: Longint): HResult; virtual; stdcall; abstract;
function EnumDAdvise(out enumAdvise: IEnumStatData): HResult;
virtual; stdcall; abstract;
function EnumFormatEtc(dwDirection: Longint; out enumFormatEtc:
IEnumFormatEtc): HResult; virtual; stdcall; abstract;
function GetCanonicalFormatEtc(const formatetc: TFormatEtc;
out formatetcOut: TFormatEtc): HResult; virtual; stdcall; abstract;
function GetDataHere(const formatetc: TFormatEtc; out medium: TStgMedium):
HResult; virtual; stdcall; abstract;
function GetObjectDescriptor: HGlobal; virtual; stdcall; abstract;
function SetData(const formatetc: TFormatEtc; var medium: TStgMedium;
fRelease: BOOL): HResult; virtual; stdcall; abstract;
{ 需要实现的部分 }
function GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium):
HResult; stdcall;
function IsDataAvailable(dataFormat: DWORD): Boolean;
function QueryGetData(const formatetc: TFormatEtc): HResult; virtual; stdcall;
end;
implementation
……
constructor TDataObject.Create(pDO: IDataObject);
begin
//在初始化过程中保存数据源
FDataSource := pDO;
end;
function TDataObject.GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium): HResult;
var
s: string;
hMem: DWORD;
txtPtr: PChar;
begin
//只处理CF_HTML格式
if formatetcIn.cfFormat = CF_HTML then
begin
s := GetGlobalData(formatetcIn.cfFormat);
FilterData(s); //过滤数据
hMem := GlobalAlloc(GMEM_MOVEABLE, Length(s)); //分配全局内存
txtPtr := GlobalLock(hMem);
Move(PChar(s)^, txtPtr^, Length(s));
GlobalUnlock(hMem);
with medium do
begin
tymed := TYMED_HGLOBAL; //指定要存储数据的存储格式为全局内存
hGlobal := hMem;
unkForRelease := nil; //指定由调用者负责释放内存
end;
end;
Result := S_OK;
end;
//通过此函数取得全局内存中的数据
function TDataObject.GetGlobalData(dataFormat: DWORD): string;
var
stgMedium: TStgMedium;
formatEtc: TFormatEtc;
txtPtr: PChar;
begin
with formatEtc do
begin
cfFormat := dataFormat; //设置数据格式
ptd := nil;
dwAspect := DVASPECT_CONTENT; //指定数据类型为CONTENT
lindex := -1;
tymed := TYMED_HGLOBAL; //指定要获取数据的存储格式为全局内存
end;
//调用源数据的QueryGetData方法来查询指定格式是否存在
if FDataSource.QueryGetData(formatEtc) <> S_OK then Exit;
//调用源数据的GetData方法取得数据，并存放在stgMedium结构中
OleCheck(FDataSource.GetData(formatEtc, stgMedium));
with stgMedium do
begin
txtPtr := GlobalLock(hGlobal); //从hGlobal全局句柄中获取数据
Result := StrPas(txtPtr);
GlobalUnlock(hGlobal);
if unkForRelease = nil then
ReleaseStgMedium(stgMedium); //调用者负责释放内存
end;
end;
function TDataObject.IsDataAvailable(dataFormat: DWORD): Boolean;
begin
//MFC文档：尽管可以通过调用IDataObject的EnumFormatEtc方法来枚举格式类型，
//但通过剪贴板查询的效率更高，也更有效
Result := IsClipboardFormatAvailable(dataFormat)
end;
function TDataObject.QueryGetData(const formatetc: TFormatEtc): HResult;
begin
//在这里可以定制哪些类型的数据将被过滤
Result := S_OK;
end;
回到主窗口，重新编译TWebEditor组件并安装，然后给wbEditor的OnPaste事件添加如下代码，一切就大功告成了。
function TForm1.wbEditorPaste(const pDO: IDataObject;
var ppDORet: IDataObject): HRESULT;
begin
ppDoRet := TDataObject.Create(pDO);
Result := S_OK;
end;