• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 198
  • Last Modified:

adding an item to the shell context menu

i don't know if that's the correct title, but i'll try to explain.

i'm trying to add an item to the menu that appears when you right click on a file. sort like winzip with the "add to zip"
now, i know where to add my entry on the registry, etc. the only problem is that it always appears at the top of the menu overwriting the default option.

how to do you add an item to that menu?

thanks
0
urif
Asked:
urif
1 Solution
 
pcsentinelCommented:
This dll saves a list of  all files from a selection made in in explorer, now you need to note that this is not tied to a specific file type, but does allow for multiple file selection

--------------------------Project Code------------------------------
library SFList;

uses
  ComServ,
  ContextM in 'ContextM.pas';

exports
  DllGetClassObject,
  DllCanUnloadNow,
  DllRegisterServer,
  DllUnregisterServer;

begin
end.


-----------------Unit Code-------------------
unit ContextM;

interface

uses
  Windows, ActiveX, ComObj, ShlObj, Dialogs, Classes;

type
  TContextMenu = class(TComObject, IShellExtInit, IContextMenu)
      private
        FFileList: TStringList;
  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;
      public
        destructor Destroy; override;
  end;

const
  Class_ContextMenu: TGUID = '{5EAD7640-20E7-43D7-989C-0181FE56228C}';

implementation

uses ComServ, SysUtils, ShellApi, Registry;


destructor TContextMenu.Destroy;
begin
  try
    FFileList.Free;
  except
  end;
  inherited Destroy;
end;

function TContextMenu.SEIInitialize(pidlFolder: PItemIDList; lpdobj: IDataObject;
  hKeyProgID: HKEY): HResult;
var
  lStgMedium: TStgMedium;
  lFormatEtc: TFormatEtc;
  lszFile: array[0..MAX_PATH + 1] of Char;
  lFileCount: Integer;
  lFileCounter: Integer;
begin
  try
    if (lpdobj <> nil) then
    begin
      with lFormatEtc do begin
        cfFormat := CF_HDROP;
        ptd := nil;
        dwAspect := DVASPECT_CONTENT;
        lindex := -1;
        tymed := TYMED_HGLOBAL;
      end;
      Result := lpdobj.GetData(lFormatEtc, lStgMedium);
      if (not Failed(Result)) then
      begin
             FFileList := TStringList.Create;
        FFileList.Clear;
        FFileList.Sorted := false;
        lFileCount := DragQueryFile(lstgmedium.hGlobal, $FFFFFFFF, nil, 0);
        for lFileCounter := 0 to pred(lFileCount) do
        begin
          DragQueryFile(lstgmedium.hGlobal, lFileCounter, lszFile,SizeOf(lszFile));
          FFileList.Add(StrPas(lszFile));
        end;
        Result := NOERROR;
        ReleaseStgMedium(lStgMedium);
      end;
    end
    else
     Result:=E_INVALIDARG;
  except
    Result := E_FAIL;
  end;
end;

function TContextMenu.QueryContextMenu(Menu: HMENU; indexMenu, idCmdFirst,
          idCmdLast, uFlags: UINT): HResult;
begin
  Result := 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,
      'Save File List');

    // Return number of menu items added
    Result := 1;
  end;
end;

function TContextMenu.InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult;
  function PadR(Value: string; Len: byte): string;
  //right pads a string with spaces
  begin
    try
      Result:=value+StringOfChar(' ',Len-Length(Value));
    except
    end;
  end;

  function PadL(Value: string; Len: byte): string;
  //left pads a strring with spaces
  begin
    try
    Result:=StringOfChar(' ',Len-Length(Value))+Value;
    except
    end;
  end;
type
      lFileRec = record
  Name: string;
  Path: string;
  Size: string;
  Attr: string;
  Created: TDateTime;
      Modified: TDateTime;
  LastAcc: TDateTime;
  end;

var
  lTxFile: TextFile;
  li: integer;
  lLine: string;
  lSRec: TSearchRec;
  lFiles: Array of lFileRec;
  lMaxName: integer;
  lMaxPath: integer;
  lMaxSize: integer;
  lTempTime: TSystemTime;
  lSaveDialog: TSaveDialog;
      lReg:      TRegistry;
  lLastName: string;
