分享
 
 
 

Windows外壳扩展编程之添加右键菜单

王朝delphi·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

Windows外壳扩展编程 www.applevb.com

在Windows下的一些软件提供了这样的功能:当安装了这些软件之后,当在Windows的Explore中鼠标右键单击文件或者文件夹后,在弹出菜单中就会多出与该软件操作相关的菜单项,点击该项就会激活相应的程序对用户选中的文件进行相应的操作。例如安装了Winzip之后,当用户选中一个文件夹后单击右键,在弹出菜单中就会多出一个Add To Zip和一个 Add To xxx.zip的选项,其中xxx为选中的文件夹的名称。只要单击上面的两个菜单项中的一个,就可以方便的压缩目录了。这样的功能称为Windows外壳扩展(Shell Extensions)

外壳扩展概述

下面是与外壳扩展相关的三个重要术语:

(1)文件对象(File Object)

文件对象是外壳中的一项,大家最熟识的文件对象是文件和目录,此外,打印机、控制面板程序、共享网

络等也都是文件对象。

(2)文件类(File Class)

文件类是具有某种共同特性的文件对象的集合,比如,扩展名相同的文件属于同一文件类。

(3)处理程序(Handler)

处理程序是具体实现某个外壳扩展的代码。

Windows支持七种类型的外壳扩展(称为Handler),它们相应的作用简述如下:

(1)Context menu handlers向特定类型的文件对象增添上下文相关菜单;

(2)Drag-and-drop handlers用来支持当用户对某种类型的文件对象进行拖放操作时的OLE数据传输;

(3)Icon handlers用来向某个文件对象提供一个特有的图标,也可以给某一类文件对象指定图标;

(4)Property sheet handlers给文件对象增添属性页,属性页可以为同一类文件对象所共有,也可以给一个

文件对象指定特有的属性页;

(5)Copy-hook handlers在文件夹对象或者打印机对象被拷贝、移动、删除和重命名时,就会被系统调用,

通过为Windows增加Copy-hook handlers,可以允许或者禁止其中的某些操作;

(6)Drop target handlers在一个对象被拖放到另一个对象上时,就会被系统被调用;

(7)Data object handlers在文件被拖放、拷贝或者粘贴时,就会被系统被调用。

Windows的所有外壳扩展都是基于COM(Component Object Model) 组件模型的,外壳是通过接口(Interface)来访问对象的。外壳扩展被设计成32位的进程中服务器程序,并且都是以动态链接库的形式为操作系统提供服务的。因此,如果要对Windows的用户界面进行扩充的话,则具备写COM对象的一些知识是十分必要的。

写好外壳扩展程序后,必须将它们注册才能生效。所有的外壳扩展都必须在Windows注册表的HKEY_CLASSES_ROOT\CLSID键之下进行注册。在该键下面可以找到许多名字像{0000002F-0000-0000-C000-000000000046}的键,这类键就是全局唯一类标识符。每一个外壳扩展都必须有一个全局唯一类标识符,Windows正是通过此唯一类标识符来找到外壳扩展处理程序的。在类标识符之下的InProcServer32子键下记录着外壳扩展动态链接库在系统中的位置。与某种文件类型关联的外壳扩展注册在相应类型的shellex主键下。如果所处的Windows操作系统为Windows NT,则外壳扩展还必须在注册表中的HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\ShellExtensions\Approved主键下登记。

注册表HKEY_CLASSES_ROOT主键下有几个特殊的子键,如*、Folder、Drive以及Printer。如果把外壳扩展注册在*子键下,那么这个外壳扩展将对Windows中所有类型的文件有效;如果把外壳扩展注册在Folder子键下,则对所有目录有效。

上面提到的在Windows Explore中在鼠标右键菜单中添加菜单项(我们成为上下文相关菜单)的操作属于外壳扩展的第一类,即Context menu handlers向特定类型的文件对象增添上下文相关菜单。要动态地在上下文相关菜单中增添菜单项,可以通过写Context Menu Handler来实现。

