itemprop.pas

最好的局域网搜索软件

{ Standard defines for all Delphi Free Stuff components }

{ -----------------------------------------------------------------------------}
{ ItemProp v3.54                                                               }
{ -----------------------------------------------------------------------------}
{ Date last modified:  June 28, 2001                                           }
{ -----------------------------------------------------------------------------}

//zhuwei added, for D5.

{$DEFINE DFS_DELPHI}
{$DEFINE DFS_COMPILER_4_UP}
{$DEFINE DFS_NO_COM_CLEANUP}

unit ItemProp;

interface

// See the included ShellFix.txt file if you get a compile error on 'MyShlObj'.
uses Windows, Classes,
     {$IFDEF DFS_COMPILER_2}
     MyShlObj, OLE2;
     {$ELSE}
     ShlObj, ActiveX;
     {$ENDIF}

{$IFDEF DFS_COMPILER_2}
const 
  CMF_CANRENAME = $00000010;
{$ENDIF}

type
  DFS_HWND = {$IFDEF DFS_DELPHI} HWND {$ELSE} pointer {$ENDIF};
  

//------------------------------------------------------------------------------
// You must pass fully qualified path names to all of these functions.  No
// guarantees are made as to what will happen for relative pathnames.
// If you are calling for a subdirectory (i.e. no filename), it is your
// responsibility to insure that there is *NO* trailing backslash.
//------------------------------------------------------------------------------


//------------------------------------------------------------------------------
// DisplayContextMenu displays the right click menu for the given file or
// directory and processes the item selected, if any.  Parent is the window
// handle for the owning window of any error messages that may need to be
// displayed by the system, MyForm.Handle is generally fine.  Pos is the X, Y
// position to display the menu at given in screen (absolute) coordinates.
//------------------------------------------------------------------------------

{$IFDEF DFS_COMPILER_4_UP}
function DisplayContextMenu(const Filename: string; Parent: DFS_HWND;
   Pos: TPoint; ShowRename: boolean; var RenameSelected: boolean): boolean; overload;

function DisplayContextMenu(const Directory: string; Items: TStringList;
   Parent: DFS_HWND; Pos: TPoint; ShowRename: boolean;
   var RenameSelected: boolean): boolean; overload;

function DisplayContextMenu(AParent: IShellFolder; var APIDL: PItemIDList;
   Attr: ULONG; Parent: DFS_HWND; Pos: TPoint; PidlCount: integer;
   ShowRename: boolean; var RenameSelected: boolean): boolean; overload;

{$ELSE}

function DisplayContextMenu(const Filename: string; Parent: DFS_HWND;
   Pos: TPoint; ShowRename: boolean; var RenameSelected: boolean): boolean;

function DisplayContextMenuList(const Directory: string; Items: TStringList;
   Parent: DFS_HWND; Pos: TPoint; ShowRename: boolean;
   var RenameSelected: boolean): boolean;

function DisplayContextMenuPIDL(AParent: IShellFolder; var APIDL: PItemIDList;
   Attr: ULONG; Parent: DFS_HWND; Pos: TPoint; PidlCount: integer;
   ShowRename: boolean; var RenameSelected: boolean): boolean;

{$ENDIF}

//------------------------------------------------------------------------------
// DisplayPropertiesDialog displays, oddly enough, the properties dialog for
// the given file or directory.  Parent is the window handle for the owning
// window of any error messages that may need to be displayed by the system,
// MyForm.Handle is generally fine.
//------------------------------------------------------------------------------
{$IFDEF DFS_COMPILER_4_UP}
function DisplayPropertiesDialog(const Filename: string;
   Parent: DFS_HWND): boolean; overload;

function DisplayPropertiesDialog(const Directory: string; Items: TStringList;
   Parent: DFS_HWND): boolean; overload;

function DisplayPropertiesDialog(AParent: IShellFolder; var APIDL: PItemIDList;
   Attr: ULONG; Parent: DFS_HWND; PidlCount: integer): boolean; overload;

{$ELSE}

function DisplayPropertiesDialog(const Filename: string; Parent: DFS_HWND): boolean;

