如何通过ShellExecuteEx打开字体文件?

时间:2012-11-28 07:00:43

标签: delphi windows-shell

我得到一个名为FontPIDL

的字体文件的绝对PIDL

我使用此代码打开它:     VAR       ShExeInfo:SHELLEXECUTEINFO;

begin
    ZeroMemory(@ShExeInfo, SizeOf(ShExeInfo));

    ShExeInfo.cbSize := SizeOf(ShExeInfo);
    ShExeInfo.lpVerb := 'Open';
    ShExeInfo.lpIDList := FontPIDL;
    ShExeInfo.nShow := SW_SHOWNORMAL;
    ShExeInfo.fMask := SEE_MASK_IDLIST;
end;    

收到错误:The parameter is incorrect

我想知道如何修复它?是我想念的一些参数吗?

更新:

我如何得到字体文件绝对PIDL:

var
  psfDeskTop : IShellFolder;
  psfFont : IShellFolder;
  pEnumList : IEnumIdList;
  pidFont : PItemIdList;
  pidChild : PItemIdList;
  pidAbFont : PItemIdList; 
  FontPath : array[0..MAX_PATH - 1] of Char;
  pchEaten, dwAttributes, ItemsFetched : ULONG;

begin
  FillChar(FontPath, sizeof(FontPath), #0);
  SHGetSpecialFolderPath(0, FontPath, CSIDL_FONTS, False);
  SHGetDesktopFolder(psfDeskTop);
  psfDeskTop.ParseDisplayName(0, nil, FontPath, pchEaten, pidFont,
    dwAttributes);
  psfDeskTop.BindToObject(pidFont, nil, IID_IShellFolder, psfFont);
  psfFont.EnumObjects(0, SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or
    SHCONTF_INCLUDEHIDDEN, pEnumList);
  ItemsFetched := 0;
  while pEnumList.Next(1, pidChild, ItemsFetched) = NO_ERROR do
  begin
    pidAbFont := ILCombine(pidFont , pidChild);
    ///... do something
  end;

end;

3 个答案:

答案 0 :(得分:5)

省略lpVerb分配使代码有效:

begin
    ZeroMemory(@ShExeInfo, SizeOf(ShExeInfo));
    ShExeInfo.cbSize := SizeOf(ShExeInfo);
    // ShExeInfo.lpVerb := 'Open'; will be fail . 
    // use ShExeInfo.lpVerb := '' or ZeroMemory(@ShExeInfo, SizeOf(ShExeInfo)); before
    ShExeInfo.lpIDList := FontPIDL;
    ShExeInfo.nShow := SW_SHOWNORMAL;
    ShExeInfo.fMask := SEE_MASK_IDLIST;
end;    

答案 1 :(得分:5)

删除ShExeInfo.lpVerb := 'Open';语句有效,但没有其他人说过它的工作原理。原因是因为默认情况下字体文件没有注册"Open"个动词。通过将lpVerb设置为nil,您允许ShellExecuteEx()执行文件类型的实际默认动词,无论它是什么。根据{{​​3}}:

  

lpVerb

     

类型:LPCTSTR

     

一个字符串,称为动词,指定要执行的操作。可用动词集取决于特定文件或文件夹。通常,对象快捷菜单中的可用动作是可用动词。 此参数可以为NULL,在这种情况下,如果可用,则使用默认动词。如果不是,则使用“开放”动词。如果两个动词都不可用,则系统使用注册表中列出的第一个动词。

答案 2 :(得分:1)

我给你做了一个样品:

var
    ShExeInfo: TShellExecuteInfo;
    ExecuteFile: string;
begin
    ZeroMemory(@ShExeInfo, SizeOf(ShExeInfo));
    ExecuteFile:='D:\SoftWare\font\BDavat.ttf';
    FillChar(ShExeInfo, SizeOf(ShExeInfo), 0) ;
    ShExeInfo.cbSize := SizeOf(TShellExecuteInfo) ;
    with ShExeInfo do
    begin
      //lpVerb := 'Open';
      fMask := SEE_MASK_NOCLOSEPROCESS;
      Wnd := Application.Handle;
      lpFile := PWideChar(ExecuteFile) ;
      nShow := SW_SHOWNORMAL;
    end;
    ShellExecuteEx(@ShExeInfo) ;
end;

获取它们的路径的函数:

uses
  ShlObj, ActiveX;

const
  CSIDL_FLAG_CREATE = $8000;
  CSIDL_ADMINTOOLS = $0030;
  CSIDL_ALTSTARTUP = $001D;
  CSIDL_APPDATA = $001A;
  CSIDL_BITBUCKET = $000A;
  CSIDL_CDBURN_AREA = $003B;
  CSIDL_COMMON_ADMINTOOLS = $002F;
  CSIDL_COMMON_ALTSTARTUP = $001E;
  CSIDL_COMMON_APPDATA = $0023;
  CSIDL_COMMON_DESKTOPDIRECTORY = $0019;
  CSIDL_COMMON_DOCUMENTS = $002E;
  CSIDL_COMMON_FAVORITES = $001F;
  CSIDL_COMMON_MUSIC = $0035;
  CSIDL_COMMON_PICTURES = $0036;
  CSIDL_COMMON_PROGRAMS = $0017;
  CSIDL_COMMON_STARTMENU = $0016;
  CSIDL_COMMON_STARTUP = $0018;
  CSIDL_COMMON_TEMPLATES = $002D;
  CSIDL_COMMON_VIDEO = $0037;
  CSIDL_CONTROLS = $0003;
  CSIDL_COOKIES = $0021;
  CSIDL_DESKTOP = $0000;
  CSIDL_DESKTOPDIRECTORY = $0010;
  CSIDL_DRIVES = $0011;
  CSIDL_FAVORITES = $0006;
  CSIDL_FONTS  = $0014;
  CSIDL_HISTORY = $0022;
  CSIDL_INTERNET = $0001;
  CSIDL_INTERNET_CACHE = $0020;
  CSIDL_LOCAL_APPDATA = $001C;
  CSIDL_MYDOCUMENTS = $000C;
  CSIDL_MYMUSIC = $000D;
  CSIDL_MYPICTURES = $0027;
  CSIDL_MYVIDEO = $000E;
  CSIDL_NETHOOD = $0013;
  CSIDL_NETWORK = $0012;
  CSIDL_PERSONAL = $0005;
  CSIDL_PRINTERS = $0004;
  CSIDL_PRINTHOOD = $001B;
  CSIDL_PROFILE = $0028;
  CSIDL_PROFILES = $003E;
  CSIDL_PROGRAM_FILES = $0026;
  CSIDL_PROGRAM_FILES_COMMON = $002B;
  CSIDL_PROGRAMS = $0002;
  CSIDL_RECENT = $0008;
  CSIDL_SENDTO = $0009;
  CSIDL_STARTMENU = $000B;
  CSIDL_STARTUP = $0007;
  CSIDL_SYSTEM = $0025;
  CSIDL_TEMPLATES = $0015;
  CSIDL_WINDOWS = $0024;

function GetShellFolder(CSIDL: integer): string;
var
  pidl                   : PItemIdList;
  FolderPath             : string;
  SystemFolder           : Integer;
  Malloc                 : IMalloc;
begin
  Malloc := nil;
  FolderPath := '';
  SHGetMalloc(Malloc);
  if Malloc = nil then
  begin
    Result := FolderPath;
    Exit;
  end;
  try
    SystemFolder := CSIDL;
    if SUCCEEDED(SHGetSpecialFolderLocation(0, SystemFolder, pidl)) then
    begin
      SetLength(FolderPath, max_path);
      if SHGetPathFromIDList(pidl, PChar(FolderPath)) then
      begin
        SetLength(FolderPath, length(PChar(FolderPath)));
      end;
    end;
    Result := FolderPath;
  finally
    Malloc.Free(pidl);
  end;
end;

如何使用:

ShowMessage(GetShellFolder(CSIDL_FONTS));

测试它,我希望能帮到你......