win７のエクスプローラ表示の「ライブラリ」直下のフォルダのアドレスの取得は (ID：42577)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

XE2でしか確認してないですが、一応こんな感じで取得出来ます。

XE2の標準のSHLoadLibraryFromItemだとエラーが出るんで下記のように変更。
IShellLibraryの取得は、Library下のアイテム列挙中のIShellitemを利用してます。

function SHLoadLibraryFromItem(const psiLibrary: IShellItem; grfMode: DWORD;
  const riid: TIID; var ppv: Pointer): HResult;
var
  plib: IShellLibrary;
begin
  ppv := nil;
  Result := CoCreateInstance(CLSID_ShellLibrary, nil, CLSCTX_INPROC_SERVER,
    IID_IShellLibrary, plib);
  if Succeeded(Result) then
  begin
    Result := plib.LoadLibraryFromItem(psiLibrary, grfMode);
    if Succeeded(Result) then
    begin
      Result := plib.QueryInterface(riid, ppv);
    end;
    plib := Nil;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  penumShellItems: IEnumShellItems;
  hr: HResult;

pItem: IShellItem;
  pItem2: IShellItem;
  Fetched: Longint;
  ppszName: PWideChar;

pShellLibrary: IShellLibrary;
begin
  hr := SHCreateItemInKnownFolder(FOLDERID_Libraries, 0, Nil, IID_IShellItem, pItem);
  if Succeeded(hr) then
  begin
    hr := pItem.BindToHandler(Nil, BHID_EnumItems, IID_IEnumShellItems, penumShellItems);
    if Succeeded(hr) then
    begin
      repeat
        hr := penumShellItems.Next(1, pItem2, @Fetched);
        if Failed(hr) then break;
        if Fetched > 0 then
        begin
          pItem2.GetDisplayName(SIGDN_NORMALDISPLAY, ppszName);
          ListBox1.AddItem(ppszName, Nil);
          CoTaskMemFree(ppszName);

//追加
          SHLoadLibraryFromItem(pItem2, STGM_READ, IID_IShellLibrary, Pointer(pShellLibrary));
          GetFoldersInLibrary(pShellLibrary);

pItem2 := Nil;
        end;
      until hr = S_FALSE;
      penumShellItems := Nil;
    end;
    pItem := Nil;
  end;
end;

procedure TForm1.GetFoldersInLibrary(pLibrary: IShellLibrary);
var
  penumShellItems: IEnumShellItems;
  psiaFolders: IShellItemArray;
  hr: HResult;

pItem: IShellItem;
  pItem2: IShellItem;
  Fetched: Longint;
  ppszName: PWideChar;
  dwFolderCount: DWORD;
begin

hr := pLibrary.GetFolders(LFF_ALLITEMS, IID_IShellItemArray, psiaFolders);
  if Succeeded(hr) then
  begin
    psiaFolders.GetCount(dwFolderCount);
    if dwFolderCount=0 then Exit;
    psiaFolders.EnumItems(penumShellItems);

repeat
      hr := penumShellItems.Next(1, pItem2, @Fetched);
      if Failed(hr) then break;
      if Fetched > 0 then
      begin
        pItem2.GetDisplayName(SIGDN_NORMALDISPLAY, ppszName);
        ListBox1.AddItem(ppszName, Nil);
        CoTaskMemFree(ppszName);
        pItem2 := Nil;
      end;
    until hr = S_FALSE;
    penumShellItems := Nil;
  end;
end;

←解決時は質問者本人がここをチェックしてください。

戻る