itemprop.pas

最好的局域网搜索软件

  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.
    Result := NIL;
end;

function CopyPidl(APidl: PItemIDList; ShellMalloc: IMalloc): PItemIDList;
var
  CB: UINT;
begin
  Result := NIL;
  CB := APidl.mkid.cb + SizeOf(APidl.mkid.cb);
  if NextPidl(APidl)^.mkid.cb <> 0 then
    exit;
  Result := ShellMalloc.Alloc(CB);
  if Result <> NIL then
  begin
    FillChar(Result^, CB, #0); // Initialize the memory to zero
    Move(APidl^, Result^, APidl.mkid.cb);
  end;
end;

function GetPIDLAndShellFolder(Path: string;
   {$IFDEF DFS_COMPILER_4_UP} out {$ELSE} var {$ENDIF} Folder: IShellFolder;
   var PIDL: PItemIDList; ShellMalloc: IMalloc;
   {$IFDEF DFS_DELPHI} Parent: HWND {$ELSE} Parent: pointer {$ENDIF}): boolean;
var
  DF: IShellFolder;
  // translate for D2/D3/C1/C3!!!!
{$IFDEF DFS_COMPILER_3_UP}
  WidePath: WideString;
{$ELSE}
  WidePath: PWideChar;
{$ENDIF}
  Eaten: ULONG;
  pidlNext,
  pidlLast,
  pidlFull: PItemIDList;
  Attrs: ULONG;
  CurFolder, NextFolder: IShellFolder;
  SaveCB: UINT;

begin
  Result := FALSE;
  pidlFull := NIL;
  if Succeeded(SHGetDesktopFolder(DF)) then
  begin
{$IFDEF DFS_COMPILER_3_UP}
    WidePath := Path;
{$ELSE}
    WidePath := StringToOLEStr(Path);
    if assigned(WidePath) then
{$ENDIF}
    try
      if Succeeded(DF.ParseDisplayName({$IFDEF DFS_DELPHI} Parent, {$ELSE}
         HWND(Parent), {$ENDIF} NIL, PWideChar(WidePath), Eaten,
         pidlFull, Attrs)) then
      begin
        if Succeeded(DF.QueryInterface(IID_IShellFolder, CurFolder)) then
        begin
          pidlNext := NextPidl(pidlFull);
          pidlLast := pidlFull;
          while pidlNext^.mkid.cb <> 0 do
          begin
            Result := TRUE;
            SaveCB := pidlNext^.mkid.cb;
            pidlNext^.mkid.cb := 0;
            if not Succeeded(CurFolder.BindToObject(pidlLast, NIL, IID_IShellFolder,
               pointer(NextFolder))) then
            begin
              Result := FALSE;
              break;
            end;
            pidlNext^.mkid.cb := SaveCB;
            CurFolder := NextFolder;
            pidlLast := pidlNext;
            pidlNext := NextPidl(pidlNext);
          end;
          PIDL := CopyPidl(pidlLast, ShellMalloc);
          Folder := CurFolder;
        end;
      end;
    finally
{$IFNDEF DFS_NO_COM_CLEANUP}
      SysFreeString(WidePath);
{$ENDIF}
    end;
  end;
  if pidlFull <> NIL then
    ShellMalloc.Free(pidlFull);
end;


{$IFDEF DFS_COMPILER_4_UP}
function DisplayPropertiesDialog(const Filename: string; Parent: DFS_HWND): boolean;
var
  Dummy: PItemIDList;
begin
  Dummy := NIL;
  Result := InvokeInterfaceElement(Filename, NIL, Dummy, 0, icProperties, '',
     HWND(Parent), Point(0,0), 1);
end;

function DisplayPropertiesDialog(const Directory: string; Items: TStringList;
   Parent: DFS_HWND): boolean; overload;
begin
  Result := InvokeListInterfaceElement(Directory, Items, HWND(Parent), Point(0,0),
     icProperties, '');
end;

function DisplayPropertiesDialog(AParent: IShellFolder; var APIDL: PItemIDList;
   Attr: ULONG; Parent: DFS_HWND; PidlCount: integer): boolean;
begin
  Result := InvokeInterfaceElement('', AParent, APIDL, Attr, icProperties, '',
     HWND(Parent), Point(0,0), PidlCount);
end;

{$ELSE}

function DisplayPropertiesDialog(const Filename: string;
   Parent: DFS_HWND): boolean;
var
  Dummy: PItemIDList;
begin
  Dummy := NIL;
  Result := InvokeInterfaceElement(Filename, NIL, Dummy, 0, icProperties, '',
     HWND(Parent), Point(0,0), 1);
end;

function DisplayPropertiesDialogList(const Directory: string; Items: TStringList;
   Parent: DFS_HWND): boolean;
begin
  Result := InvokeListInterfaceElement(Directory, Items,
     HWND(Parent), Point(0,0), icProperties, '');
end;

function DisplayPropertiesDialogPIDL(AParent: IShellFolder; var APIDL: PItemIDList;
   Attr: ULONG; Parent: DFS_HWND; PidlCount: integer): boolean;
begin
  Result := InvokeInterfaceElement('', AParent, APIDL, Attr, icProperties, '',
     HWND(Parent), Point(0,0), PidlCount);
end;
{$ENDIF}


{$IFDEF DFS_COMPILER_4_UP}

function DisplayContextMenu(const Filename: string; Parent: DFS_HWND;
   Pos: TPoint; ShowRename: boolean; var RenameSelected: boolean): boolean;
var
  Dummy: PItemIDList;
begin
  Dummy := NIL;
  g_ShowRename := ShowRename;
  Result := InvokeInterfaceElement(Filename, NIL, Dummy, 0, icContextMenu, '',
     HWND(Parent), Pos, 1);
  RenameSelected := g_RenameSelected;
end;

function DisplayContextMenu(const Directory: string; Items: TStringList;
   Parent: DFS_HWND; Pos: TPoint; ShowRename: boolean;
   var RenameSelected: boolean): boolean; overload;
begin
  g_ShowRename := ShowRename;
  Result := InvokeListInterfaceElement(Directory, Items, HWND(Parent), Pos,
     icContextMenu, '');
  RenameSelected := g_RenameSelected;
end;

function DisplayContextMenu(AParent: IShellFolder; var APIDL: PItemIDList;
   Attr: ULONG; Parent: DFS_HWND; Pos: TPoint; PidlCount: integer;
   ShowRename: boolean; var RenameSelected: boolean): boolean;
begin
  g_ShowRename := ShowRename;
  Result := InvokeInterfaceElement('', AParent, APIDL, Attr, icContextMenu, '',
     HWND(Parent), Pos, PidlCount);
  RenameSelected := g_RenameSelected;
end;

{$ELSE}

function DisplayContextMenu(const Filename: string; Parent: DFS_HWND;
   Pos: TPoint; ShowRename: boolean; var RenameSelected: boolean): boolean;
var
  Dummy: PItemIDList;
begin
  g_ShowRename := ShowRename;
  Dummy := NIL;
  Result := InvokeInterfaceElement(Filename, NIL, Dummy, 0, icContextMenu, '',
     HWND(Parent), Pos, 1);
  RenameSelected := g_RenameSelected;
end;

function DisplayContextMenuList(const Directory: string; Items: TStringList;
   Parent: DFS_HWND; Pos: TPoint; ShowRename: boolean;
   var RenameSelected: boolean): boolean;
begin
  g_ShowRename := ShowRename;
  Result := InvokeListInterfaceElement(Directory, Items,
     HWND(Parent), Pos, icContextMenu, '');
  RenameSelected := g_RenameSelected;
end;

function DisplayContextMenuPIDL(AParent: IShellFolder; var APIDL: PItemIDList;
   Attr: ULONG; Parent: DFS_HWND; Pos: TPoint; PidlCount: integer;
   ShowRename: boolean; var RenameSelected: boolean): boolean;
begin
  g_ShowRename := ShowRename;
  Result := InvokeInterfaceElement('', AParent, APIDL, Attr, icContextMenu, '',
     HWND(Parent), Pos, PidlCount);
  RenameSelected := g_RenameSelected;
end;
{$ENDIF}

{$IFDEF DFS_COMPILER_4_UP}
function PerformDefaultAction(const Filename: string; Parent: DFS_HWND): boolean;
var
  Dummy: PItemIDList;
begin
  Dummy := NIL;
  Result := InvokeInterfaceElement(Filename, NIL, Dummy, 0, icDefaultAction, '',
     HWND(Parent), Point(0,0), 1);
end;

function PerformDefaultAction(const Directory: string; Items: TStringList;
   Parent: DFS_HWND): boolean; overload;
begin
  Result := InvokeListInterfaceElement(Directory, Items, HWND(Parent),
     Point(0,0), icDefaultAction, '');
end;

function PerformDefaultAction(AParent: IShellFolder; var APIDL: PItemIDList;
   Attr: ULONG; Parent: DFS_HWND; PidlCount: integer): boolean;
begin
  Result := InvokeInterfaceElement('', AParent, APIDL, Attr, icDefaultAction,
     '', HWND(Parent), Point(0,0), PidlCount);
end;
{$ELSE}

function PerformDefaultAction(const Filename: string; Parent: DFS_HWND): boolean;
var
  Dummy: PItemIDList;
begin
  Dummy := NIL;
  Result := InvokeInterfaceElement(Filename, NIL, Dummy, 0, icDefaultAction, '',
     HWND(Parent), Point(0,0), 1);
end;

function PerformDefaultActionList(const Directory: string; Items: TStringList;
   Parent: DFS_HWND): boolean;
begin
  Result := InvokeListInterfaceElement(Directory, Items,
     HWND(Parent), Point(0,0), icDefaultAction, '');
end;

function PerformDefaultActionPIDL(AParent: IShellFolder; var APIDL: PItemIDList;
   Attr: ULONG; Parent: DFS_HWND; PidlCount: integer): boolean;
begin
  Result := InvokeInterfaceElement('', AParent, APIDL, Attr, icDefaultAction,
     '', HWND(Parent), Point(0,0), PidlCount);
end;
{$ENDIF}


{$IFDEF DFS_COMPILER_4_UP}
function PerformVerb(const Verb, Filename: string; Parent: DFS_HWND): boolean;
var
  Dummy: PItemIDList;
begin
  Dummy := NIL;
  Result := InvokeInterfaceElement(Filename, NIL, Dummy, 0, icVerb, Verb,
     HWND(Parent), Point(0,0), 1);
end;

function PerformVerb(const Verb, Directory: string; Items: TStringList;
   Parent: DFS_HWND): boolean;
begin
  Result := InvokeListInterfaceElement(Directory, Items, HWND(Parent),
     Point(0,0), icVerb, Verb);
end;

function PerformVerb(const Verb: string; AParent: IShellFolder;
   var APIDL: PItemIDList; Attr: ULONG; Parent: DFS_HWND;
   PidlCount: integer): boolean;
begin
  Result := InvokeInterfaceElement('', AParent, APIDL, Attr, icVerb, Verb,
     HWND(Parent), Point(0,0), PidlCount);
end;

{$ELSE}

function PerformVerb(const Verb, Filename: string;
   Parent: DFS_HWND): boolean;
var
  Dummy: PItemIDList;
begin
  Dummy := NIL;
  Result := InvokeInterfaceElement(Filename, NIL, Dummy, 0, icVerb, Verb,
     HWND(Parent), Point(0,0), 1);
end;

function PerformVerbList(const Verb, Directory: string; Items: TStringList;
   Parent: DFS_HWND): boolean;
begin
  Result := InvokeListInterfaceElement(Directory, Items,
     HWND(Parent), Point(0,0), icVerb, Verb);
end;

function PerformVerbPIDL(const Verb: string; AParent: IShellFolder;
   var APIDL: PItemIDList; Attr: ULONG; Parent: DFS_HWND; 
   PidlCount: integer): boolean;
begin
  Result := InvokeInterfaceElement('', AParent, APIDL, Attr, icVerb, Verb,
     HWND(Parent), Point(0,0), PidlCount);
end;
{$ENDIF}


initialization
  OLEInitialize(NIL);
finalization
  OLEUninitialize;
end.