function DisplayPropertiesDialogList(const Directory: string; Items: TStringList;
   Parent: DFS_HWND): boolean;

function DisplayPropertiesDialogPIDL(AParent: IShellFolder; var APIDL: PItemIDList;
   Attr: ULONG; Parent: DFS_HWND; PidlCount: integer): boolean;

{$ENDIF}

//------------------------------------------------------------------------------
// PerformDefaultAction causes the item's double-click action to be taken.
// Parent is the window handle for the owning window of any error messages
// that may need to be displayed by the system, MyForm.Handle is generally fine.
//------------------------------------------------------------------------------
{$IFDEF DFS_COMPILER_4_UP}
function PerformDefaultAction(const Filename: string;
   Parent: DFS_HWND): boolean; overload;

function PerformDefaultAction(const Directory: string; Items: TStringList;
   Parent: DFS_HWND): boolean; overload;

function PerformDefaultAction(AParent: IShellFolder; var APIDL: PItemIDList;
   Attr: ULONG; Parent: DFS_HWND; PidlCount: integer): boolean; overload;

{$ELSE}

function PerformDefaultAction(const Filename: string;
   Parent: DFS_HWND): boolean;

function PerformDefaultActionList(const Directory: string; Items: TStringList;
   Parent: DFS_HWND): boolean;

function PerformDefaultActionPIDL(AParent: IShellFolder; var APIDL: PItemIDList;
   Attr: ULONG; Parent: DFS_HWND; PidlCount: integer): boolean;
   
{$ENDIF}


//------------------------------------------------------------------------------
// PerformVerb causes executes the given verb for the item.  Common verbs are
// 'delete', 'cut', 'copy', 'paste', etc. Parent is the window handle for the
// owning window of any error messages that may need to be displayed by the
// system, MyForm.Handle is generally fine.
//------------------------------------------------------------------------------
{$IFDEF DFS_COMPILER_4_UP}
function PerformVerb(const Verb, Filename: string;
   Parent: DFS_HWND): boolean; overload;

function PerformVerb(const Verb, Directory: string; Items: TStringList;
   Parent: DFS_HWND): boolean; overload;

function PerformVerb(const Verb: string; AParent: IShellFolder;
   var APIDL: PItemIDList; Attr: ULONG; Parent: DFS_HWND;
   PidlCount: integer): boolean; overload;

{$ELSE}

function PerformVerb(const Verb, Filename: string; Parent: DFS_HWND): boolean;

function PerformVerbList(const Verb, Directory: string; Items: TStringList;
   Parent: DFS_HWND): boolean;

function PerformVerbPIDL(const Verb: string; AParent: IShellFolder;
   var APIDL: PItemIDList; Attr: ULONG; Parent: DFS_HWND;
   PidlCount: integer): boolean;
{$ENDIF}


//------------------------------------------------------------------------------
// Utility function that you probably won't need, but included just in case.
// Caller is responsible for calling shell malloc Free for PIDL param when done.
//------------------------------------------------------------------------------
function GetPIDLAndShellFolder(Path: string;
   {$IFDEF DFS_COMPILER_4_UP} out {$ELSE} var {$ENDIF} Folder: IShellFolder;
   var PIDL: PItemIDList; ShellMalloc: IMalloc;
   Parent: DFS_HWND): boolean;

type
  PPIDLArray = ^TPIDLArray;
  TPIDLArray = array[0..0] of PItemIDList;


implementation

uses SysUtils, Forms, Controls, Messages;


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

{$IFDEF DFS_COMPILER_3}
const
  SID_IContextMenu3      = '{BCFCE0A0-EC17-11d0-8D10-00A0C90F2719}';

type
  { D3 and C3 got the declaration of IContextMenu2 wrong in ShlObj.pas unit. }
  IContextMenu2 = interface(IContextMenu)
    [SID_IContextMenu2]
    function HandleMenuMsg(uMsg: UINT; wParam: WPARAM; lParam: LPARAM): HResult;
       stdcall;
  end;

  { Only D4 has this one }
  IContextMenu3 = interface(IContextMenu2)
    [SID_IContextMenu3]
    function HandleMenuMsg2(uMsg: UINT; wParam: WPARAM; lParam: LPARAM;
      var Result: longint): HResult; stdcall;
  end;

