dcshellproperties.pas

获取硬盘相关详细信息

{*******************************************************************************

  Disk Controls pack v3.5
  FILE: dcShellProperties.pas - dcShellProperties component

  Copyright (c) 1999-2002 UtilMind Solutions
  All rights reserved.
  E-Mail: [e-mail], [e-mail]
  WWW: http://www.appcontrols.com, http://www.utilmind.com

  The entire contents of this file is protected by International Copyright
Laws. Unauthorized reproduction, reverse-engineering, and distribution of all
or any portion of the code contained in this file is strictly prohibited and
may result in severe civil and criminal penalties and will be prosecuted to
the maximum extent possible under the law.

*******************************************************************************}
{$I umDefines.inc}

unit dcShellProperties;

interface

uses
  Windows, Classes, Controls, Menus,
  dcInternal;

type
  TdcBeforeMenuItemClickEvent = procedure(Sender: TObject; const FileName: String; MenuItemID: Integer; var Discard: Boolean) of object;
  TdcAfterMenuItemClickEvent = procedure(Sender: TObject; const FileName: String; MenuItemID: Integer) of object;
  TdcContextMenuEvent = procedure(Sender: TObject; const FileName: String) of object;

  TdcContextMenuOption = (moCanRename, moAllowDelete, moAllowCut, moAllowCopy, moAllowPaste, moAllowCreateShortcut, moActionItems, moExtendedItems, moSystemItems);
  TdcContextMenuOptions = set of TdcContextMenuOption;
  TdcShellProperties = class(TumdcComponent)
  private
    FFileName: String;
    FMenuAlignment: TPopupAlignment;
    FMenuOptions: TdcContextMenuOptions;

    FOnBeforeMenuItemClick: TdcBeforeMenuItemClickEvent;
    FOnAfterMenuItemClick: TdcAfterMenuItemClickEvent;

    FOnDelete, FOnRename: TdcContextMenuEvent;

    procedure SetFileName(Value: String);

    function ShowInterface(const FileName: String; IsContextMenu: Boolean): Boolean;
  protected
  public
    constructor Create(aOwner: TComponent); override;

    function ShowPropertiesByFile(const FileName: String): Boolean;
    function ShowContextMenuByFile(const FileName: String): Boolean;

    function ShowProperties: Boolean;
    function ShowContextMenu: Boolean;
  published
    property About;

    property FileName: String read FFileName write SetFileName stored False;
    property MenuAlignment: TPopupAlignment read FMenuAlignment write FMenuAlignment default paLeft;
    property MenuOptions: TdcContextMenuOptions read FMenuOptions write FMenuOptions default [moAllowDelete, moAllowCut, moAllowCopy, moAllowPaste, moAllowCreateShortcut, moActionItems, moExtendedItems, moSystemItems];

    property OnBeforeMenuItemClick: TdcBeforeMenuItemClickEvent read FOnBeforeMenuItemClick write FOnBeforeMenuItemClick;
    property OnAfterMenuItemClick: TdcAfterMenuItemClickEvent read FOnAfterMenuItemClick write FOnAfterMenuItemClick;
    property OnDelete: TdcContextMenuEvent read FOnDelete write FOnDelete;
    property OnRename: TdcContextMenuEvent read FOnRename write FOnRename;
  end;

implementation

uses
  Messages, Forms, SysUtils, ShellAPI, ShlObj, ActiveX, dcUtils;

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

{$IFDEF D3}
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;
{$ENDIF}

type
  DoubleWord = record
    case Boolean of
      True: (Lo, Hi: word);
      False: (DW: DWORD);
  end;

var
  IsCM2: Boolean;
  IsCM3: Boolean;

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;
    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));
                         Assert(CM3 <> nil, 'NIL Context Menu!');
                         // 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));
                          Assert(CM2 <> nil, 'NIL Context Menu!');
                          // 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
                    CM := IContextMenu(GetWindowLong(Wnd, GWL_USERDATA));
                    if ((DWParam.Hi = $FFFF) and (lParam = 0)) then
                      Application.Hint :=  ''
                    else
                     if DWParam.Lo >= 1 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 - 1, GCS_VERB, nil, PChar(Name), MAX_PATH);
                       SetLength(Name, StrLen(PChar(Name)));
                       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 - 1, 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;

procedure TdcShellProperties.SetFileName(Value: String);
begin
  { deleting odd params from filename (like "c:\file.exe /autorun" = "c:\file.exe")}
  GetPureFileName(Value);
  while (Value <> '') and (Value[Length(Value)] = '\') and (Value[Length(Value) - 1] <> ':') do
    SetLength(Value, Length(Value) - 1);

  if FFileName <> Value then
    FFileName := Value;
end;

function TdcShellProperties.ShowInterface(const FileName: String; IsContextMenu: Boolean): Boolean;

  function HandleContextMenu(const CtxMenu: IContextMenu; Attr: ULONG): boolean;
  const
    MenuAlignments: Array[TPopupAlignment] of Integer = (TPM_LEFTALIGN, TPM_RIGHTALIGN, TPM_CENTERALIGN);
    CanRenameFlags: Array[Boolean] of Integer = (0, CMF_CANRENAME);

    CCREATESHORTCUT = $11;
    CDELETE     = $12;
    CRENAME     = $13;
    CPROPERTIES = $14;
    CCUT        = $19;
    CCOPY       = $1A;
    CPASTE      = $1B;
  var
    Popup: hMenu;
    ICI: TCMInvokeCommandInfo;
    MenuCmd: Cardinal;
    CallbackWnd: HWnd;
    AWndClass: TWndClass;
    Flags: Integer;
    Discard: Boolean;
    MousePos: TPoint;
  begin
    Result := False;
    CallbackWnd := 0;

    // FLAGS
    Flags := CMF_EXPLORE;

    if not (not (moActionItems in FMenuOptions) and
            not (moExtendedItems in FMenuOptions) and
            not (moSystemItems in FMenuOptions)) then
    { ! SystemOnly ! }
     if not (moExtendedItems in FMenuOptions) and
        not (moActionItems in FMenuOptions) then
       Flags := Flags + CMF_NOVERBS
     else
       { ! Action Only ! }
       if not (moExtendedItems in FMenuOptions) and
          not (moSystemItems in FMenuOptions) then
         Flags := Flags + CMF_VERBSONLY + CMF_DEFAULTONLY
       else
         { ! Action + System ! }
         if not (moExtendedItems in FMenuOptions) then
           Flags := Flags + CMF_DEFAULTONLY
         else
           { ! Extended or Extended + Action}
           if (moExtendedItems in FMenuOptions) and
              not (moSystemItems in FMenuOptions) then
             Flags := Flags + CMF_VERBSONLY;

    FillChar(ICI, SizeOf(TCMInvokeCommandInfo), #0);
    with ICI do
     begin
      cbSize := SizeOf(TCMInvokeCommandInfo);
      hWnd := GetActiveWindow;