Show Multiple File Properties

Der folgende Code zeigt, wie man die Eigenschaften vieler Dateien im gesamten anzeigen lassen kann. Als Erstes werden die Dateien in ein Memo geladen und dann ausgewertet.

uses ActiveX, ShlObj, ComObj

//

function SHMultiFileProperties(pDataObj: IDataObject; Flag: DWORD): HRESULT;
  stdcall; external 'shell32.dll';

function GetFileListDataObject(Files: TStrings): IDataObject;
type
  PArrayOfPItemIDList = ^TArrayOfPItemIDList;
  TArrayOfPItemIDList = array[0..0] of PItemIDList;
var
  Malloc: IMalloc;
  Root: IShellFolder;
  p: PArrayOfPItemIDList;
  chEaten, dwAttributes: ULONG;
  i, FileCount: Integer;
begin
  Result := nil;
  FileCount := Files.Count;
  if FileCount = 0 then Exit;

  OleCheck(SHGetMalloc(Malloc));
  OleCheck(SHGetDesktopFolder(Root));
  p := AllocMem(SizeOf(PItemIDList) * FileCount);
  try
    for i := 0 to FileCount - 1 do
      try
        if not (DirectoryExists(Files[i]) or FileExists(Files[i])) then Continue;
        OleCheck(Root.ParseDisplayName(GetActiveWindow,
          nil,
          PWideChar(WideString(Files[i])),
          chEaten,
          p^[i],
          dwAttributes));
      except
      end;
    OleCheck(Root.GetUIObjectOf(GetActiveWindow,
      FileCount,
      p^[0],
      IDataObject,
      nil,
      Pointer(Result)));
  finally
    for i := 0 to FileCount - 1 do
    begin
      if p^[i] <> nil then Malloc.Free(p^[i]);
    end;
    FreeMem(p);
  end;
end;

procedure ShowFileProperties(Files: TStrings; aWnd: HWND);
type
  PArrayOfPItemIDList = ^TArrayOfPItemIDList;
  TArrayOfPItemIDList = array[0..0] of PItemIDList;
var
  Data: IDataObject;
begin
  if Files.Count = 0 then Exit;
  Data := GetFileListDataObject(Files);
  SHMultiFileProperties(Data, 0);
end;

// Dateien laden
procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    Memo1.Lines.AddStrings(OpenDialog1.Files);
end;

// Eigenschaften auswerten
procedure TForm1.Button2Click(Sender: TObject);
begin
  ShowFileProperties(Memo1.Lines, 0);
end;