{$ELSE} {$IFDEF DFS_COMPILER_2}
  { D2 and C1 don't have IContextMenu2 declared at all... }
const
  IID_IContextMenu2: TGUID = (
    D1:$000214F4; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46));

type
  IContextMenu2 = class(IContextMenu)
    function HandleMenuMsg(uMsg: UINT; wParam: WPARAM; lParam: LPARAM): HResult;
       virtual; stdcall; abstract;
  end;

  { Only D4 has this one }
  IContextMenu3 = class(IContextMenu2)
    function HandleMenuMsg2(uMsg: UINT; wParam: WPARAM; lParam: LPARAM;
      var Result: longint): HResult; virtual; stdcall; abstract;
  end;
{$ENDIF} {$ENDIF}

const
  CMD_ID_OFFSET = 1;

var
  IsCM2: boolean;
  IsCM3: boolean;
  g_ShowRename: boolean;
  g_RenameSelected: boolean;

type
  DoubleWord = record
    case boolean of
      TRUE: (Lo, Hi: word);
      FALSE: (DW: DWORD);
  end;

function MenuCallbackProc(Wnd: HWND; Msg: UINT; wParam: WPARAM;
   lParam: LPARAM): LResult; stdcall; export;
var
  CM2: IContextMenu2;
  CM3: IContextMenu3;
  Name,
  Help: string;
  CM: IContextMenu;
  DWParam: DoubleWord absolute wParam;
begin
  case Msg of
    WM_CREATE:
      begin
        if IsCM3 then
        begin
          // get pointer to the IContextMenu3 on whose behalf we're acting
          CM3 := IContextMenu3(PCreateStruct(lParam).lpCreateParams);
          // Save it in window info
          SetWindowLong(Wnd, GWL_USERDATA, LongInt(CM3));
        end
        else if IsCM2 then
        begin
          // get pointer to the IContextMenu2 on whose behalf we're acting
          CM2 := IContextMenu2(PCreateStruct(lParam).lpCreateParams);
          // Save it in window info
          SetWindowLong(Wnd, GWL_USERDATA, LongInt(CM2));
        end
        else
        begin
          // get pointer to the IContextMenu on whose behalf we're acting
          CM := IContextMenu(PCreateStruct(lParam).lpCreateParams);
          // Save it in window info
          SetWindowLong(Wnd, GWL_USERDATA, LongInt(CM));
        end;
        Result := DefWindowProc(Wnd, Msg, wParam, lParam);
      end;

    // these are the biggies -- the messages that IContextMenu2::HandlMenuMsg is
    // supposed to handle.
    WM_DRAWITEM,
    WM_MEASUREITEM,
    WM_INITMENUPOPUP:
      begin
        if IsCM3 then
        begin
          // grab object pointer from window data -- we put it there in WM_CREATE
          CM3 := IContextMenu3(GetWindowLong(Wnd, GWL_USERDATA));

          {$IFDEF DFS_COMPILER_3_UP}
          Assert(CM3 <> NIL, 'NIL Context Menu!');
          {$ENDIF}

          // pass along to context menu
          CM3.HandleMenuMsg2(Msg, wParam, lParam, Result);
        end
        else if IsCM2 then
        begin
          // grab object pointer from window data -- we put it there in WM_CREATE
          CM2 := IContextMenu2(GetWindowLong(Wnd, GWL_USERDATA));

          {$IFDEF DFS_COMPILER_3_UP}
          Assert(CM2 <> NIL, 'NIL Context Menu!');
          {$ENDIF}

          // pass along to context menu
          CM2.HandleMenuMsg(Msg, wParam, lParam);
        end;
        if Msg = WM_INITMENUPOPUP then
          Result := 0
        else
          Result := 1;
      end;

    // this is to set Application.Hint
    WM_MENUSELECT:
      begin
        // This occurs every time the current menu selection changes
        // LoWord(wParam) will be the CmdID if the menu entry is a command item,
        //   or the sub-menu's index if a sub-menu.
        // HiWord(wParam) will be a set of MF_ flags
        // lParam is the handle of the menu in which the command item or
        //   sub-menu lies. 
        // When the user Escapes out of the menu, flags will be $FFFF and
        //   lParam = Nil.

        // Grab object pointer from window data -- we put it there in WM_CREATE
        // Because CM2 and CM3 descend from CM, we can typecast any of the three
        // to CM
        CM := IContextMenu(GetWindowLong(Wnd, GWL_USERDATA));
        // We mimic the VCL's TMenuItem hint dispatching algorithm by setting
        // Application.Hint
        if ((DWParam.Hi = $FFFF) and (lParam = 0)) then
          Application.Hint :=  ''
        else if (DWParam.Lo >= CMD_ID_OFFSET) then
        begin
          SetLength(Name, MAX_PATH);
          // If it doesn't have one, it won't null out the string so we have to.
          Name[1] := #0;
          CM.GetCommandString(DWParam.Lo - CMD_ID_OFFSET, GCS_VERB,
            NIL, PChar(Name), MAX_PATH);
          SetLength(Name, StrLen(PChar(Name)));
          {
          NOTE:
            Not all context menu extensions report verbs (WinZip, for example);
            SendTo is explicitly instructed by the shell not to include any
            verbs (via CMF_NOVERBS)
          }
          SetLength(Help, MAX_PATH);
          // If it doesn't have one, it won't null out the string so we have to.
          Help[1] := #0;
          CM.GetCommandString(DWParam.Lo - CMD_ID_OFFSET,
            GCS_HELPTEXT, NIL, PChar(Help), MAX_PATH);
          SetLength(Help, StrLen(PChar(Help)));
          // The pipe ('|') separates the short hint from the long one.
          Application.Hint := Name + '|' + Help;
        end;
      end;
  else
    Result := DefWindowProc(Wnd, Msg, wParam, lParam);
  end;
