itemprop.pas

最好的局域网搜索软件

                              // make a selection.
              MenuCmd := Cardinal(TrackPopupMenuEx(Popup, TPM_LEFTALIGN or
                 TPM_RETURNCMD or TPM_RIGHTBUTTON, Pos.x, Pos.y, CallbackWnd,
                 NIL));
              if MenuCmd = RENAME_COMMAND then
              begin
                g_RenameSelected := TRUE;
                Result := TRUE;
              end
              else
              if MenuCmd <> 0 then
              begin
(*
                SetLength(CmdString, 255);
                if Succeeded(CtxMenu.GetCommandString(MenuCmd - CMD_ID_OFFSET, GCS_VERB, NIL,
                   PChar(CmdString), 255)) then
                  ICI.lpVerb := PChar(CmdString)
                else
                  ICI.lpVerb := MakeIntResource(MenuCmd - CMD_ID_OFFSET);
*)
                ICI.lpVerb := MakeIntResource(MenuCmd - CMD_ID_OFFSET);
                Result := Succeeded(CtxMenu.InvokeCommand(ICI));
              end;
            end;
          finally
            DestroyMenu(Popup);
            if CallbackWnd <> 0 then
              DestroyWindow(CallbackWnd);
          end;
        end;
      icVerb:
        begin
          ICI.lpVerb := PChar(Verb);
          Result := Succeeded(CtxMenu.InvokeCommand(ICI));
        end;
      icProperties:
        begin
          // does it have a property sheet?
          if (Attr and SFGAO_HASPROPSHEET) <> 0 then
          begin
            ICI.lpVerb := 'properties'; // Built-in verb for all items, I think
            Result := Succeeded(CtxMenu.InvokeCommand(ICI));
          end;
        end;
      icDefaultAction:
        begin
          Popup := CreatePopupMenu;
          try
            if Succeeded(CtxMenu.QueryContextMenu(Popup, 0, 1, $7FFF,
               CMF_DEFAULTONLY)) then
            begin
              MenuCmd := GetMenuDefaultItem(Popup, 0, 0);
              if MenuCmd <> $FFFFFFFF then
              begin
                ICI.lpVerb := MakeIntResource(MenuCmd - CMD_ID_OFFSET);
                Result := Succeeded(CtxMenu.InvokeCommand(ICI));
              end;
            end;
          finally
            DestroyMenu(Popup);
          end;
        end;
    end;
  end; { InvokeInterfaceElement }

  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
{$IFNDEF DFS_NO_COM_CLEANUP}
        ContextMenu._Release; // Delphi 3 does this for you.
{$ENDIF}
        ContextMenu := ContextMenu2;
        IsCM2 := TRUE;

        if Succeeded(ContextMenu.QueryInterface(IID_IContextMenu3,
           pointer(ContextMenu3))) then
        begin
{$IFNDEF DFS_NO_COM_CLEANUP}
          ContextMenu._Release; // Delphi 3 does this for you.
{$ENDIF}
          ContextMenu := ContextMenu3;
          IsCM3 := TRUE;
        end;
      end;
      try
        Result := HandleContextMenu(ContextMenu, Attr);
      finally
{$IFNDEF DFS_NO_COM_CLEANUP}
        ContextMenu._Release; // Delphi 3 does this for you.
{$ENDIF}
      end;
    end;
  end;

  function HasWildcards(const s: string): boolean;
  begin
    Result := (StrScan(PChar(s), '*') <> NIL) or (StrScan(PChar(s), '?') <> NIL);
  end;

const
  {$IFDEF DFS_CPPB}
  ATTR_ALL = ULONG($FFFFFFFF);
  {$ELSE}
  ATTR_ALL = $FFFFFFFF;
  {$ENDIF}
var
  ShellMalloc: IMalloc;
  SubFolder,
  ShellFolder: IShellFolder;
  FolderID,
  ItemID: pItemIDList;
  Eaten, ulAttr: ULONG;
  uiAttr: UINT;
{$IFDEF DFS_COMPILER_3_UP}
  oleWild,
  oleAll,
  oleSubDir,
  oleFilename: widestring;
{$ELSE}
  oleWild,
  oleAll,
  oleSubDir,
  oleFilename: PWideChar;
{$ENDIF}
  OldCursor: TCursor;
  JustName: string;
  EnumList: IEnumIDList;
  CompID: pItemIDList;
  CompFolder: IShellFolder;
{$IFDEF DFS_CPPB}
  Fetched: Cardinal;
  Dummy: UINT absolute 0;
{$ELSE}
  Fetched: ULONG;
{$ENDIF}
  SR: TSearchRec;
  WildFiles: TStringList;
  WildPIDLs: PPIDLArray;
  Count,
  x: integer;
