求信息条提示的資料(Windows外壳)

[vansoft]

信息条提示 Infotip
文件类外壳对象 Desktop Update
IQueryInfo 当鼠标移到某个文件类型文档上时显示简短文本信息

[迈克揉索芙特]

我相信几乎每一台电脑上都会安装Winzip的，在最新的Winzip 8.0里它增加了一项特殊功能，就是当你的鼠标在资源管理器中的zip文件停留几秒钟后，会显示一个飞跃提示的信息告诉你zip文件里有多少个压缩文件，如图2.3所示。其实Winzip使用的就是文件飞跃提示扩展技术（不过前提条件是安装了IE4或以上版本的浏览器）。

实现这个扩展必须编写一个实现IPersistFile和IQueryInfo接口(除了标准的IUnknown接口外)进程内的COM Server。IPersistFile接口使当前文件名可以被传递到COM对象，而IQueryInfo则把对应文件的信息反馈回外壳，然后外壳负责显示信息。这实际上是一个非常简单的过程，但奇怪的是甚至在最新的Windows SDK里也没有记载。

下面是建立一个基本的Infotip扩展的详细步骤。这个扩展可以获取MP3歌曲文件的ID3-Tag中的信息，并显示出来。首先，创建一个新的ActiveX library (File |New |ActiveX|Active Library)并添加IPersistFile和IQueryInfo接口，得到下列文件：

Define a new type as below:

TInfoTip = class(TComObject, IQueryInfo, IPersistFile)

private

fName : string;

protected

{ IQueryInfo }

function GetInfoTip(dwFlags: DWORD; var ppwszTip: PWideChar): HResult;
stdcall;

function GetInfoFlags(out pdwFlags: DWORD): HResult; stdcall;

{ IPersistFile }

function IsDirty: HResult; stdcall;

function Load(pszFileName: POleStr; dwMode: Longint): HResult;
stdcall;

function Save(pszFileName: POleStr; fRemember: BOOL): HResult;
stdcall;

function SaveCompleted(pszFileName: POleStr): HResult; stdcall;

function GetCurFile(out pszFileName: POleStr): HResult; stdcall;

function GetClassID(out classID: TCLSID): HResult; stdcall;

end;

implementation

uses ComServ;

对于这个扩展，IPersistFile惟一重要的方法是Load，至于IpersistFile其他的方法只要返回E_NOTIMPL就可以了，所以IpersistFile的其他方法都实现为类似下面的方法：

function TInfoTip.Save(pszFileName: POleStr; fRemember: BOOL): HResult;

begin

Result := E_NOTIMPL;

end;

当外壳调用IPersistFile.Load，它会传递文件名作为pszFileName的参数给COM对象，这时要把文件名保存起来，因为后面要用到它（注意的是pszFileName的类型是PoleStr，实际上等同于类型 PWideChar）。下面对文件名进行保存：

function TInfoTip.Load(pszFileName: POleStr; dwMode: Integer): HResult;

begin

WideCharToStrVar(pszFileName, fName);

Result := S_OK;

end;

同样IQueryInfo接口的GetInfoFlags方法不被外壳调用，所以也只需要返回E_NOTIMPL就可以了。整个扩展的核心部分是IQueryInfo.GetInfoTip方法。 DwFlags参数没有被外壳调用，所以可以忽略它，而ppwszTip参数就是用来返回想要显示的信息 (是一个 UNICODE 字符串)。要注意的是，必须为它分配内存，然而释放内存则由外壳负责。Delphi里有一个非常有用的函数StringTooleStr，这个函数接受一个Pascal类型的字符串参数，分配必需的内存，然后把它转化成PWideChar。

过程的核心部分是获得MP3文件中的ID3-Tag信息。一个MP3文件包含有一个ID3-Tag头，它用来提供艺术家、标题、专辑、出版年份和歌曲流派等信息。这个头总是128字节长并位于MP3文件末尾。ID3-Tag 结构是这样的：