编写Context Menu Handler必须实现IShellExtInit和IContextMenu两个接口。除了IUnknown接口所定义的函数之外,Context Menu Handler还需要用到QueryContextMenu、InvokeCommand和GetCommandString这三个非常重要的成员函数。

(1)QueryContextMenu函数:每当系统要显示一个文件对象的上下文相关菜单时,它首先要调用该函数。为了在上下文相关菜单中添加菜单

项,我们在该函数中调用InsertMenu函数。

(2)InvokeCommand函数:当用户选定了某个Context Menu Handler登记过的菜单项后,该函数将会被调用,系统将会传给该函数一个指向

LPCMINVOKECOMMANDINFO结构的指针。在该函数中要执行与所选菜单项相对应的操作。

(3)GetCommandString函数:当鼠标指针移到一个上下文相关菜单项上时,在当前窗口的状态条上将会出现与该菜单项相关的帮助信息,此

信息就是系统通过调用该函数获取的。

下面我通过具体的例程来说明编写一个比较完整的上下文菜单程序,这个程序是一个文件操作程序,当安装并注册了外壳扩展的服务器动态连接库之后,当选择一个或者多个文件并单击鼠标右键后,在右键菜单中就会多出一个“执行文件操作”的上下文菜单,点击菜单就会弹出相应的程序执行文件操作。

在整个程序的编写中,外壳扩展的服务器动态连接库是有Delphi4.0编写的,而动态连接库调用的文件操作程序是由VB6编写的。下面首先介绍服务器动态连接库的编写:

服务器动态连接库的工程文件内容如下:

library contextmenu;

uses

ComServ,

ContextMenuHandler in 'Unit2.pas';

// contmenu_TLB in 'contmenu_TLB.pas';

exports

DllGetClassObject,

DllCanUnloadNow,

DllRegisterServer,

DllUnregisterServer;

{$R *.TLB}

{$R *.RES}

begin

end.

将工程文件保存为contextmenu.dpr。

服务器动态连接库的单位文件内容如下:

unit ContextMenuHandler;

interface

uses Windows,ActiveX,ComObj,ShlObj,Classes;

type

TContextMenu = class(TComObject,IShellExtInit,IContextMenu)

private

FFileName: array[0..MAX_PATH] of Char;

protected

function IShellExtInit.Initialize = SEIInitialize; // Avoid compiler warning

function SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;

hKeyProgID: HKEY): HResult; stdcall;

function QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst, idCmdLast,

uFlags: UINT): HResult; stdcall;

function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;

function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;

pszName: LPSTR; cchMax: UINT): HResult; stdcall;

end;

const

Class_ContextMenu: TGUID = '{19741013-C829-11D1-8233-0020AF3E97A9}';

{全局唯一标识符(GUID)是一个16字节(128为)的值,它唯一地标识一个接口(interface)}

var

FileList:TStringList;

Buffer:array[1..1024]of char;

implementation

uses ComServ, SysUtils, ShellApi, Registry,UnitForm;

function TContextMenu.SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;

hKeyProgID: HKEY): HResult;

var

StgMedium: TStgMedium;

FormatEtc: TFormatEtc;

FileNumber,i:Integer;

begin

file://如果lpdobj等于Nil,则本调用失败

if (lpdobj = nil) then begin

Result := E_INVALIDARG;

Exit;

end;

file://首先初始化并清空FileList以添加文件

FileList:=TStringList.Create;

FileList.Clear;

file://初始化剪贴版格式文件

with FormatEtc do begin

cfFormat := CF_HDROP;

ptd := nil;

dwAspect := DVASPECT_CONTENT;

lindex := -1;

tymed := TYMED_HGLOBAL;

end;

Result := lpdobj.GetData(FormatEtc, StgMedium);

if Failed(Result) then Exit;

file://首先查询用户选中的文件的个数

