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

解決

横山 2012-07-11 00:23:48 No: 42569

よろしくお願いします。
windows７ Delphi ６ personalです。
サンプルタブにあるTShelltreeviewを大変ありがたく利用しています。
win７のエクスプローラで表示している「ライブラリ」の下に
任意に登録されたフォルダのアドレスは
残念ながらShelltreeview1.Path で取得できません。
質問：
「ライブラリ」の直下のフォルダのアドレスを
コードで取得できる方法がありましたら教えていただけませんか。
お願いします。

monaa 2012-07-11 01:49:15 No: 42570

Google先生に「windows7 ライブラリパス」で聞くと
C:\Users\[ユーザー名]\AppData\Roaming\Microsoft\Windows\Libraries
だそうです。
http://queensryche.blog41.fc2.com/blog-entry-727.html

横山 2012-07-11 04:06:24 No: 42571

monaaさんありがとうございました。解決しました。
win７導入以来永く悩んでいた問題で自分なりにくぐったのですが
そのものズバリですね。くぐる能力も実力の内。
もっとGoogleさんを信頼しなければと考えさせられました。
まだ特殊フォルダの取得ガイドなどで見かけません。
助かりました。
では。

au 2012-07-11 04:24:56 No: 42572

フォームにbutton1とlistbox1があるとして、以下のような感じ？
D6だと色々定義が足りない気がしますが

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

  pItem: IShellItem;
  pItem2: IShellItem;
  Fetched: Longint;
  ppszName: PWideChar;
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);
          pItem2 := Nil;
        end;
      until hr = S_FALSE;
      penumShellItems := Nil;
    end;
    pItem := Nil;
  end;
end;

横山 2012-07-11 08:46:40 No: 42573