type

TID3Tag = packed record // 128 字节

TAGID: array[0..2] of char; // 3 字节: 必须是TAG

Title: array[0..29] of char; // 30 字节: 歌曲标题

Artist: array[0..29] of char; // 30 字节: 演唱歌曲的艺术家

Album: array[0..29] of char; // 30 字节: 歌曲专辑

Year: array[0..3] of char; // 4 字节: 出版年份

Comment: array[0..29] of char; // 30 字节: 评论

Genre: byte; // 1 字节: 种类标识

end;

我们要做的就是读取fName文件，跳到倒数第128个字节，读取ID3-Tag信息，并将其格式化成字符串。下面就是实现的IQueryInfo.GetInfoTip方法，注意这里我们要返回S_Ok的结果。

function TInfoTip.GetInfoTip(dwFlags: DWORD; var ppwszTip: PWideChar):
HResult;

var

id3tag: Tid3tag;

mp3file: Tfilestream;

s:string;

begin

mp3file:=Tfilestream.create(fName,fmOpenRead);

try

mp3file.position:=mp3file.size-128; // 跳到id3tag

mp3file.Read(id3tag,SizeOf(id3tag));

s:=' 标题：'+id3tag.title+#10#13+ 艺术家:

'+id3tag.artist+#10#13+

' Album: '+id3tag.album+#10#13+ 年份:

'+id3tag.year+#10#13+ 注释:

'+id3tag.comment+#10#13+ 风格-ID:

'+inttostr(id3tag.genre);

finally

mp3file.free;

end;

ppwszTip := StringToOleStr(s);

Result := S_OK;

end;

最后就是注册COM Server使之同文件相关联，我们要重载COM类工厂对象的UpdateReigistry 方法来添加额外的注册表项。

下面是我们要在注册表中添加的表项：

HKEY_CLASSES_ROOT

\.txt

\ShellEx

\{00021500-0000-0000-C000-000000000046}

{00021500-0000-0000-C000-000000000046}是IqueryInfo接口的GUID，我们不能改变它，最后点击菜单 (Run | Register ActiveX Server.)来注册它。

很重要的是一旦提示信息被显示出来，动态连接库就被装入内存，这时就无法重新编译或UnRegister库了。要想重新编译，必须用任务管理器关闭explorer.exe。

注意：要想在Windows NT和Windows 2000下正常工作，外壳扩展必须注册为管理员同意权限。很多开发者会疏忽这一点，因为大多数情况下他们是以管理员的权限登录系统的。对于Windows 9x则不需要设定这一项。

[迈克揉索芙特]

下面就是要添加的注册表项：
HKEY_LOCAL_MACHINE

\SOFTWARE

\Microsoft

\Windows

\CurrentVersion

\Shell Extensions

\Approved

在这个键下添加扩展的类标示符（CLSID）及描述信息。

下面是最后实现的注册代码：

procedure TCXFileInfoFactory.UpdateRegistry(Register: Boolean);

var

ClassID: string;

begin

if Register then begin

inherited UpdateRegistry(Register);

ClassID := GUIDToString(Class_CXFileInfo);

CreateRegKey('.mp3\ShellEx\{00021500-0000-0000-C000-000000000046}',
'', Classid);

with TRegistry.Create do

begin

try

RootKey:=HKEY_LOCAL_MACHINE;

OpenKey('\SOFTWARE\Classes\.mp3\ShellEx\
{00021500-0000-0000-C000-000000000046}',True);

WriteString('',ClassID);

finally

CloseKey;

Free;

end;

end;

end

else begin

//winnt approve registry not installed

DeleteRegKey('.mp3\ShellEx\{00021500-0000-0000-C000-000000000046}');

with TRegistry.Create do

begin

try

RootKey:=HKEY_LOCAL_MACHINE;