FileNumber := DragQueryFile(StgMedium.hGlobal,$FFFFFFFF,nil,0);

file://循环读取,将所有用户选中的文件保存到FileList中

for i:=0 to FileNumber-1 do begin

DragQueryFile(StgMedium.hGlobal, i, FFileName, SizeOf(FFileName));

FileList.Add(FFileName);

Result := NOERROR;

end;

ReleaseStgMedium(StgMedium);

end;

function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,

idCmdLast, uFlags: UINT): HResult;

begin

Result := 0;

if ((uFlags and $0000000F) = CMF_NORMAL) or

((uFlags and CMF_EXPLORE) <> 0) then begin

// 往Context Menu中加入一个菜单项

InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst,

PChar('执行文件操作'));

// 返回增加菜单项的个数

Result := 1;

end;

end;

function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;

var

// sFile:TFileStream;

charSavePath:array[0..1023]of char;

sSaveFile:String;

i:Integer;

F: TextFile;

FirstLine: string;

begin

// 首先确定该过程是被系统而不是被一个程序所调用

if (HiWord(Integer(lpici.lpVerb)) <> 0) then

begin

Result := E_FAIL;

Exit;

end;

// 确定传递的参数的有效性

if (LoWord(lpici.lpVerb) <> 0) then begin

Result := E_INVALIDARG;

Exit;

end;

file://建立一个临时文件保存用户选中的文件名

GetTempPath(1024,charSavePath);

sSaveFile:=charSavePath+'chen0001.tmp';

AssignFile(F,sSaveFile); { next file in Files property }

ReWrite(F);

file://将文件名保存到临时文件中

for i:= 0 to FileList.Count -1 do begin

FirstLine:=FileList.Strings[i];

Writeln(F,FirstLine); { Read the first line out of the file }

end;

CloseFile(F);

file://调用文件操作程序对用户选中的文件进行操作

ShellExecute(0,nil,'c:\FileOP.exe',PChar(sSaveFile),charSavePath,SW_NORMAL);

Result := NOERROR;

end;

function TContextMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;

pszName: LPSTR; cchMax: UINT): HRESULT;

begin

if (idCmd = 0) then begin

if (uType = GCS_HELPTEXT) then

{返回该菜单项的帮助信息,此帮助信息将在用户把鼠标移动到该菜单项时出现在状态条上。}

StrCopy(pszName, PChar('点击该菜单项将执行文件操作'));

Result := NOERROR;

end

else

Result := E_INVALIDARG;

end;

type

TContextMenuFactory = class(TComObjectFactory)

public

procedure UpdateRegistry(Register: Boolean); override;

end;

procedure TContextMenuFactory.UpdateRegistry(Register: Boolean);

var

ClassID: string;

begin

if Register then begin

inherited UpdateRegistry(Register);

ClassID := GUIDToString(Class_ContextMenu);

CreateRegKey('*\shellex', '', '');

CreateRegKey('*\shellex\ContextMenuHandlers', '', '');

CreateRegKey('*\shellex\ContextMenuHandlers\OpenWithWordPad', '', ClassID);

file://如果操作系统为Windows NT的话

if (Win32Platform = VER_PLATFORM_WIN32_NT) then

with TRegistry.Create do

try

RootKey := HKEY_LOCAL_MACHINE;

OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions', True);

OpenKey('Approved', True);

WriteString(ClassID, 'Context Menu Shell Extension');

finally

Free;

end;

end

else begin

DeleteRegKey('*\shellex\ContextMenuHandlers\FileOpreation');

DeleteRegKey('*\shellex\ContextMenuHandlers');

// DeleteRegKey('*\shellex');

inherited UpdateRegistry(Register);

end;

end;

initialization

TContextMenuFactory.Create(ComServer, TContextMenu, Class_ContextMenu,

'', 'Context Menu Shell Extension', ciMultiInstance,tmApartment);

end.