begin
      try
    lSaveDialog:=TSaveDialog.Create(nil);
    lLastName:='';
    lReg:=tRegistry.Create;
            try
      lReg.RootKey := HKEY_CURRENT_USER;
      if lReg.OpenKeyReadOnly('\Software\MSU\SaveFileList') then
      begin
        if lReg.ValueExists('LastFile') then
          lLastName:=lReg.ReadString('LastFile');
        lSaveDialog.FileName:=ExtractFileName(lLastName);
        lSaveDialog.InitialDir:=ExtractFilePath(lLastName);
      end;
    finally
      lReg.CloseKey;
      lReg.Free;
    end;
    lSaveDialog.DefaultExt:='txt';
    lSaveDialog.Filter:='Text files (*.txt)|*.txt';
    lSaveDialog.Title:='Save File List';
    if lSaveDialog.Execute then
    begin
      SetLength(lFiles,FFileList.Count);
      lMaxName:=0;
      lMaxPath:=0;
      lMaxSize:=0;
      for li:=0 to FFileList.Count-1 do
      begin
        FindFirst(FFileList[li],faAnyFile,lSRec);
        lFiles[li].Name:=ExtractFileName(FFileList[li]);
        lFiles[li].Path:=ExtractFilePath(FFileList[li]);
        lFiles[li].Size:=IntToStr(lSRec.Size);
        lFiles[li].Attr:='';
        if lSRec.Attr and faReadOnly >0 then
          lFiles[li].Attr:=lFiles[li].Attr+'R'
        else
          lFiles[li].Attr:=lFiles[li].Attr+' ';
        if lSRec.Attr and faHidden >0 then
          lFiles[li].Attr:=lFiles[li].Attr+'H'
        else
          lFiles[li].Attr:=lFiles[li].Attr+' ';
        if lSRec.Attr and faSysFile >0 then
          lFiles[li].Attr:=lFiles[li].Attr+'S'
        else
          lFiles[li].Attr:=lFiles[li].Attr+' ';
        if lSRec.Attr and faVolumeID >0 then
          lFiles[li].Attr:=lFiles[li].Attr+'V'
        else
          lFiles[li].Attr:=lFiles[li].Attr+' ';
        if lSRec.Attr and faDirectory      >0 then
          lFiles[li].Attr:=lFiles[li].Attr+'D'
        else
          lFiles[li].Attr:=lFiles[li].Attr+' ';
        if lSRec.Attr and faArchive            >0 then
          lFiles[li].Attr:=lFiles[li].Attr+'A'
        else
          lFiles[li].Attr:=lFiles[li].Attr+' ';
        FileTimeToSystemTime(lSRec.FindData.ftCreationTime,lTempTime);
        lFiles[li].Created:=SystemTimeToDateTime(lTempTime);
        FileTimeToSystemTime(lSRec.FindData.ftLastWriteTime,lTempTime);
        lFiles[li].Modified:=SystemTimeToDateTime(lTempTime);
        FileTimeToSystemTime(lSRec.FindData.ftLastAccessTime,lTempTime);
        lFiles[li].LastAcc:=SystemTimeToDateTime(lTempTime);
        if Length(lFiles[li].Name)>lMaxName then
          lMaxName:=Length(lFiles[li].Name);
        if Length(lFiles[li].Path)>lMaxPath then
          lMaxPath:=Length(lFiles[li].Path);
        if Length(lFiles[li].Size)>lMaxSize then
          lMaxSize:=Length(lFiles[li].Size);
      end;
      if Length('FileName')>lMaxName then
            lMaxName:=Length('FileName');
      if Length('FilePath')>lMaxPath then
            lMaxPath:=Length('FilePath');
      if Length('Size')>lMaxSize then
            lMaxSize:=Length('Size');
      AssignFile(lTxFile,lSaveDialog.FileName);
      ReWrite(lTxFile);
      lLine:=PadR('FileName',lMaxName+3);
      lLine:=lLine+PadR('FilePath',lMaxPath+3);
      lLine:=lLine+PadR('Size',lMaxSize+3);
      lLine:=lLine+PadR('Attr',9);
      lLine:=lLine+PadR('Created',Length(DateTimeToStr(Now()))+1);
      lLine:=lLine+PadR('Modified',Length(DateTimeToStr(Now()))+1);
      lLine:=lLine+PadR('Accessed',Length(DateTimeToStr(Now()))+1);
      WriteLn(lTxFile,lLine);
      for li:=0 to high(lFiles) do
      begin
        lLine:=PadR(lFiles[li].Name,lMaxName+3);
        lLine:=lLine+PadR(lFiles[li].Path,lMaxPath+3);
        lLine:=lLine+PadL(lFiles[li].Size,lMaxSize);
        lLine:=lLine+'   ';
        lLine:=lLine+PadR(lFiles[li].Attr,9);
        lLine:=lLine+PadR(DateTimeToStr(lFiles[li].Created),Length(DateTimeToStr(Now()))+1);
        lLine:=lLine+PadR(DateTimeToStr(lFiles[li].Modified),Length(DateTimeToStr(Now()))+1);
        lLine:=lLine+PadR(DateTimeToStr(lFiles[li].LastAcc),Length(DateTimeToStr(Now()))+1);
        WriteLn(lTxFile,lLine);
      end;
      CloseFile(lTxFile);
      lReg:=tRegistry.Create;
      try
        lReg.RootKey := HKEY_CURRENT_USER;
        if lReg.OpenKey('\Software\MSU\SaveFileList',true) then
          lReg.WriteString('LastFile',lSaveDialog.FileName);
      finally
        lReg.CloseKey;
        lReg.Free;
      end;
      FreeandNil(lSaveDialog);
    end;
      except
  end;
      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, 'Save File List');
    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\ContextMenuHandlers\Save File List','', ClassID);
  CreateRegKey('Directory\shellex\ContextMenuHandlers\Save File List','', ClassID);
  CreateRegKey('Drive\shellex\ContextMenuHandlers\Save File List','', ClassID);
  CreateRegKey('Folder\shellex\ContextMenuHandlers\Save File List','', 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, 'Save File List');
      finally
        Free;
      end;
  if (Win32Platform = VER_PLATFORM_WIN32_NT) then
    with TRegistry.Create do
      try
      finally
        Free;
      end;
  end
  else begin
    DeleteRegKey('*\shellex\ContextMenuHandlers\Save File List');
    DeleteRegKey('Directory\shellex\ContextMenuHandlers\Save File List');
    DeleteRegKey('Drive\shellex\ContextMenuHandlers\Save File List');
    DeleteRegKey('Folder\shellex\ContextMenuHandlers\Save File List');

    inherited UpdateRegistry(Register);
  end;
end;

initialization
  TContextMenuFactory.Create(ComServer, TContextMenu, Class_ContextMenu,
    '', 'Save File List', ciMultiInstance,
    tmApartment);
end.
0
 
urifAuthor Commented:
great thanks!
even tho i was trying NOT to add a dll to my app, but everyone i asked pointed me to the same direction.
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now