dcshellproperties.pas

DiskControls.v3.8.Full.Source 控制磁盘的控件 包括源代码

      nShow := SW_SHOWNORMAL;
     end;
    if IsContextMenu then
     begin
      Popup := CreatePopupMenu;
      try
        if Succeeded(CtxMenu.QueryContextMenu(Popup, 0, 1, $7FFF,
                     CanRenameFlags[moCanRename in FMenuOptions] or
                     Flags)) 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
                          // make a selection.
          GetCursorPos(MousePos);
          MenuCmd := Cardinal(TrackPopupMenuEx(Popup, MenuAlignments[FMenuAlignment] or
                              TPM_RETURNCMD or TPM_LEFTBUTTON or TPM_RIGHTBUTTON, MousePos.x, MousePos.y, CallbackWnd, nil));

          case MenuCmd of
            CRENAME: begin
                      if Assigned(FOnRename) then
                        FOnRename(Self, FileName);
                      Result := True;  
                      Exit;  
                     end;
            CCREATESHORTCUT: if not (moAllowDelete in FMenuOptions) then
                              begin
                               Result := True;
                               Exit;
                              end;
            CDELETE: if not (moAllowDelete in FMenuOptions) then
                      begin
                       Result := True;
                       Exit;
                      end;
            CCUT: if not (moAllowCut in FMenuOptions) then
                   begin
                    Result := True;
                    Exit;
                   end;
            CCOPY: if not (moAllowCopy in FMenuOptions) then
                    begin
                     Result := True;
                     Exit;
                    end;
            CPASTE: if not (moAllowPaste in FMenuOptions) then
                     begin
                      Result := True;
                      Exit;
                     end;
           end;

          if MenuCmd <> 0 then
           begin
            if Assigned(FOnBeforeMenuItemClick) then
             begin
              Discard := False;
              FOnBeforeMenuItemClick(Self, FileName, MenuCmd, Discard);
              if Discard then
               begin
                Result := True;
                Exit;
               end;
             end;

            ICI.lpVerb := MakeIntResource(MenuCmd - 1);
            Result := Succeeded(CtxMenu.InvokeCommand(ICI));

            if Assigned(FOnAfterMenuItemClick) then
              FOnAfterMenuItemClick(Self, FileName, MenuCmd);

            if (MenuCmd = CDELETE) and not ObjectExists(FileName) and
               Assigned(FOnDelete) then
              FOnDelete(Self, FileName);
           end;
         end;
      finally
        DestroyMenu(Popup);
        if CallbackWnd <> 0 then
          DestroyWindow(CallbackWnd);
      end
     end
    else
{* Possible Win98SE bug - does not returns
   SFGA_HASPROPSHEET flag for disks (AK) *}
//     if Attr and SFGAO_HASPROPSHEET <> 0 then
      begin
       ICI.lpVerb := 'properties'; // do not localize
       Result := Succeeded(CtxMenu.InvokeCommand(ICI));
      end;
  end;

  function HandleFromPIDLs(Parent: HWND; SubFolder: IShellFolder;
     var ItemID: PItemIDList; Attr: ULONG; PidlCount: integer): boolean;
  var
    ContextMenu: IContextMenu;
    ContextMenu2: IContextMenu2;
    ContextMenu3: IContextMenu3;
  begin
    Result := False;
    IsCM2 := False;

    if Succeeded(SubFolder.GetUIObjectOf(Parent, PidlCount, ItemID,
       IID_IContextMenu, nil, pointer(ContextMenu))) then
    begin
      if Succeeded(ContextMenu.QueryInterface(IID_IContextMenu2,
         Pointer(ContextMenu2))) then
      begin
        {$IFDEF NO_COM_CLEANUP}
        ContextMenu.Release;
        {$ENDIF}
        ContextMenu := ContextMenu2;
        IsCM2 := True;

        if Succeeded(ContextMenu.QueryInterface(IID_IContextMenu3,
           Pointer(ContextMenu3))) then
         begin
          {$IFDEF NO_COM_CLEANUP}
          ContextMenu.Release;
          {$ENDIF}
          ContextMenu := ContextMenu3;
          IsCM3 := True;
         end;
      end;
      try
        Result := HandleContextMenu(ContextMenu, Attr);
      finally
        {$IFDEF NO_COM_CLEANUP}
        ContextMenu.Release;
        {$ENDIF}
      end;
    end;
  end;