DeleteKey('\SOFTWARE\Classes\.mp3\ShellEx\{00021500-0000-0000
-C000-000000000046}');

finally

CloseKey;

Free;

end;

end;

inherited UpdateRegistry(Register);

end;

end;

好了，现在让我们来试验一下它的效果吧

[vansoft]

老大，怪我不好。

这里是VB版，看来我还得写清是VB方面的资料。

这是DELPHI的，还有VC的，我都有，我现在需要VB的资料。

[vansoft]

提示信息已經搞定，問題又出來了。

只能顯示17個字符以內的E文或數字。
超出或有中文就挂掉。

鬱悶啊。

樓上的，謝謝，請發我郵箱。
[e-mail]

[迈克揉索芙特]

已发，查收。

[vansoft]

終於自己搞定。

謝謝大家的幫忙。你的書還沒看呢。

我堅信，VB可以搞定一切。

[iamxiang]

把代码贴出来，楼主挑一下哈：



Private Sub CreateToolTip()
If m_lToolTipType = TTStandard Then Exit Sub '如果模式为1则不创建提示

Dim lpRect As RECT
Dim lWinStyle As Long
ttip.lpStr = m_sToolTipText

If m_lttHwnd <> 0 Then
DestroyWindow m_lttHwnd
End If

lWinStyle = TTS_ALWAYSTIP Or TTS_NOPREFIX

''create baloon style if desired
If m_lToolTipType = TTBalloon Then lWinStyle = lWinStyle Or TTS_BALLOON

m_lttHwnd = CreateWindowEx(0&, _
TOOLTIPS_CLASSA, _
vbNullString, _
lWinStyle, _
CW_USEDEFAULT, _
CW_USEDEFAULT, _
CW_USEDEFAULT, _
CW_USEDEFAULT, _
UserControl.hWnd, _
0&, _
App.hInstance, _
0&)

''make our tooltip window a topmost window
SetWindowPos m_lttHwnd, _
HWND_TOPMOST, _
0&, _
0&, _
0&, _
0&, _
SWP_NOACTIVATE Or SWP_NOSIZE Or SWP_NOMOVE

''get the rect of the parent control
GetClientRect UserControl.hWnd, lpRect

''now set our tooltip info structure
With ttip
''if we want it centered, then set that flag
If m_lttCentered Then
.lFlags = TTF_SUBCLASS Or TTF_CENTERTIP
Else
.lFlags = TTF_SUBCLASS
End If

''set the hwnd prop to our parent control's hwnd
.lhWnd = UserControl.hWnd
.lId = 0
.hInstance = App.hInstance
'.lpstr = ALREADY SET
.lpRect = lpRect
End With

''add the tooltip structure
SendMessage m_lttHwnd, TTM_ADDTOOLA, 0&, ttip

''if we want a title or we want an icon
If m_sTooltipTitle <> vbNullString Or m_lToolTipIcon <> TTNoIcon Then
SendMessage m_lttHwnd, TTM_SETTITLE, CLng(m_lToolTipIcon), ByVal m_sTooltipTitle
End If
If m_lttForeColor <> Empty Then
SendMessage m_lttHwnd, TTM_SETTIPTEXTCOLOR, TranslateColor(m_lttForeColor), 0&
End If

If m_lttBackColor <> Empty Then
SendMessage m_lttHwnd, TTM_SETTIPBKCOLOR, TranslateColor(m_lttBackColor), 0&
End If

End Sub

[迈克揉索芙特]

to 楼主
说实话,vb这方面的资料很少。尽量用其它语言转化吧。

[vansoft]

iamxiang(真心微笑)
首先謝謝你，但你答非所問了。

Modest(塞北雪貂) --- (偶最欣赏楼主的分)
找到一本電子書，但說得也不太全，而且是E文的。

[迈克揉索芙特]

我有汉化的电子书，要否？

[迈克揉索芙特]

是vc的。