Mega Code Archive
Add menu item to explorer context menu
<![CDATA[
Add a menu item to windows explorer and desktop popup menus
ShellSPY V1.1a
is the award winning and powerful monitoring solution that you need! ShellSPY
gives you the power to log all keystrokes, windows viewed, applications ran, internet
connections made, passwords entered, chat conversations that were made, Monitor
all running tasks on your pc Download
Now
Web Site:
Cjpsoftware.com
// Open Delphi select dynamic link library
// Copy / paste this into the DLL
// Then compile
// You will have to customize this code. To suite your needs.
// once the dll has been compiled you will now have to register this
// com server.
// Use regsvr32.exe sendtoweb.dll
// now open windows explorer and you will see a new menu item
// which can be accessed by the desktop also..
unit Sendtoweb;
// Author C Pringle Cjpsoftware.com
{ Implementation of the context menu shell extension COM object. This
COM object is responsible for forwarding requests to its partner
TPopupMenu component. The TPopupMenu component must reside on the
MenuComponentForm, and is referred to explicitly in this example.
You can modify this code to make it more flexible and generic in
the future.
The TContextMenu component registers itself as a global context menu
handler. This is accomplished by adding a key to the
HKEY_CLASSES_ROOT\*\ShellEx\ContextMenuHandlers key in the registry.
jfl
}
interface
uses
Classes, ComServ, ComObj, ActiveX, Windows, ShlObj, Interfaces, Menus,
ShellAPI, SysUtils,registry;
type
TContextMenuFactory = class( TComObjectFactory )
public
procedure UpdateRegistry( Register: Boolean ); override;
end;
TContextMenu = class( TComObject, IShellExtInit, IContextMenu )
private
FFileName: String;
function BuildSubMenu( Menu: HMENU; IndexMenu: Integer;
var IDCmdFirst: Integer ): HMENU;
protected
szFile: array[0..MAX_PATH] of Char;
// Required to disambiguate TComObject.Initialize otherwise a compiler
// warning will result.
function IShellExtInit.Initialize = IShellExtInit_Initialize;
public
{ IShellExtInit members }
function IShellExtInit_Initialize(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;
var
// Must be set prior to instantiation of TContextMenu!
GFileExtensions: TStringList;
const
MenuCommandStrings: array[ 0..3 ] of String = (
'','&STW Web Upload','&STW FTPClient','&STW Setup'
);
implementation
{ TContextMenuFactory }
{ Public }
Function ReadDefaultPAth: String;
var
path : String;
Reg : TRegistry;
begin
Reg := TRegistry.CReate;
try
With Reg Do
Begin
RootKey := HKEY_LOCAL_MACHINE;
Path := 'SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths';
If KeyExists(Path) Then
Begin
OpenKey(Path+'\sendtoweb.exe',false);
Result := ReadString(#0);
closekey;
End;
// Key Added to shell ext.
End;
Finally
Reg.CloseKey;
Reg.Free;
End;
End;// Custom registration code
procedure TContextMenuFactory.UpdateRegistry( Register: Boolean );
begin
inherited UpdateRegistry( Register );
// Register our global context menu handler
if Register then
begin
CreateRegKey( '*\ShellEx\ContextMenuHandlers\SendToWeb', '',
GUIDToString( Class_ContextMenu ) );
CreateRegKey( 'CLSID\' + GUIDToString( ClassID ) + '\' +
ComServer.ServerKey, 'ThreadingModel', 'Apartment' );
end else
begin
DeleteRegKey( '*\ShellEx\ContextMenuHandlers\SendToWeb' );
end;
end;
{ TContextMenu }
{ Private }
{ Build a context menu using the existing Menu handle. If Menu is nil,
we create a new menu handle and return it in the function's return
value. Note that this function does not handle nested (recursive)
menus. This exercise is left to the reader. }
function TContextMenu.BuildSubMenu( Menu: HMENU; IndexMenu: Integer;
var IDCmdFirst: Integer ): HMENU;
var
i: Integer;
menuItemInfo: TMenuItemInfo;
begin
if Menu = 0 then
Result := CreateMenu
else
Result := Menu;
// Build the menu items here
with menuitemInfo do
begin
cbSize := SizeOf( TMenuItemInfo );
fMask := MIIM_CHECKMARKS or MIIM_DATA or MIIM_ID or
MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE or MIIM_CHECKMARKS ;
fType := MFT_STRING;
fState := MFS_ENABLED ;
hSubMenu := 0;
hbmpChecked := 0;
hbmpUnchecked := 0;
end;
for i := 0 to High( MenuCommandStrings ) do
begin
if i = 0 then
menuitemInfo.fType := MFT_SEPARATOR
else
menuiteminfo.ftype := MFT_String;
if i = 1 then
menuitemInfo.fstate := MFS_ENABLED OR MFS_DEFAULT
Else
menuitemInfo.fstate := MFS_ENABLED;
menuitemInfo.dwTypeData := PChar(MenuCommandStrings[ i ]);
menuitemInfo.wID := IDCmdFirst;
InsertMenuItem( Result, IndexMenu + i, True, menuItemInfo );
Inc( IDCmdFirst );
end;
end;
{ IShellExtInit }
function TContextMenu.IShellExtInit_Initialize( pidlFolder: PItemIDList;
lpdobj: IDataObject; hKeyProgID: HKEY ): HResult;
var
medium: TStgMedium;
fe: TFormatEtc;
begin
with fe do
begin
cfFormat := CF_HDROP;
ptd := Nil;
dwAspect := DVASPECT_CONTENT;
lindex := -1;
tymed := TYMED_HGLOBAL;
end;
// Fail the call if lpdobj is Nil.
if lpdobj = Nil then
begin
Result := E_FAIL;
Exit;
end;
// Render the data referenced by the IDataObject pointer to an HGLOBAL
// storage medium in CF_HDROP format.
Result := lpdobj.GetData(fe, medium);
if Failed(Result) then Exit;
// If only one file is selected, retrieve the file name and store it in
// szFile. Otherwise fail the call.
if DragQueryFile(medium.hGlobal, $FFFFFFFF, Nil, 0) = 1 then
begin
DragQueryFile(medium.hGlobal, 0, szFile, SizeOf(szFile));
Result := NOERROR;
end
else
Result := E_FAIL;
ReleaseStgMedium(medium);
end;
{ IContextMenu }
function TContextMenu.QueryContextMenu( Menu: HMENU;
indexMenu, idCmdFirst, idCmdLast, uFlags: UINT ): HResult;
var
extension: String;
I: Integer;
idLastCommand: Integer;
begin
Result := E_FAIL;
idLastCommand := idCmdFirst;
// Extract the filename extension from the file dropped, and see if we
// have a handler registered for it
// extension := UpperCase( ( FFileName ) );
//for i := 0 to GFileExtensions.Count - 1 do
// if Pos(Lowercase(GFileExtensions[ i ]),lowercase(extension))=0 then
// begin
BuildSubMenu( Menu, indexMenu, idLastCommand );
// Return value is number of items added to context menu
Result := idLastCommand - idCmdFirst;
// Exit;
// end;
end;
function TContextMenu.InvokeCommand( var lpici:
TCMInvokeCommandInfo ): HResult;
var
idCmd: UINT;
begin
if HIWORD( Integer(lpici.lpVerb) ) <> 0 then
Result := E_FAIL
else
begin
idCmd := LOWORD( lpici.lpVerb );
Result := S_OK;
// Activate the Dialog And prepare to send data to the
// web
case idCmd of
1: Begin
ShellExecute( GetDesktopWindow, nil,Pchar(ExtractFileName(ReadDefaultPath)),
Pchar('Direct'+'"'+szfile+'"'), nil, SW_SHOW );
End;
3:Begin
ShellExecute( GetDesktopWindow, nil,Pchar(ExtractFileName(ReadDefaultPath)),
Pchar('Path'), nil, SW_SHOW );
End;
2:
ShellExecute( GetDesktopWindow, nil, Pchar(ExtractFileName(ReadDefaultPath)),
PChar(''), nil, SW_SHOW );
else
Result := E_FAIL;
end;
end;
end;
function TContextMenu.GetCommandString( idCmd, uType: UINT;
pwReserved: PUINT; pszName: LPSTR; cchMax: UINT ): HResult;
begin
// StrCopy( pszName, 'Send To The Web') ;
Result := S_OK;
end;
initialization
{ Note that we create an instance of TContextMenuFactory here rather
than TComObjectFactory. This is necessary so that we can add some
custom registry entries by overriding the UpdateRegistry virtual
function. }
TContextMenuFactory.Create( ComServer, TContextMenu, Class_ContextMenu,
'ContextMenu', 'Send To The Web', ciMultiInstance );
// Initialize the file extension list
GFileExtensions := TStringList.Create;
// GFileExtensions.Add( 'setup msn' );
finalization
GFileExtensions.Free;
end.
]]>