KOL and ContextMenu shel extension

← →
Boguslaw (2005-01-05 00:10) [0]

Is there any example how to write ContextMenuHandler shell extension in KOL ?

← →
thaddy (2005-01-05 11:02) [1]

You can use kolactiveX/kolactivedll example as a basis.

← →
Boguslaw (2005-01-06 17:41) [2]

OK. Below is ContextMenuHandler simple shell extension.
Could somebody help me port this to KOL ? Should be no problem, only Registry,SySUtils and ComServ units used besides common.

Is ComServ unit ported to KOL ?

P.S. Sorry,I hate COM but must use it.
Anyway I"m writing simple antivirus with KOL GUI.
Are You interested in this project (GPL license) ?

*******************************
unit shellunt;

interface

uses
Windows, ActiveX, ComObj, ShlObj;

type
TContextMenu = class(TComObject, IShellExtInit, IContextMenu)
private
FFileName: array[0..MAX_PATH] of Char;
FFileNameList: String;
protected
{ IShellExtInit }
function IShellExtInit.Initialize = SEIInitialize; // Avoid compiler warning
function SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
hKeyProgID: HKEY): HResult; stdcall;
{ IContextMenu }
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 = "{E15E69D0-E84D-4A69-9E3C-51839D60C9C2}";

implementation

uses ComServ, SysUtils, ShellApi, Registry;

function TContextMenu.SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
hKeyProgID: HKEY): HResult;
var
StgMedium: TStgMedium;
FormatEtc: TFormatEtc;
Count, Loop: Byte;
begin
// Fail the call if lpdobj is Nil.
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;

// Render the data referenced by the IDataObject pointer to an HGLOBAL
// storage medium in CF_HDROP format.
Result := lpdobj.GetData(FormatEtc, StgMedium);
if Failed(Result) then
begin
Exit;
end;
// File(s) is selected, retrieve the file name and store it in FFileName.
// FFileNameList Soters the List of files.
if (DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0) > 0) then begin
Count := DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0);
for Loop := 0 to Count - 1 do begin
DragQueryFile(StgMedium.hGlobal, Loop, FFileName, SizeOf(FFileName));
FFileNameList := FFileNameList + FFileName+ "*";
end;
// if (DragQueryFile(StgMedium.hGlobal, $FFFFFFFF, nil, 0) = 1) then begin
// DragQueryFile(StgMedium.hGlobal, 0, FFileName, SizeOf(FFileName));
Result := NOERROR;
end
else begin
FFileName[0] := #0;
Result := E_FAIL;
end;
ReleaseStgMedium(StgMedium);
end;

function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,
idCmdLast, uFlags: UINT): HResult;
begin
Result := 0; // or use MakeResult(SEVERITY_SUCCESS, FACILITY_NULL, 0);

if ((uFlags and $0000000F) = CMF_NORMAL) or
((uFlags and CMF_EXPLORE) <> 0) then begin
// Add one menu item to context menu
InsertMenu(Menu, indexMenu, MF_STRING or MF_BYPOSITION, idCmdFirst,"&Skanuj za pomocą programu ThunderClam AV");
// Return number of menu items added
Result := 1; // or use MakeResult(SEVERITY_SUCCESS, FACILITY_NULL, 1)
end;
end;

function GetProgramPath: string;
// Returns string containing path to ThunderClam
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
try
with Reg do begin
RootKey := HKEY_LOCAL_MACHINE;
OpenKey("\SOFTWARE\ThunderClam\Configuration", False);
Result := ReadString("App");
end;
if AnsiPos(" ", Result) <> 0 then
// Result := ExtractShortPathName(Result);
Result := Result + " "%s"";
finally
Reg.Free;
end;
end;

function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
var
H: THandle;
begin
Result := E_FAIL;
// Make sure we are not being called by an application
if (HiWord(Integer(lpici.lpVerb)) <> 0) then
begin
Exit;
end;
// Make sure we aren"t being passed an invalid argument number
if (LoWord(lpici.lpVerb) <> 0) then begin
Result := E_INVALIDARG;
Exit;
end;

// Execute the command specified by lpici.lpVerb
H := WinExec(PChar(Format(GetProgramPath, [FFileNameList])), lpici.nShow);
if (H < 32) then
MessageBox(lpici.hWnd, "Nie można uruchomić ThunderClam AV.", "Błąd",
MB_ICONERROR or MB_OK);
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
// return help string for menu item
StrCopy(pszName, "Skanowanie antywirusowe używając programu ThunderClam AV");
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\ContMenu", "", ClassID);
CreateRegKey("Folder\shellex", "", "");
CreateRegKey("Folder\shellex\ContextMenuHandlers", "", "");
CreateRegKey("Folder\shellex\ContextMenuHandlers\ContMenu", "", 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, "ThunderClam Context Menu Shell Extension");
finally
Free;
end;
end
else begin
DeleteRegKey("*\shellex\ContextMenuHandlers\ContMenu");
DeleteRegKey("*\shellex\ContextMenuHandlers");
DeleteRegKey("*\shellex");
DeleteRegKey("Folder\shellex\ContextMenuHandlers\ContMenu");
DeleteRegKey("Folder\shellex\ContextMenuHandlers");
DeleteRegKey("Folder\shellex");

inherited UpdateRegistry(Register);
end;
end;

initialization
TContextMenuFactory.Create(ComServer, TContextMenu, Class_ContextMenu,
"", "ThunderClam Context Menu Shell Extension", ciMultiInstance,
tmApartment);
end.

KOL and ContextMenu shel extension Найти похожие ветки