1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
| 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: Cardinal;
ScanParam: Integer;
begin
SHGetDesktopFolder(Folder);
SHGetSpecialFolderLocation(0, CSIDL_DRIVES, PIDLbase);
OLECheck(Folder.BindToObject(PIDLbase, nil, IID_IShellFolder, Pointer(SubFolder)));
TempPath:=Path;
NextDir:='';
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, 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;
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(FileName: TFileName; X, Y: Integer; Handle: HWND);
var
aContextMenu: IContextMenu;
aPrgOut: Pointer;
aPopup: HMENU;
aCmd: Integer;
aCmdInfo: TCMInvokeCommandInfo;
PIDL: PItemIDList;
ShellFolder: IShellFolder;
begin
PIDL:=SHGetIDListFromPath(FileName, ShellFolder);
if not Assigned(PIDL) then Exit;
aPrgOut:=nil;
OLECheck(ShellFolder.GetUIObjectOf(0, 1, PIDL, IID_IContextMenu, aPrgOut, Pointer(aContextMenu)));
aPopup:=CreatePopUpMenu;
if aPopup=0 then Exit;
try
OLECheck(aContextMenu.QueryContextMenu(aPopup, 0, 1, $7FFF, CMF_NORMAL));
aCmd:=Integer(TrackPopupMenuEx(aPopup, TPM_LEFTALIGN or TPM_RETURNCMD or TPM_RIGHTBUTTON or TPM_HORIZONTAL or TPM_VERTICAL, X, Y, Handle, nil));
if aCmd<>0 then
begin
FillChar(aCmdInfo, Sizeof(aCmdInfo), 0);
with aCmdInfo do
begin
cbSize:=SizeOf(TCMInvokeCommandInfo);
lpVerb:=MakeIntResource(aCmd-1);
nShow:=SW_SHOWNORMAL;
end;
try
aContextMenu.InvokeCommand(aCmdInfo);
except
end;
end;
finally
DestroyMenu(aPopup);
end;
end; |
