この発言は
#01290　アイクビー      さんのシェルのツリーを表示(1/2)
に対するコメントです





(続き)

//   *******************************************************************
//   アイコンのインデックスを設定する(リンク フォルダー)
//   *******************************************************************
     procedure SetIconIndexOfLinkFolder(
          fNode:    TTreeNode
     );
     var
          hRE: HResult;
          fSR: TStrRet;
          fII: PItemIDList;
          vEA: ULONG;
          vAT: ULONG;

     begin
          hRE := PTreeNodeData(Node.Data).fFolder.GetDisplayNameOf(
               PTreeNodeData(fNode.Data).fIDList, SHGDN_FORPARSING, fSR
          );
          if not (hRE = NOERROR) then begin
               ShowMessage(
                    'IShellFolder.GetDisplayNameOf: '+IntToHex(hRE, 8)
               );

               Exit;
          end;

          if not (fSR.uType = STRRET_WSTR) then begin
               ShowMessage(
                    'IShellFolder.GetDisplayNameOf: '
               +    'OLE文字列ではありません。('+IntToStr(fSR.uType)+')'
               );

               Exit;
          end;

          vEA  := 0;
          vAT  := 0;
          hRE  := FfFolder.ParseDisplayName(
               Handle, nil, fSR.pOleStr, vEA, fII, vAT
          );
          if not (hRE = NOERROR) then begin
               ShowMessage(
                    'IShellFolder.ParseDisplayName: '+IntToHex(hRE, 8)
               );

               Exit;
          end;
          try
               SetIconIndexOf(fNode, fII);

          finally
               FfMalloc.Free(fII);
          end;
     end;

//   *******************************************************************
//   アイコンのインデックスを設定する(仮想フォルダー)
//   *******************************************************************
     procedure SetIconIndexOfVirtualFolder(
          fNode:    TTreeNode
     );
     var
          fII: PItemIDList;
          iIS: Cardinal;
          iID: Cardinal;

          procedure MakeItemIDListOf(
               fTN: TTreeNode
          );
          begin
               iIS  := iIS + PTreeNodeData(fTN.Data).fIDList.mkid.cb;
               if Assigned(fTN.Parent) then begin
                    MakeItemIDListOf(fTN.Parent);
               end
               else begin
                    iIS  := iIS + SizeOf(fII.mkid.cb);
                    fII  := AllocMem(iIS);
               end;
               Move(
                    PTreeNodeData(fTN.Data).fIDList^,
                    PChar(fII)[iID],
                    PTreeNodeData(fTN.Data).fIDList.mkid.cb
               );
               iID  := iID + PTreeNodeData(fTN.Data).fIDList.mkid.cb;
          end;

     begin
          iIS  := 0;
          iID  := 0;
          MakeItemIDListOf(fNode);
          try
               PItemIDList(@PChar(fII)[iID]).mkid.cb   := 0;
               SetIconIndexOf(fNode, fII);

          finally
               FreeMem(fII);
          end;
     end;

//**********************************************************************
//   メイン
//**********************************************************************
var
     hRE: HRESULT;
     fEI: IEnumIDList;
     fII: PItemIDList;
     iII: ULONG;
     fSF: IShellFolder;
     fSR: TStrRet;
     vSR: string;
     vFA: ULONG;
     fTN: TTreeNode;
     fND: PTreeNodeData;

