itemprop.pas

动态提示控件

{$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;
  if (Items = NIL) or (Items.Count < 1) then
    exit;

  SHGetMalloc(ShellMalloc);
  try
    if Succeeded(SHGetDesktopFolder(ShellFolder)) then
    try
{$IFDEF DFS_COMPILER_3_UP}
      oleSubDir := Directory;
{$ELSE}
      oleSubDir := StringToOLEStr(Directory);
      if assigned(oleSubDir) then
{$ENDIF}
      try
        if Succeeded(ShellFolder.ParseDisplayName(Parent, NIL,
           PWideChar(oleSubDir), Eaten, FolderID, Attr)) then
        try
          if Succeeded(ShellFolder.BindToObject(FolderID, NIL, IID_IShellFolder,
             pointer(SubFolder))) then
          try
            Count := 0;
            GetMem(ItemPIDLs, SizeOf(PItemIDList) * Items.Count);
            try
              for x := 0 to Items.Count - 1 do
              begin
{$IFDEF DFS_COMPILER_3_UP}
                oleFilename := Items[x];
{$ELSE}
                oleFilename := StringToOLEStr(Items[x]);
                if assigned(oleSubDir) then
{$ENDIF}
                try
{ 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(oleFilename), Eaten, ItemPIDLs^[Count], Attr)) then
{$IFDEF DFS_RESET_RANGE_CHECKING} {$R+} {$UNDEF DFS_RESET_RANGE_CHECKING} {$ENDIF}
                    Inc(Count);
                finally
{$IFNDEF DFS_NO_COM_CLEANUP}
                  SysFreeString(oleFilename);
{$ENDIF}
                end;
              end;

              Result := InvokeInterfaceElement('', SubFolder, ItemPIDLs^[0],
                 Attr, Cmd, Verb, Parent, Pos, Count);
{              Result := DisplayContextMenu(SubFolder, ItemPIDLs^[0], Attr, Parent,
                 Pos, Count);}
            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(ItemPIDLs^[x]);
{$IFDEF DFS_RESET_RANGE_CHECKING} {$R+} {$UNDEF DFS_RESET_RANGE_CHECKING} {$ENDIF}
              FreeMem(ItemPIDLs);
            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}
        SysFreeString(oleSubDir);
{$ENDIF}
      end;
    finally
{$IFNDEF DFS_NO_COM_CLEANUP}
      ShellFolder.Release; // Delphi 3 does this for you.
{$ENDIF}
    end;
  finally
{$IFDEF DFS_COMPILER_3_UP}
    ShellMalloc._Release;
{$ELSE}
    ShellMalloc.Release;
{$ENDIF}
  end;
end;


// Returns to the next ID in the given list of IDs
function NextPIDL(PIDL: PItemIDList): PItemIDList;
begin
  if PIDL.mkid.cb > 0 then
    Result := PItemIDList(Longint(PIDL) + PIDL.mkid.cb)
  else // At end of list.