将该单位文件保存为unit2.pas,文件同contextmenu.dpr位于同一个目录下。

打开Delphi,选菜单中的 file | open project 打开contextmenu.dpr文件,然后选 Project | build contextmenu菜单项编译连接程序,如果编译成功的话,会建立一个contextmenu.dll的动态连接库文件,这个文件就是服务器动态连接库。

下面来建立文件操作程序。打开VB,建立一个新的工程文件,在Form1中加入一个ListBox控件和三个CommandButton控件,将ListBox的MultiSelect属性设置为2。然后在Form1的代码窗口中加入以下代码:

Option Explicit

Private Type BrowseInfo

hwndOwner As Long

pIDLRoot As Long

pszDisplayName As Long

lpszTitle As Long

ulFlags As Long

lpfnCallback As Long

lParam As Long

iImage As Long

End Type

Private Type SHFILEOPSTRUCT

hwnd As Long

wFunc As Long '对文件的操作指令

pFrom As String '源文件或路径

pTo As String '目的文件或路径

fFlags As Integer '操作标志

fAnyOperationsAborted As Long

hNameMappings As Long

lpszProgressTitle As String

End Type

Const FO_COPY = &H2

Const FO_DELETE = &H3

Const FO_MOVE = &H1

Const FO_RENAME = &H4

Const FOF_ALLOWUNDO = &H40

Const BIF_RETURNONLYFSDIRS = 1

Const MAX_PATH = 260

Private Declare Function ShellAbout Lib "shell32.dll" Alias _

"ShellAboutA" (ByVal hwnd As Long, ByVal szApp As _

String, ByVal szOtherStuff As String, ByVal hIcon As Long) _

As Long

Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)

Private Declare Function lstrcat Lib "kernel32" Alias _

"lstrcatA" (ByVal lpString1 As String, ByVal lpString2 _

As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi _

As BrowseInfo) As Long

Private Declare Function SHGetPathFromIDList Lib "shell32" _

(ByVal pidList As Long, ByVal lpBuffer As String) As Long

Private Declare Function SHFileOperation Lib "shell32" _

(lpFileOp As SHFILEOPSTRUCT) As Long

Private Declare Function GetWindowsDirectory _

Lib "kernel32" Alias "GetWindowsDirectoryA" _

(ByVal lpBuffer As String, ByVal nSize As _

Long) As Long

Dim DirString As String

Dim sFile As String

Sub UpdateList()

'UpdateList函数检查列表框中的文件是否存在,如果不存在,就将其

'从文件列表中删除

Dim bEndList As Boolean

Dim i As Integer

bEndList = True

i = 0

While bEndList

'检查文件是否存在,如果不存在就删除

If Dir$(List1.List(i)) = "" Then

List1.RemoveItem (i)

Else '如果文件存在就转移到下一个列表项

i = i + 1

If i > List1.ListCount - 1 Then

bEndList = False

End If

End If

Wend

Command1.Enabled = False

Command2.Enabled = False

Command3.Enabled = False

End Sub

Function BrowseForFolder(hwndOwner As Long, sPrompt As String) As String

Dim iNull As Integer

Dim lpIDList As Long

Dim lResult As Long

Dim sPath As String

Dim udtBI As BrowseInfo

'初试化udtBI结构

With udtBI

.hwndOwner = hwndOwner

.lpszTitle = lstrcat(sPrompt, "")

.ulFlags = BIF_RETURNONLYFSDIRS

End With

'弹出文件夹查看窗口

lpIDList = SHBrowseForFolder(udtBI)

If lpIDList Then

sPath = String$(MAX_PATH, 0)

lResult = SHGetPathFromIDList(lpIDList, sPath)

Call CoTaskMemFree(lpIDList)

iNull = InStr(sPath, vbNullChar)

If iNull Then sPath = Left$(sPath, iNull - 1)

End If

BrowseForFolder = sPath

End Function

Private Sub Command1_Click() '执行文件拷贝操作

Dim sPath As String

