Problem dość nietypowy, mam stworzoną bibliotekę DLL która realizuje w mojej aplikacji menu kontekstowe dla każdego pliku. Od razu zaznaczę iż nie jest to zrobione na zasadzie dopisania się do obsługi typu pliku w rejestrze pod *, tylko tak jak robi to większość porządnych aplikacji - dll + [HKEY_CLASSES_ROOT*\shellex\ContextMenuHandlers]. Kod który to realizuje udało mi się znaleźć dopiero na jakiejś niemieckiej stronie. Przystosowałem go oczywiście do swojego przypadku (nie ma to jak edycja kodu z niemieckimi komentarzami).
Używałem tego przez spory kawałek czasu, jednak problem pojawił się niedawno, właściwie to został odkryty. Nie wiedzieć czemu menu kontekstowe pliku nie dodaje się na systemach 64-bitowych (Vista, 7 RC). Rejestrowanie biblioteki realizowane jest przez instalator InnoSetup. Doszedłem już do wniosku iż sam fakt iż aplikacji jest 32-bitowa nie jest problemem, gdyż wiele aplikacji stricte 32-bitowych mających również menu kontekstowe pliku działa bez problemu (np: Spik, KIS, Unlocker). Sama główna aplikacja działa bez problemu, jedynie menu kontekstowe się nie dodaje, tak jakby w ogóle nie była wywoływana komenda regsvr32 (zarówno gdy robi to instalator jak i gdy ręcznie próbuję zarejestrować DLL’a).
Poniżej załączam kod biblioteki DLL:
unit ShellExtMenu;
interface
// -----------------------------------------------------------------------------
uses
Windows, SysUtils, Classes, ComServ, ShellAPI, Registry, ActiveX, ComObj,
ShlObj, Graphics, Dialogs,
CTZPTypes;
// -----------------------------------------------------------------------------
type
TShellExtMenu = class(TComObject, IShellExtInit, IContextMenu)
protected
// Metody
function IShellExtInit.Initialize = SEInitialize;
function SEInitialize(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;
TShellExtFactory = class(TComObjectFactory)
public
// Metody
procedure UpdateRegistry(Register: Boolean); override;
end;
implementation
// -----------------------------------------------------------------------------
var
ShellExtFactory: TShellExtFactory;
S: String;
GUID: TGUID;
InstallLocation: String;
Icon: TBitmap;
FileName: String;
// -----------------------------------------------------------------------------
function TShellExtMenu.SEInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject; hKeyProgID: HKEY): HResult;
var
StgMedium: TStgMedium;
FormatEtc: TFormatEtc;
fn: array[0..MAX_PATH] of Char;
begin
if (lpdobj = nil) then
begin
Result := E_INVALIDARG;
Exit;
end;
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;
if DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0) = 1 then
begin
DragQueryFile(StgMedium.hGlobal, 0, fn, SizeOf(fn));
FileName := fn;
end
else
FileName := '';
ReleaseStgMedium(StgMedium);
Result := NOERROR;
end;
// -----------------------------------------------------------------------------
function TShellExtMenu.QueryContextMenu(Menu: HMENU; indexMenu,
idCmdFirst, idCmdLast, uflags: UINT): HResult;
var
info: TMenuItemInfo;
begin
if (FileName <> '') and
(
((uFlags and $0000000F) = CMF_NORMAL) or
((uFlags and CMF_EXPLORE) <> 0) or
((uFlags and CMF_VERBSONLY) <> 0)
) then
begin
info.cbSize := SizeOf(TMenuItemInfo);
info.fMask := MIIM_STRING or MIIM_ID;
info.wID := idCmdFirst;
info.dwTypeData := PAnsiChar(SHELLEXT_CAPTION);
InsertMenuItem(Menu, indexMenu, True, info);
if Icon.Handle <> 0 then
SetMenuItemBitmaps(Menu, indexMenu, MF_BYPOSITION, Icon.Handle, Icon.Handle);
Result := 4
end
else
Result := 0;
end;
// -----------------------------------------------------------------------------
function TShellExtMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
begin
if HiWord(Integer(lpici.lpVerb)) = 0 then
begin
if LoWord(lpici.lpVerb) = 0 then // Numer komendy
begin
// Uruchomienie aplikacji
ShellExecute(
0,
'',
PAnsiChar(InstallLocation + MAIN_EXE_FILENAME),
PAnsiChar('"' + FileName + '"'),
PAnsiChar(InstallLocation),
SW_SHOWDEFAULT
);
Result := NOERROR;
end
else
Result := E_INVALIDARG;
end
else
Result := E_FAIL;
end;
// -----------------------------------------------------------------------------
function TShellExtMenu.GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
pszName: LPSTR; cchMax: UINT): HResult;
begin
//Result := S_OK;
try
if idCmd = 0 then
begin
if uType = GCS_HELPTEXT then
StrCopy(pszName, SHELLEXT_CAPTION);
Result := NOERROR;
end
else
Result := E_INVALIDARG;
except
Result := E_UNEXPECTED;
end;
end;
// -----------------------------------------------------------------------------
procedure TShellExtFactory.UpdateRegistry(Register: Boolean);
var
classid: string;
begin
if Register then
begin
inherited UpdateRegistry(Register);
classid := GUIDToString(GUID);
CreateRegKey('*\shellex', '', '');
CreateRegKey('*\shellex\ContextMenuHandlers', '', '');
CreateRegKey('*\shellex\ContextMenuHandlers\' + SHELLEXT_NAME, '', classid);
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, SHELLEXT_NAME);
finally
Free;
end;
end
else
begin
DeleteRegKey('*\shellex\ContextMenuHandlers\' + SHELLEXT_NAME);
DeleteRegKey('*\shellex\ContextMenuHandlers');
DeleteRegKey('*\shellex');
inherited UpdateRegistry(Register);
end;
end;
// -----------------------------------------------------------------------------
initialization
// GUID
S := GetRegStringValue('*\shellex\ContextMenuHandlers\' + SHELLEXT_NAME, '');
if S = '' then
CoCreateGUID(GUID)
else
GUID := StringToGUID(S);
// Sciezka aplikacji
InstallLocation := ParsePath(GetRegStringValue('Software\' + REG_NAME, 'InstallLocation', HKEY_CURRENT_USER));
// ???
ShellExtFactory := TShellExtFactory.Create(
ComServer, TShellExtMenu, GUID,
'', SHELLEXT_NAME,
ciMultiInstance, tmApartment
);
// Ikona
Icon := TBitmap.Create;
Icon.LoadFromResourceName(hInstance, 'ICON');
// -----------------------------------------------------------------------------
finalization
// Zwalnianie ikony
Icon.Free;
// Zwalnianie ???
ShellExtFactory.Free;
end.
? Czytałem już wiele razy że ma w końcu wyjść ale czy udało im się go wydać już?