var
  ShellMalloc: IMalloc;
  DesktopFolder, CompFolder, SubFolder: IShellFolder;
  FolderID, ItemID: PItemIDList;
  Eaten, ulAttr: ULONG;
  uiAttr: UINT;
  oleAll, oleSubDir, oleFilename: WideString;
  OldCursor: TCursor;
  EnumList: IEnumIDList;
  CompID: PItemIDList;
  Fetched: ULONG;
begin
  { deleting odd params from filename (like "c:\file.exe /autorun" = "c:\file.exe")}
  GetPureFileName(FileName);

  IsCM2 := False;
  IsCM3 := False;
  Result := False;
  OldCursor := Screen.Cursor;
  Screen.Cursor := crHourglass;
  try
    SHGetMalloc(ShellMalloc);
    try
      oleSubDir := ExtractFilePath(FileName);
      try
        oleFileName := ExtractFileName(FileName);
        try
          if Succeeded(SHGetDesktopFolder(DesktopFolder)) then
           try
             if Succeeded(DesktopFolder.ParseDisplayName(GetActiveWindow, nil,
                PWideChar(oleSubDir), Eaten, FolderID, ulAttr)) then
              try
                if Succeeded(DesktopFolder.BindToObject(FolderID, nil,
                   IID_IShellFolder, Pointer(SubFolder))) then
                try
                  if Succeeded(SubFolder.ParseDisplayName(GetActiveWindow, nil,
                     PWideChar(oleFileName), Eaten, ItemID, ulAttr)) then
                   try
                     SubFolder.GetAttributesOf(1, ItemID, uiAttr);
                     Result := HandleFromPIDLS(GetActiveWindow, SubFolder, ItemID, uiAttr, 1);
                   finally
                     ShellMalloc.Free(ItemID);
                   end
                  else
                   begin // This is probably drive
                    oleAll := FileName;
                    if Succeeded(DesktopFolder.EnumObjects(GetActiveWindow,
                       SHCONTF_FOLDERS, EnumList)) then
                     try
                       if (EnumList.Next(1, CompID, Fetched) = S_OK) and
                          Succeeded(DesktopFolder.BindToObject(CompID, nil,
                                    IID_IShellFolder, Pointer(CompFolder))) then
                         try
                           if Succeeded(CompFolder.ParseDisplayName(GetActiveWindow, nil,
                              PWideChar(oleAll), Eaten, ItemID, ulAttr)) then
                           try
                             CompFolder.GetAttributesOf(1, ItemID, uiAttr);
                             Result := HandleFromPIDLS(GetActiveWindow, CompFolder, ItemID, uiAttr, 1);
                           finally
                             ShellMalloc.Free(ItemID);
                           end;
                         finally
{$IFDEF NO_COM_CLEANUP}              CompFolder.Release; {$ENDIF}
                         end;
                     finally
{$IFDEF NO_COM_CLEANUP}          EnumList.Release; {$ENDIF}
                     end;
{$IFDEF NO_COM_CLEANUP}       SysFreeString(oleAll); {$ENDIF}
                   end;
                finally
{$IFDEF NO_COM_CLEANUP}     SubFolder.Release; {$ENDIF}
                end;
              finally
                ShellMalloc.Free(FolderID);
              end;
            finally
{$IFDEF NO_COM_CLEANUP} ShellFolder.Release; {$ENDIF}
            end;
          finally
{$IFDEF NO_COM_CLEANUP} SysFreeString(oleFilename); {$ENDIF}
          end;
        finally
{$IFDEF NO_COM_CLEANUP} SysFreeString(oleSubDir); {$ENDIF}
        end;
      finally
        ShellMalloc._Release;
      end;
  finally
    Screen.Cursor := OldCursor;
  end;
end;


constructor TdcShellProperties.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  FMenuOptions := [moAllowDelete, moAllowCut, moAllowCopy, moAllowPaste, moAllowCreateShortcut, moActionItems, moExtendedItems, moSystemItems];
end;

function TdcShellProperties.ShowPropertiesByFile(const FileName: String): Boolean;
begin
  Result := ShowInterface(FileName, False);
end;

function TdcShellProperties.ShowContextMenuByFile(const FileName: String): Boolean;
begin
  Result := ShowInterface(FileName, True);
end;

function TdcShellProperties.ShowProperties: Boolean;
begin
  Result := ShowPropertiesByFile(FFileName);
end;

function TdcShellProperties.ShowContextMenu: Boolean;
begin
  Result := ShowContextMenuByFile(FFileName);
end;

end.