unit UnitDummyShellForm;
{
    Purpose:
        Jesus H Christ the shell crap is overly and unnecessarily
        complication. This unit is trying to simplify this stuff and
        not doing a good job of it.
    Updates:
        Support for multiple filenames at once
}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ShlObj, ShellAPI;

type
  TFrmDummyShellForm = class(TForm)
  private
    { Private declarations }
    ICM1 : IContextMenu;
    ICM2 : IContextMenu2;
    ICM3 : ICOntextMenu3;
    procedure WMInitMenuPopup(var Msg : TWMInitMenuPopup); message WM_INITMENUPOPUP;
    procedure WMDrawItem(var msg : TWMDrawItem); message WM_DRAWITEM;
    procedure WMeasureItem(var msg : TWMMeasureItem); message WM_MEASUREITEM;
  public
    { Public declarations }
    procedure PinSelfToTaskbar;
    procedure ShowExplorerContextMenu( FileNames : array of string; p : TPoint; executePin : boolean=false);
    procedure ShowFileProperties(filename : string);
  end;

var
  FrmDummyShellForm: TFrmDummyShellForm;

{////////////////////}
{//}implementation{//}
{////////////////////}

uses Menus, ActiveX, ComObj, UnitToken;
const  IID_IContextMenu3: TGUID = (D1: $BCFCE0A0; D2: $EC17; D3: $11D0; D4: ($8D, $10, $00, $A0, $C9, $0F, $27, $19));


{$R *.dfm}


//
// To display the "send to" and "open with" dialogs,
// we have to pass these messages to the popup
//
procedure TFrmDummyShellForm.WMeasureItem(var msg : TWMMeasureItem);
var mi : TMenuItem;
begin
    if icm3 <> nil then begin
        mi := TMenuItem(msg.MeasureItemStruct.itemData);
        ICM3.HandleMenuMsg2(msg.msg, msg.IDCtl, Integer(msg.MeasureItemStruct), msg.Result );
    end;
end;
procedure TFrmDummyShellForm.WMDrawItem(var msg : TWMDrawItem);
begin
    if icm3 <> nil then begin
        ICM3.HandleMenuMsg2(msg.Msg, msg.Ctl, Integer(msg.DrawItemStruct), msg.Result );
    end;
end;
procedure TFrmDummyShellForm.WMInitMenuPopup(var Msg : TWMInitMenuPopup);
var m : cardinal;
    menu : HMENU;
    p : smallint;
    r : nativeInt;
begin
    m := msg.Msg;
    menu := msg.MenuPopup;
    p := msg.Pos;
    r := msg.Result;

    if (icm3 <> nil) and (m = WM_INITMENUPOPUP) then begin
        ICM3.HandleMenuMsg2(m, menu, p, r);
    end;
end;





procedure TFrmDummyShellForm.ShowFileProperties(filename : string);
var sei : TShellExecuteInfo;
begin
    FillChar(sei, SizeOf(sei), #0);
    sei.cbSize := SizeOf(sei);
    sei.lpFile := PChar(filename);
    sei.lpVerb := 'properties';
    sei.fMask := SEE_MASK_INVOKEIDLIST;
    ShellExecuteEx(@sei);
end;



procedure TFrmDummyShellForm.PinSelfToTaskbar;
begin
    self.ShowExplorerContextMenu([application.ExeName],point(0,0), true);
end;
//--------------------------------------------------
//  Get
//  ...an IShellFolder interface to the desktop
//  ...an IShellFolder interface to your file "object"
// GetUIObjectOf method of that shell folder, to get an IContextMenu interface.
// Use the context menu's QueryContextMenu method to populate
//a menu you've created.  Just use CreateMenu and Destroy menu
//for the short duration.
//  Use InvokeCommand on the context menu to fire off the
//command.
//--------------------------------------------------

procedure TFrmDummyShellForm.ShowExplorerContextMenu( FileNames : array of string; p : TPoint; executePin : boolean=false);
var //ICM1 : IContextMenu;
    //ICM2 : IContextMenu2;
    ICI : CMINVOKECOMMANDINFO;
    Path: string;
    Desk, Folder : IShellFolder;
    pidl: array of PItemIDList;
    Count, Attr: Cardinal;
    WFileName: WideString;
    menu : HMENU;
    i, j, k : integer;
    tokIndex : cardinal;
    b : boolean;
    caption : string;
begin
    Count := 0;
    Attr := 0;
    ICM1 := nil;
    ICM2 := nil;

    //sleep(300);


    if FAILED(SHGetDesktopFolder(Desk)) then EXIT;
    if length(filenames) = 0 then EXIT;

    SetLength(pidl, length(filenames));
    for tokIndex := low(filenames) to high(filenames) do begin
        //
        // the process is diferent for a Folder and a File
        // The idea is the same, use the "Desktop" to file the file or
        // folder object
        Path := ExtractFileDir(filenames[tokIndex]);
        if (Path = filenames[tokIndex]) then begin
            if FAILED(SHGetSpecialFolderLocation(0, CSIDL_DRIVES, pidl[tokIndex])) then EXIT;
            if FAILED(Desk.BindToObject(pidl[tokIndex], nil, IID_IShellFolder, Pointer(Folder))) then EXIT;

            WFileName := filenames[tokIndex];
            if FAILED(Folder.ParseDisplayName(0, nil, PWideChar(WFileName), Count, pidl[tokIndex], Attr)) then EXIT;

        end else begin
            WFileName := ExtractFilePath(filenames[tokIndex]);
            if FAILED(Desk.ParseDisplayName(0, nil, PWideChar(WFileName), Count, pidl[tokIndex], Attr)) then EXIT;
            if FAILED(Desk.BindToObject(pidl[tokIndex], nil, IID_IShellFolder, Pointer(Folder))) then EXIT;

            WFileName := ExtractFileName(filenames[tokIndex]);
            if FAILED(Folder.ParseDisplayName(0, nil, PWideChar(WFileName), Count, pidl[tokIndex], Attr)) then EXIT;
        end;
    end;


    //
    // get the Context menu for the object(s)
    //
    Folder.GetUIObjectOf(0, Length(pidl), pidl[0], IID_IContextMenu, nil, Pointer(ICM1));
    ICM1.QueryInterface(IID_IContextMenu3, pointer(ICM3));
    if (ICM3 = NIL) then EXIT;

    // show the popup menu and get the selected command
    menu := Windows.CreatePopupMenu;
    i := ICM3.QueryContextMenu(menu, 0, 1, $7FFF, CMF_EXPLORE);
    if ResultSeverity(i) <> SEVERITY_SUCCESS  then begin
        i := ICM3.QueryContextMenu(menu, 0, 1, $7FFF, CMF_EXPLORE);
    end;
    // peek at the commands
    if executePin then begin
        j := ResultCode(i)-1;

        repeat
            setlength(caption, MAX_PATH);
            k := ICM3.GetCommandString(j,GCS_VERBW,0,pansichar(caption),MAX_PATH-1);
            if (k=0) then begin
                caption := pchar(caption);
                if caption = 'taskbarpin' then begin
                    i := j;
                    BREAK;
                end;
            end;
            dec(j);
        until j=0;
        if j = 0 then EXIT;
    end else begin
        Windows.SetLastError(0);
        i := Integer(Windows.TrackPopupMenu(menu, TPM_RETURNCMD or TPM_LEFTALIGN or TPM_LEFTBUTTON,
            p.X , p.Y, 0, FrmDummyShellForm.Handle,nil));
    end;




    try
    // execute the selected command (if any)
        if (i <> 0) then begin
            ici.cbSize := sizeof(CMINVOKECOMMANDINFO);
            ici.fMask := 0;
            ici.hwnd := self.Handle;
            if executepin then begin
                ici.lpVerb := 'taskbarpin';
            end else begin
                ici.lpVerb := MAKEINTRESOURCEA(i - 1);
            end;
            ici.lpParameters := NIL;
            ici.lpDirectory := NIL;
            ici.nShow := SW_SHOWNORMAL;
            ici.dwHotKey := 0;
            ici.hIcon := 0;
            ICM3.InvokeCommand(ici);
        end;

        // clean up
        DestroyMenu(menu);

        icm1 := nil;
        icm2 := nil;
        icm3 := nil;
    except

    end;
    Windows.SetLastError(0);
end;




initialization
  OleInitialize(nil);

finalization
  OleUninitialize;

end.