begin
     if Assigned(PTreeNodeData(Node.Data).fFolder) then begin
     //   フォルダー
          AllowExpansion := True;
          if PTreeNodeData(Node.Data).fExpand then begin
          //   展開済み
               Exit;
          end;
     end
     else begin
          AllowExpansion := False;

          Exit;
     end;
     PTreeNodeData(Node.Data).fExpand   := True;

     hRE  := PTreeNodeData(Node.Data).fFolder.EnumObjects(
          Handle,
          SHCONTF_FOLDERS
     or   SHCONTF_INCLUDEHIDDEN         // 隠しファイルも含める
     or   SHCONTF_NONFOLDERS,           // フォルダー以外も含める
          fEI
     );
     if not (hRE = NOERROR) then begin
          ShowMessage('IShellFolder.EnumObjects: '+IntToHex(hRE, 8));

          Exit;
     end;
     fEI._AddRef();
     try
          while (fEI.Next(1, fII, iII) = NOERROR) do begin
               hRE := PTreeNodeData(
                    Node.Data
               ).fFolder.GetDisplayNameOf(
                    fII, SHGDN_INFOLDER, fSR
               );
               if not (hRE = NOERROR) then begin
                    FfMalloc.Free(fII);
                    ShowMessage(
                         'IShellFolder.GetDisplayNameOf: '
                    +    IntToHex(hRE, 8)
                    );

                    Continue;
               end;

               case fSR.uType of
                    STRRET_WSTR: begin
                         vSR  := WideCharToString(fSR.pOleStr);
                    end;
                    STRRET_CSTR: begin
                         vSR  := string(fSR.cStr);
                    end;
                    STRRET_OFFSET: begin
                         vSR  := string(PChar(fII) + fSR.uOffset);
                    end;
                    else begin
                         FfMalloc.Free(fII);
                         ShowMessage(
                              'IShellFolder.GetDisplayNameOf: '
                         +    '不明な TStrRet.uType: '
                         +    IntToStr(fSR.uType)
                         );

                         Continue;
                    end;
               end;

               vFA  :=
                    SFGAO_LINK
               or   SFGAO_SHARE
               or   SFGAO_FILESYSTEM
               or   SFGAO_FILESYSANCESTOR
               or   SFGAO_FOLDER;
               hRE  := PTreeNodeData(Node.Data).fFolder.GetAttributesOf(
                    1, fII, vFA
               );
               if not (hRE = NOERROR) then begin
                    FfMalloc.Free(fII);
                    ShowMessage(
                         'IShellFolder.GetAttributesOf: '
                    +    IntToHex(hRE, 8)
                    );

                    Continue;
               end;

               New(fND);
               fND.fFolder    := nil;
               fND.fIDList    := fII;
               fND.fExpand    := False;

               fTN  := TreeView1.Items.AddChildObject(
                    Node, vSR, fND
               );

               if not ((vFA and SFGAO_FOLDER) = 0) then begin
                    if (PTreeNodeData(
                         Node.Data
                    ).fFolder.BindToObject(
                         fII, nil, IID_IShellFolder, fSF
                    ) = NOERROR) then begin
                         fSF._AddRef();
                         fND.fFolder         := fSF;
                         fTN.HasChildren     := True;
                    end
                    else begin
                    //   IShellFolder以外のフォルダー
                    //   IEなんかがこれのようです
                         fTN.HasChildren     := False;
                    end;
               end
               else begin
                    fTN.HasChildren     := False;
               end;

               if  not ((vFA and SFGAO_FILESYSTEM) = 0)
               and not ((vFA and SFGAO_FOLDER) = 0)
               and not ((vFA and SFGAO_LINK) = 0) then begin
               //   リンク フォルダー
               //   (フォルダーのショートカットではありません)
               //   Windows 2000の「近くのコンピュータ」とか
                    SetIconIndexOfLinkFolder(fTN);
               end
               else begin
                    if not SetIconIndex(fTN) then begin
                    //   仮想フォルダー
                    //   「ネットワーク全体」とか
                         SetIconIndexOfVirtualFolder(fTN);
                    end;
               end;

               case vFA and (SFGAO_SHARE or SFGAO_LINK) of
                    SFGAO_SHARE: begin
                         fTN.OverlayIndex    := 0;
                    end;
                    SFGAO_LINK: begin
                         if ((vFA and SFGAO_FOLDER) = 0) then begin
                              fTN.OverlayIndex    := 1;
                         end
                         else begin
                         //   リンク フォルダー
                         //   Windows 2000の「近くのコンピュータ」とか
                              fTN.OverlayIndex    := -1;
                         end;
                    end;
                    else begin
                         fTN.OverlayIndex    := -1;
                    end;
               end;
          end;

     finally
          fEI._Release();
     end;
end;

(ここまで)

アイクビー
 


Original document by アイクビー      氏 ID:(KHB01350)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。