?
Solved

adding an item to the shell context menu

Posted on 2005-03-29
3
Medium Priority
?
194 Views
Last Modified: 2011-09-20
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
Comment
Question by:urif
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
3 Comments
 
LVL 11

Accepted Solution

by:
pcsentinel earned 500 total points
ID: 13651963
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
 

Author Comment

by:urif
ID: 13670370
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

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
Add bar graphs to Access queries using Unicode block characters. Graphs appear on every record in the color you want. Give life to numbers. Hopes this gives you ideas on visualizing your data in new ways ~ Create a calculated field in a query: …
Sometimes it takes a new vantage point, apart from our everyday security practices, to truly see our Active Directory (AD) vulnerabilities. We get used to implementing the same techniques and checking the same areas for a breach. This pattern can re…
Suggested Courses
Course of the Month8 days, 1 hour left to enroll

765 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question