谁懂windows的shell快捷菜单？

[pingto]

windows shell快捷菜单如何编程实现

[严黎斌]

这不是几句话能说得清楚的。
要实现这种编程，必须学习的内容有：
Windows 的ActiveX或者说COM的原理和技术细节
Windows Shell的所谓7种外壳扩展
如何用Delphi来实现COM编程

祝你好运

[torble]

IContextMenu 接口

[torble]

相关技术看看这里： http://www.csdn.net/develop/read_article.asp?id=3544

[tombyron]

up

[zliang82]

去找《Windows Shell 编程指南与实例》电子工业出版社出版的；很管用的。包含了
Windows 的ActiveX或者说COM的原理和技术细节
Windows Shell的所谓7种外壳扩展
如何用Delphi来实现COM编程

[Bellamy]

SEE！

[pingto]

http://www.csdn.net/develop/read_article.asp?id=3544
上的文章并没有讲如何调用Windows的右键菜单，类拟的代码Delphi Demo中就有，我并不想扩展一个右键菜单，而是想调用系统的。

[pingto]

感谢大家的热情，现在开始放分。其实此问题只回答了一半，另一半则是Windows Shell菜单中当没有目录和文件选中时又当如何将其获取呢？
所以继续话题：如何调用Windows Shell菜单之----Windows Shell菜单中当没有目录和文件选中时又当如何将其获取？

[lixif]

关注

[TechnoFantasy]

调用系统菜单的代码：

unit unitContextMenu;

interface

uses
Windows, Messages, SysUtils, Classes,FileCtrl,shlobj,activex,comobj,Unit2;

procedure DisplayContextMenuForFile(hWnd:DWord;FileName: string);

var
s_NowURL,s_NowFile,s_NowPath:string;
bFileIsEx : boolean;
bDirIsEx:boolean;

const
SC_MenuSave = WM_USER + 1;
SC_MenuCopyURL = WM_USER + 2;
SC_MenuExportPath = WM_USER + 3;

implementation

uses
Unit1;