begin
  IsCM2 := FALSE;
  IsCM3 := FALSE;
  Result := FALSE;
  OldCursor := Screen.Cursor;
  Screen.Cursor := crHourglass;
  try
    if (APIDL <> NIL) then
    begin
      Result := HandleFromPIDLs(Parent, AFolder, APIDL, AnAttr, PidlCount);   
    end else
    begin
      SHGetMalloc(ShellMalloc);
      // I'm extra liberal with my try-finally blocks when dealing with system
      // resources like these.  Last thing I want to do is make the shell itself
      // unstable.
      try
        JustName := ExtractFileName(FileName);
{$IFDEF DFS_COMPILER_3_UP}
        oleSubDir := ExtractFilePath(Filename);
        try
          oleFilename := JustName;
          try
{$ELSE}
        oleSubDir := StringToOLEStr(ExtractFilePath(Filename));
        if assigned(oleSubDir) then
        try
          oleFilename := StringToOLEStr(JustName);
          if assigned(oleFilename) then
          try
{$ENDIF}
            if Succeeded(SHGetDesktopFolder(ShellFolder)) then
            try
              if Succeeded(ShellFolder.ParseDisplayName(Parent, NIL,
                 PWideChar(oleSubDir), Eaten, FolderID, ulAttr)) then
              try
                if Succeeded(ShellFolder.BindToObject(FolderID, NIL,
                   IID_IShellFolder, pointer(SubFolder))) then
                try
                  ulAttr := ATTR_ALL; // Tell it to return everything.
                  if HasWildcards(JustName) then
                  begin
                    WildFiles := TStringList.Create;
                    try
                      if FindFirst(Filename, faAnyFile, SR) = 0 then
                      begin
                        WildFiles.Add(SR.Name);
                        while FindNext(SR) = 0 do
                          WildFiles.Add(SR.Name);
                        FindClose(SR);
                      end;

                      if WildFiles.Count > 0 then
                      begin
                        Count := 0;
                        GetMem(WildPIDLs, SizeOf(PItemIDList) * WildFiles.Count);
                        try
                          for x := 0 to WildFiles.Count - 1 do
                          begin
{$IFDEF DFS_COMPILER_3_UP}
                            oleWild := WildFiles[x];
                            try
{$ELSE}
                            oleWild := StringToOLEStr(WildFiles[x]);
                            if assigned(oleSubDir) then
                            try
{$ENDIF}
                              ulAttr := ATTR_ALL; // Tell it to return everything.
{ Turn off range checking because WildPILDs is typed as an array of 0..0.}
{$IFOPT R+} {$DEFINE DFS_RESET_RANGE_CHECKING} {$R-} {$ENDIF}
                              if Succeeded(SubFolder.ParseDisplayName(Parent,
                                 NIL, PWideChar(oleWild), Eaten,
                                 WildPIDLs^[Count], ulAttr)) then
{$IFDEF DFS_RESET_RANGE_CHECKING} {$R+} {$UNDEF DFS_RESET_RANGE_CHECKING} {$ENDIF}
                                Inc(Count);
                            finally
{$IFNDEF DFS_NO_COM_CLEANUP}
                              SysFreeString(oleWild);
{$ENDIF}
                            end;
                          end;

                          if Count > 0 then
                          begin
                            // ParseDisplayName should have populated ulAttr, but
                            // it seems to fail on Windows 2000.
                            SubFolder.GetAttributesOf(Count, WildPIDLs^[0], uiAttr);
                            Result := HandleFromPIDLS(Parent, SubFolder,
                               WildPIDLs^[0], uiAttr, Count);
                          end;
                        finally
                          for x := 0 to Count - 1 do
{ Turn off range checking because WildPILDs is typed as an array of 0..0.}
{$IFOPT R+} {$DEFINE DFS_RESET_RANGE_CHECKING} {$R-} {$ENDIF}
                            ShellMalloc.Free(WildPIDLs^[x]);
{$IFDEF DFS_RESET_RANGE_CHECKING} {$R+} {$UNDEF DFS_RESET_RANGE_CHECKING} {$ENDIF}
                          FreeMem(WildPIDLs);
                        end;
                      end;
                    finally
                      WildFiles.Free;
                    end;

                  end else if Succeeded(SubFolder.ParseDisplayName(Parent, NIL,
                     PWideChar(oleFilename), Eaten, ItemID, ulAttr)) then
                  begin
                    try
                      // ParseDisplayName should have populated ulAttr, but it
                      // seems to fail on Windows 2000.
                      SubFolder.GetAttributesOf(1, ItemID, uiAttr);
                      Result := HandleFromPIDLS(Parent, SubFolder, ItemID,
                        uiAttr, 1);
  (*
                      if Succeeded(SubFolder.GetUIObjectOf(Parent, 1, ItemID,
                         IID_IContextMenu, NIL, pointer(ContextMenu))) then
                      begin
                        if Succeeded(ContextMenu.QueryInterface(IID_IContextMenu2,
                           pointer(ContextMenu2))) then
                        begin
{$IFNDEF DFS_NO_COM_CLEANUP}
                          ContextMenu.Release; // Delphi 3 does this for you.
{$ENDIF}
                          ContextMenu := ContextMenu2;
                          IsCM2 := TRUE;
                        end;
                        try
                          HandleContextMenu(ContextMenu, uiAttr, IsCM2);
                        finally
{$IFNDEF DFS_NO_COM_CLEANUP}
                          ContextMenu.Release; // Delphi 3 does this for you.
{$ENDIF}
                        end;
                      end;
  *)
                    finally
                      ShellMalloc.Free(ItemID);
                    end;
                  end else begin
                    // No filename, probably a drive.
{$IFDEF DFS_COMPILER_3_UP}
                    oleAll := Filename;
{$ELSE}
                    oleAll := StringToOLEStr(Filename);
{$ENDIF}
                    // This is screwy, but it's the only way I could get it to
                    // work. Basically, the thing is that for drives, the
                    // IShellFolder MUST be the parent of the drive PIDL.  The
                    // Desktop folder won't work. So, I enumerate the Desktop
                    // folder, taking the first child which *SHOULD* be the "My
                    // Computer" item, which is the parent of drives.
                    if Succeeded(ShellFolder.EnumObjects(Parent,
                       SHCONTF_FOLDERS, EnumList)) then
                    try
                      if EnumList.Next(1, CompID, Fetched) = S_OK then
                      begin
                        if Succeeded(ShellFolder.BindToObject(CompID, NIL,
                           IID_IShellFolder, pointer(CompFolder))) then
                        try
                          if Succeeded(CompFolder.ParseDisplayName(Parent, NIL,
                             PWideChar(oleAll),Eaten, ItemID, ulAttr)) then
                          try
                            // ParseDisplayName should have populated ulAttr, but
                            // it seems to fail on Windows 2000.
                            CompFolder.GetAttributesOf(1, ItemID, uiAttr);
                            Result := HandleFromPIDLS(Parent, CompFolder, ItemID,
                               uiAttr, 1);
