显示多个文件的属性对话框

时间:2010-02-01 13:18:44  来源:第二电脑网  作者:第二电脑网

  第二电脑网导读:Windows 2000 or Higher, Shell32.dll version 5.0 or later }uses ActiveX, ShlObj, ComObj;function SHMultiFileProperties(pDataObj: IDataObject; Flag: DWORD): HRESULT;stdcall; external 'shell32.dll';function GetFileListDataObject(Files: TStrings): IDataObject;typePArrayOfPItemIDList = ^TArrayOfPItemIDList...
  正文:显示多个文件的属性对话框:

"显示多个文件的属性对话框"由第二电脑网原创提供,转载请注明:http://www.002pc.com/master/College/Language/Delphi/12707.html


关键字:

关于《显示多个文件的属性对话框》文章的评论


{ Copyright Kingron 2005 }
{ For Windows 2000 or Higher, Shell32.dll version 5.0 or later }

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;
    
    
    // Example:
// Beispiel:

    procedure TForm1.Button1Click(Sender: TObject);
    begin
      if OpenDialog1.Execute then
      Memo1.Lines.AddStrings(OpenDialog1.Files);
    end;
    
    procedure TForm1.Button2Click(Sender: TObject);
    begin
      ShowFileProperties(Memo1.Lines, 0);
    end;
站内搜索: 高级搜索

热门搜索: Windows style 系统 tr IP QQ CPU 安装 function 注册 if td