function SlashDirName(ADir: String): string;
var s: string;
RootDir: Boolean;
begin
if ADir <> '' then
begin
s := ADir;
RootDir := ((Length(s) = 3) and (S[2] = ':')) or (s = '\');
if not RootDir then
if s[Length(s)] <> '\' then s := s + '\';
Result := s;
end;
end;

function SHGetIDListFromPath(Path: TFileName; var ShellFolder: IShellFolder): pItemIDList;
var TempPath, NextDir: TFileName;
SlashPos: Integer;
Folder, subFolder: IShellFolder;
PIDL, PIDLbase: PItemIDList;
ParseStruct: TStrRet;
ParseNAme: string;
EList: IEnumIDList;
DidGet: integer;
ScanParam: integer;
begin
SHGetDesktopFolder(Folder);
SHGetSpecialFolderLocation(0, CSIDL_DRIVES, PIDLbase);

OLECheck(Folder.BindToObject(PIDLbase, nil, IID_IShellFolder, Pointer(SubFolder)));
TempPath := Path;
NextDir := '';

{ Enumerate the path one directory at a time }
while Length(TempPath)>0 do
begin
SlashPos := Pos('\', TempPath);
if SlashPos > 0 then
begin
if Pos(':', TempPath) > 0 then NextDir := Copy(TempPath, 1, 3)
else NextDir := SlashDirName(NextDir) + Copy(TempPath, 1, SlashPos - 1);
TempPath := Copy(TempPath, SlashPos + 1, Length(TempPath));
end else begin
if NextDir = '' then NextDir:=TempPath
else NextDir := SlashDirName(NextDir) + TempPath;
TempPath := '';
end;

Pidl := PidlBase;
ScanParam := SHCONTF_FOLDERS or SHCONTF_INCLUDEHIDDEN;
if (NextDir = Path) and (not DirectoryExists(Path)) then
ScanParam := ScanParam or SHCONTF_NONFOLDERS;

if S_OK = SubFolder.EnumObjects(0, ScanParam, EList) then
while S_OK = EList.Next(1, pidl, ULong(DidGet)) do
begin
OLECheck(SubFolder.GetDisplayNameOf(PIDL, SHGDN_FORPARSING, ParseStruct));
case ParseStruct.uType of
STRRET_CSTR: ParseName := ParseStruct.cStr;
STRRET_WSTR: ParseName := WideCharToString(ParseStruct.pOleStr);
STRRET_OFFSET: Parsename := PChar(DWORD(Pidl)+ParseStruct.uOffset);
end;
if UpperCase(Parsename) = UpperCase(NextDir) then Break;
end else begin
Folder:=nil;
Result:=nil;
Exit;
end;

if DidGet=0 then
begin
Folder := nil;
Result := nil;
Exit;
end;
PIDLBase := Pidl;
Folder := subFolder;

{ As best as we can, determine whether or not this is a file. }
{ If so then we cannot bind it to the ShellFolder (hence "folder".) }
if not FileExists(NextDir) then
OLECheck(Folder.BindToObject(Pidl, nil, IID_IShellFolder, Pointer(SubFolder)));
end;

ShellFolder := Folder;
if ShellFolder = nil then Result := nil
else Result := Pidl;
end;

procedure ContextMenuForFile(hWndMain:DWord;Folder: IShellFolder; Pidl: pItemIDList);
var aContextMenu: IContextMenu;
aPrgOut: Pointer;
aPopup: hMenu;
aCmd: Integer;
aCmdInfo: TCMInvokeCommandInfo;
MenuInfo: TMenuItemInfo;
t, ItemCount: integer;
buf: array[0..80] of Char;
Where: TPoint;
begin
GetCursorPos(Where);
OLECheck(Folder.GetUIObjectOf(hWndMain, 1, Pidl, IID_IContextMenu,
aPrgOut, Pointer(aContextMenu)));
aPopup := CreatePopUpMenu;
if aPopup = 0 then exit;

try
OLECheck(aContextMenu.QueryContextMenu(aPopup, 0, 1, $7FFF, CMF_NORMAL));
AppendMenu(aPopup, MF_SEPARATOR, 0, '');
if s_NowFile <> '' then //显示保存文件菜单
Appendmenu(aPopup,MF_STRING,SC_MenuSave,'Save');
if s_NowURL <> '' then //显示复制URL菜单
Appendmenu(aPopup,MF_STRING,SC_MenuCopyURL,'Copy URL');
if s_NowPath <> '' then //显示输出文件菜单
Appendmenu(aPopup,MF_STRING,SC_MenuExportPath,'Export Files');

aCmd := Integer(TrackPopupMenuEx(aPopup, TPM_LEFTALIGN or TPM_RETURNCMD or
TPM_RIGHTBUTTON or TPM_HORIZONTAL or TPM_VERTICAL, Where.X, Where.Y,
hWndMain, nil));
if aCmd <> 0 then
begin
if aCmd = SC_MenuSave then //用户选择保存
begin
MessageBox(0,PChar(s_NowFile),'Save',0);
end
else if aCmd = SC_MenuCopyURL then //用户选择CopyURL
begin
CopyURLToClp(s_NowURL);
// MessageBox(0,PChar(s_NowURL),'Copy URL',0);
end
else if aCmd = SC_MenuExportPath then //选择输出
begin
form1.ExportCache;
end
else
begin
Fillchar(aCmdInfo, Sizeof(aCmdInfo), 0);
with aCmdInfo do
begin
cbSize := SizeOf(TCMInvokeCommandInfo);
hwnd := hWndMain;
lpVerb := MakeIntResource(aCmd - 1);
nShow := SW_SHOWNORMAL;
end;

try
aContextMenu.InvokeCommand(aCmdInfo);
except
raise Exception.Create('The system menu for this file could not be created.');
end;
bFileIsEx := FileExists(s_NowFile); //返回文件是否存在
bDirIsEx := DirectoryExists(s_NowPath); //返回目录是否存在
end;
end;
finally
DestroyMenu(aPopup);
end;
end;

procedure DisplayContextMenuForFile(hWnd:DWord;FileName: string);
var ShellFolder: IShellFolder;
Pidl: pItemIDList;
begin
Pidl := SHGetIDListFromPath(FileName, ShellFolder);
if Assigned(Pidl) then
ContextMenuForFile(hWnd,ShellFolder, Pidl);
end;

调用只要调用 DisplayContextMenuForFile 函数就可以了参数hWnd是窗口句柄，FileName是文件或者文件夹名称。