(*
                            if Succeeded(CompFolder.GetUIObjectOf(Parent, 1, ItemID,
                               IID_IContextMenu, NIL, pointer(ContextMenu))) then
                            begin
                              if Succeeded(ContextMenu.QueryInterface(
                                 IID_IContextMenu2, pointer(ContextMenu2))) then
                              begin
{$IFNDEF DFS_NO_COM_CLEANUP}
                                ContextMenu.Release; // Delphi 3 does this for you.
{$ENDIF}
                                ContextMenu := ContextMenu2;
                                IsCM2 := TRUE;
                              end;
                              try
                                HandleContextMenu(ContextMenu, uiAttr, IsCM2);
                              finally
{$IFNDEF DFS_NO_COM_CLEANUP}
                                ContextMenu.Release; // Delphi 3 does this for you.
{$ENDIF}
                              end;
                            end;
*)
                          finally
                            ShellMalloc.Free(ItemID);
                          end;
                        finally
{$IFNDEF DFS_NO_COM_CLEANUP}
                          CompFolder._Release; // Delphi 3 does this for you.
{$ENDIF}
                        end;
                      end;
                    finally
{$IFNDEF DFS_NO_COM_CLEANUP}
                      EnumList._Release; // Delphi 3 does this for you.
{$ENDIF}
                    end;
{$IFNDEF DFS_NO_COM_CLEANUP}
                    SysFreeString(oleAll);
{$ENDIF}
                  end;
                finally
{$IFNDEF DFS_NO_COM_CLEANUP}
                  SubFolder._Release; // Delphi 3 does this for you.
{$ENDIF}
                end;
              finally
                ShellMalloc.Free(FolderID);
              end;
            finally
{$IFNDEF DFS_NO_COM_CLEANUP}
              ShellFolder._Release; // Delphi 3 does this for you.
{$ENDIF}
            end;
          finally
{$IFNDEF DFS_NO_COM_CLEANUP}
            SysFreeString(oleFilename);
{$ENDIF}
          end;
        finally
{$IFNDEF DFS_NO_COM_CLEANUP}
          SysFreeString(oleSubDir);
{$ENDIF}
        end;
      finally
{$IFDEF DFS_COMPILER_3_UP}
        ShellMalloc._Release;
{$ELSE}
        ShellMalloc._Release;
{$ENDIF}
      end;
    end;
  finally
    Screen.Cursor := OldCursor;
  end;
end;

function InvokeListInterfaceElement(const Directory: string; Items: TStringList;
   Parent: HWND; Pos: TPoint; Cmd: TInterfaceCommand; const Verb: string): boolean;
var
  ShellMalloc: IMalloc;
  SubFolder,
  ShellFolder: IShellFolder;
  FolderID: PItemIDList;
  Eaten, Attr: ULONG;
{$IFDEF DFS_COMPILER_3_UP}
  oleSubDir,
  oleFilename: widestring;
{$ELSE}
  oleSubDir,
  oleFilename: PWideChar;
{$ENDIF}
  ItemPIDLs: PPIDLArray;
  Count,
  x: integer;
begin
  Result := FALSE;