Dim tCopy As SHFILEOPSTRUCT

Dim i As Integer

'选择拷贝到的文件夹

sPath = BrowseForFolder(Form1.hwnd, "选择拷贝到的文件夹")

If sPath <> "" Then

With tCopy

.hwnd = Form1.hwnd

.lpszProgressTitle = "正在拷贝"

.pTo = sPath

.fFlags = FOF_ALLOWUNDO

.wFunc = FO_COPY

End With

For i = 0 To List1.ListCount - 1

If List1.Selected(i) Then '如果文件被选中则拷贝文件

tCopy.pFrom = List1.List(i)

SHFileOperation tCopy

End If

Next i

UpdateList

End If

Kill sFile

End Sub

Private Sub Command2_Click() '执行文件移动操作

Dim sPath As String

Dim tCopy As SHFILEOPSTRUCT

Dim i As Integer

'选择移动到的文件夹

sPath = BrowseForFolder(Form1.hwnd, "选择转移到的文件夹")

If sPath <> "" Then

With tCopy

.hwnd = Form1.hwnd

.lpszProgressTitle = "正在移动"

.pTo = sPath

.fFlags = FOF_ALLOWUNDO

.wFunc = FO_MOVE

End With

For i = 0 To List1.ListCount - 1

If List1.Selected(i) Then '如果文件被选中则拷贝文件

tCopy.pFrom = List1.List(i)

SHFileOperation tCopy

End If

Next i

UpdateList

End If

Kill sFile

End Sub

Private Sub Command3_Click() '执行文件删除操作

Dim sPath As String

Dim tCopy As SHFILEOPSTRUCT

Dim i As Integer

With tCopy

.hwnd = Form1.hwnd

.lpszProgressTitle = "正在删除"

.pTo = sPath

.fFlags = FOF_ALLOWUNDO

.wFunc = FO_DELETE

End With

For i = 0 To List1.ListCount - 1

If List1.Selected(i) Then

tCopy.pFrom = List1.List(i)

SHFileOperation tCopy

End If

Next i

UpdateList

Kill sFile

End Sub

Private Sub Form_Load()

Dim hFileHandle As Long

Dim TextLine As String

Command1.Caption = "拷贝"

Command2.Caption = "移动"

Command3.Caption = "删除"

Command1.Enabled = False

Command2.Enabled = False

Command3.Enabled = False

'sFile接受由Windows外壳扩展库contextmenu.dll传递过来的文件参数

sFile = Command$

hFileHandle = FreeFile

Open sFile For Input As hFileHandle

Do While Not EOF(hFileHandle)

Line Input #1, TextLine

If Dir$(TextLine) <> "" Then

List1.AddItem TextLine

End If

Loop

Close hFileHandle

End Sub

Private Sub Form_Unload(Cancel As Integer)

If Dir$(sFile) <> "" Then

Kill sFile

End If

End Sub

Private Sub List1_Click()

If Not Command1.Enabled Then

Command1.Enabled = True

Command2.Enabled = True

Command3.Enabled = True

End If

End Sub

保存文件并将工程文件编译为FileOP.exe文件,将文件拷贝到C盘根目录下。然后注册contextmenu.dll,注册的方法是,在DOS窗口中进入Windows\system子目录,输入 Regsvr32 x:\xxxxx\contextmenu.dll 。其中x:\xxxxx\为Contextmenu.dll文件所在的驱动器和目录。如果注册成功,系统会弹出对话框,显示 DllRegisterServer in ..\xxx\contextmenu.dll Success 提示注册成功。

注册成功后,再选择文件并单击右键,就会发现在弹出菜单中多了一个“执行文件操作”的菜单项,点击该项,系统就会调用FileOP.exe执行文件操作,在窗口的列表框中会出现用户选择的文件名,点击相应的文件并点击“拷贝”、“移动”或“删除”按钮就可以对列表框中的选中的文件进行相应的操作。

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有