ａｕさん、コードまで書いて頂きありがとうございます。
ご推察通りＤ６personalでは
IEnumShellItems
IShellItem
SHCreateItemInKnownFolder(
FOLDERID_Libraries
IID_IShellItem
BHID_EnumItems
IID_IEnumShellItems
SIGDN_NORMALDISPLAY
が未定義の識別子になります。新しいＩＤＥを買えたとき役立たせます。
解決方法として
起動時にShelltreeviewの「ライブラリ」のアドレスが判れば
子ノードを調べて子ノードの名前とアドレスをStringlistなどに格納して
親ノードがライブラリのときはリストから子のアドレスを引き出してみようと
思っています。
初心者ではこの程度しか思いつきません。
ありがとうございました。
では。

au 2012-07-11 17:04:16 No: 42574

「ライブラリ」の直下は取れるのかなーと思うのですが、その下例えば「ドキュメント」だと「ログインユーザーのドキュメント」と「パブリックのドキュメント」があるんですがこれは、IShellLibraryインターフェース経由でないと「ドキュメント」の下にあるフォルダが何かっていうのは判らないかも知れません。

横山 2012-07-11 20:41:55 No: 42575

ａｕさん、レスありがとうございます。
そうですか・・・・
ＭＳさんもエクスプローラーにいろいろ仕掛けを作ってくれて
困りますね。
ファイルをいじるプログラミングは第一章ですから。
ということはフォルダツリーは避けて通れないです。
何かいいコンポーネントでもあれば助かるのですが。

７になってから、エクスプローラーが遅いし、バグはあるし、
使いにくいし、プログラミングを目指すものには酷な環境です。

勉強になりますから、どうしてだめかという推測がまだ出来ない能力なので
無駄ではないと思います。だめもとでやってみます。
ありがとうございました。

横山 2012-07-11 21:37:16 No: 42576

自己レスです。
ａｕさん、やっぱりだめでした。
Libraries直下のフォルダ群として展開は出来ますが
考えてみると、直下のフォルダは好き勝手に登録したのであって
実アドレスは別ですよね。（ツリー構造の根底を揺るがす問題？(^_^;)）
Librariesのアドレスとは何の関わり合いもない。
従って特殊なコードでないと取れないようです。
勘違いしていました。
ではご報告まで。

au 2012-07-11 22:54:58 No: 42577

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;

横山 2012-07-11 23:46:19 No: 42578

ａｕさん感謝します。
今回は”いった〜っ”と思ったのですが
procedure TForm1.GetFoldersInLibrary(pLibrary: IShellLibrary);

のIShellLibraryだけが未定義になります。
この辺になると私の脳みそはオーバーフローです。
何か手があるでしょうか。
では。

Mr.XRAY 2012-07-12 01:55:27 No: 42579

こんにちは，Mr.XRAYです．
解決策ではありません．情報です．

>のIShellLibraryだけが未定義になります。

これは最初の「未定義」だと思います．

IShellLibrary, SHCreateItemInKnownFolder 等は，Delphi 2010から実装されたものです．
FOLDERID_Libraries のGUIDは，MSDNで調べることができますが，
それ以外，つまり，Delphi 2010 で実装された関数やインターフェイスを実装するには，
相当の覚悟が必要と思われす．

では，がんばってください．

横山 2012-07-12 05:07:02 No: 42580

auさん、
とりあえずこのようになりました。急ごしらえでテストOKならもうちょっと整理して。
Libraries_TBLはフォルダパスの格納、起動時終了時に作成、後始末をする。

procedure TForm1.ShellTreeView1Click(Sender: TObject);
var Path:string;
begin
    if shellTreeView1.Selected=nil then exit;
    Path:=GetFolderPath(ShellTreeView1.Path);
    if DirectoryExists(Path)=true then
     begin
        webbrowser1.Navigate(Path)
    end
    else
    begin
  //最初から中を展開する気がないものは除外する
        if AnsiPos(Path,'マイコンピューターライブラリホームグループ')>0 then exit;
        showmessage(Path+#13#10+'を登録してください');
    end;
end;

function TForm1.GetFolderPath(Path:string):string;
var
     PersonalPath:string;
     i,count:integer;
    str,str2,ClickPath:string;
    cp:integer;
    StringList2:TStringList;
begin
    result:=Path;
    if DirectoryExists(Path)=true then
    begin
        result:=Path;
        exit;
    end
    else
    begin
        //最初からパスが不要と思われて  破棄する  ノード
        if AnsiPos(Path,'マイコンピューターライブラリホームグループ')>0 then exit;

        PersonalPath:= GetSpecialFolder(CSIDL_PERSONAL);
        //win7 か  XPを判定する方法を知らないのでローテクで
        //ＸＰと７で違うのでやっかいだった
        count:=0;
        for i:=1 to Length(PersonalPath) do
        if Copy(PersonalPath,i,1)='\' then Inc(count);

        if count>=3 then
            PersonalPath:=ExtractFilePath(PersonalPath)//'Documentsを捨てる
        else
            PersonalPath:=PersonalPath+'\';

    //ほぼ、そうなっているだろうなのとｘｐの場合を想定して
        if (Path='ドキュメント') or (Path='マイドキュメント')      then
        begin
            result:=PersonalPath+'Documents';
            if DirectoryExists(result)=true then exit;
        end
        else
        if (Path='ピクチャ') or (Path='マイピクチャ')              then
        begin
             result:=PersonalPath+'Pictures';
             if DirectoryExists(result)=true then exit;
        end
        else
        if (Path='ミュージック') or (Path='マイミュージック')
        or (AnsiPos('music',Path)>0) or (AnsiPos('Music-',Path)>0) then
        begin
            result:=PersonalPath+'Music';
            if DirectoryExists(result)=true then exit;
        end
        else
        if (Path='ビデオ') or (Path='マイビデオ')
        or (AnsiPos('Videos',Path)>0) or (AnsiPos('Videos-',Path)>0) then
        begin
            result:=PersonalPath+'Videos';
            if DirectoryExists(result)=true then exit;
        end;

        //元々ライブラリに登録するのは任意の手動登録だから
        //専用テーブルに名前が検索してなければ登録するようにした。
        //ライブラリーの名前は任意に変更できるから元フォルダ名と
        //同期しない可能性があるので名前で検索する

        StringList2:=TStringList.Create;
        try
            ClickPath:='\'+Path;
            for i:=0 to Libraries_TBL.Count-1 do
            begin        //未登録である
                StringList2.CommaText:= Libraries_TBL.Strings[i];
                str:=StringList2.Strings[1];
                //前半部分が同じ可能性があるので長さまでチェックする
                cp:=LastDelimiter('\', str);
                str2:=Copy(str,cp, Length(str));

                if ClickPath=str2 then
                begin  //頭だけでないか検査する
                    result:=str;
                    exit;
                end;
            end;
            //なければパスを登録する登録する
            if SelectDirectory('フォルダを指定します','', str) then
            begin
                Libraries_TBL.Add(AnsiQuotedStr(ClickPath,'"')+','+AnsiQuotedStr(str,'"') );
                if DirectoryExists(str)=true then
                begin
                    result:= str;
                end;
            end;
        finally
             StringList2.Free;
        end;
   end;
end;