end;


type
  TInterfaceCommand = (icContextMenu, icProperties, icDefaultAction, icVerb);

// Internal function used by all others as they share a lot of common
// functionality.
function InvokeInterfaceElement(Filename: string; AFolder: IShellFolder;
   var APIDL: PItemIDList; AnAttr: ULONG; Cmd: TInterfaceCommand;
   const Verb: string; Parent: HWND; Pos: TPoint; PidlCount: integer): boolean;

  function HandleContextMenu(const CtxMenu: IContextMenu; Attr: ULONG): boolean;
  const
    RENAME_COMMAND = $13;
  var
    Popup: HMenu;
    ICI: TCMInvokeCommandInfo;
    MenuCmd: Cardinal;
//    CmdString: string;
    CallbackWnd: HWnd;
    AWndClass: TWndClass;
  begin
    Result := FALSE;
    g_RenameSelected := FALSE;
    CallbackWnd := 0;
    FillChar(ICI, SizeOf(TCMInvokeCommandInfo), #0);
    with ICI do
    begin
      cbSize := SizeOf(TCMInvokeCommandInfo);
      hWnd := Parent;
      nShow := SW_SHOWNORMAL;
    end;
    case Cmd of
      icContextMenu:
        begin
          Popup := CreatePopupMenu;
          try
            // Add "or CMF_CANRENAME" if you want the rename item
            if Succeeded(CtxMenu.QueryContextMenu(Popup, 0, 1, $7FFF,
              CMF_EXPLORE or CMF_CANRENAME)) then
            begin
              FillChar(AWndClass, SizeOf(AWndClass), #0);
              AWndClass.lpszClassName := 'ItemPropMenuCallbackHelper';
              AWndClass.Style := CS_PARENTDC;
              AWndClass.lpfnWndProc := @MenuCallbackProc;
              AWndClass.hInstance := HInstance;
              Windows.RegisterClass(AWndClass);
              CallbackWnd := CreateWindow('ItemPropMenuCallbackHelper',
                 'ItemPropCallbackProcessor', WS_POPUPWINDOW, 0, 0, 0, 0, 0,
                 0, HInstance, Pointer(CtxMenu));

              Result := TRUE; // We displayed the menu, that's it unless they