unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ShlObj, ShellAPI, ComObj, ActiveX, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel2: TPanel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Panel3: TPanel;
    Panel1: TPanel;
    Edit1: TEdit;
    TreeView1: TTreeView;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure TreeView1Deletion(Sender: TObject; Node: TTreeNode);
    procedure TreeView1Edited(Sender: TObject; Node: TTreeNode; var S: string);
    procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
    procedure TreeView1Collapsed(Sender: TObject; Node: TTreeNode);
    procedure TreeView1DblClick(Sender: TObject);
    procedure TreeView1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure TreeView1Changing(Sender: TObject; Node: TTreeNode;
      var AllowChange: Boolean);
  private
    { Private 宣言 }
    FImageHandle     : THandle;
    FshFolderDesktop : IShellFolder;
    FpidlDesktop     : PItemIDList;
    FpidlRoot        : PItemIDList;
    FNodeRoot        : TTreeNode;
    FBaseFolder      : String;
    function SetRootNode(pidl: PItemIDList): Boolean;
    function ExpandFolderTreeFromNode(ExpandNode:TTreeNode): Boolean;
    procedure SetIconToTreeViewNode(ANode: TTreeNode;
      AShellFolder: IShellFolder2; pidlFull, pidl: PItemIDList);
  public
    { Public 宣言 }
    function GetFullPathFromTreeNode(Node: TTreeNode): String;
    function GetFullPathFromTreeNodeEx(Node: TTreeNode): String;
  end;

var
  Form1: TForm1;

implementation

uses CommCtrl, FileCtrl, CSIDL_ListFormUnit;

{$R *.dfm}

//-----------------------------------------------------------------------------
//  フォルダツリーソートのコールバック関数
//  TTreeViewのAlphaSortではエクスプローラと同じ表示順とはならない．
//-----------------------------------------------------------------------------
function CustomSortFolderTree(Node1, Node2: TTreeNode; ParamSort: Integer):
  Integer; stdcall;
begin
  Result := SHORT($FFFF and IShellFolder2(ParamSort).
                            CompareIDs(0, Node1.Data, Node2.Data));
end;

//=============================================================================
//  テスト用ボタン
//  デスクトップの項目識別子は，本フォームのOnShowで取得済み
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  SetRootNode(FpidlDesktop);
end;

//=============================================================================
//  テスト用ボタン
//  [特殊フォルダ]のファイルをリスト
//  CSIDLの一覧フォームを表示して，そこから選択する
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  AIndex      : Integer;
  CSIDL_Value : Integer;
  pidl        : PItemIDList;
begin
  pidl := nil;
  //CSIDL値リストを表示するフォームを作成
  CSIDL_ListForm := TCSIDL_ListForm.Create(Self);

  try
    if CSIDL_ListForm.ShowModal = mrOk then begin
      Update;
      AIndex      := CSIDL_ListForm.ListBox1.ItemIndex;
      CSIDL_Value := Integer(CSIDL_ListForm.ListBox1.Items.Objects[AIndex]);

      SHGetSpecialFolderLocation(0, CSIDL_Value, pidl);
      if pidl <> nil then begin
        SetRootNode(pidl);
        CoTaskMemFree(pidl);
      end else begin
        MessageBox(0, '取得できませんでした．', '結果', MB_OK);
      end;
    end;
  finally
    FreeAndNil(CSIDL_ListForm);
  end;
end;

//=============================================================================
//  テスト用ボタン
//  [一般フォルダ]のファイルリスト
//  フォルダの選択ダイアログを表示して選択する
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  pidl : PItemIDList;
begin
  pidl := nil;
  if FBaseFolder = '' then FBaseFolder := ExtractFileDir(ParamStr(0));

  if SelectDirectory('フォルダ指定', '', FBaseFolder) then begin
    Update;
    pidl := ILCreateFromPath(PChar(FBaseFolder));
    if (pidl = nil) or (FBaseFolder = '') then begin
      MessageBox(0, '取得できませんでした．', '結果', MB_OK);
    end else begin
      SetRootNode(pidl);
    end;
  end;
  if pidl <> nil then CoTaskMemFree(pidl);
end;

//=============================================================================
//  テスト用ボタン
//  [戻る]
//  このサンプルプログラムでは，ダブルクリックで，選択中のノードをルートノード
//  としているのでこのコードになっているが，実用的には以下のコードとなるだろう
//
//  if TreeView1.Selected = nil then exit;
//
//  //もし編集中なら編集は中止
//  TreeView1.Selected.EndEdit(True);
//  if Node.Parent <> nil then Node.Parent.Selected := True;
//=============================================================================
procedure TForm1.Button4Click(Sender: TObject);
var
  pidl : PItemIDList;
begin
  if FNodeRoot = nil then exit;

  pidl := ILClone(FNodeRoot.Data);
  ILRemoveLastID(pidl);
  if pidl <> nil then begin
    SetRootNode(pidl);
    CoTaskMemFree(pidl);
  end;
end;

//----------------- 以下，シェルによるフォルダツリー本体 ----------------------


//=============================================================================
//  フォーム表示開始時の処理
//  各種初期化
//  項目識別子にはnilを代入しておくと，後処理がしやすい
//  nilを代入しないと，不定値となっている
//=============================================================================
procedure TForm1.FormShow(Sender: TObject);
var
  FileInfo : TSHFileInfo;
begin
  FpidlDesktop := nil;
  FpidlRoot    := nil;

  TreeView1.ShowRoot := False;
  TreeView1.DoubleBuffered := True;

  //[デスクトップ]のシェルフォルダオブジェクトを取得
  SHGetDesktopFolder(FshFolderDesktop);
  //デスクトップの項目識別子を取得
  SHGetSpecialFolderLocation(0, CSIDL_DESKTOP, FpidlDesktop);
  //イメージリストの取得と設定
  FImageHandle := SHGetFileInfo(Pointer(FpidlDesktop),
                                0,
                                FileInfo,
                                SizeOf(FileInfo),
                                SHGFI_PIDL or
                                SHGFI_SYSICONINDEX or
                                SHGFI_SMALLICON);

  TreeView_SetImageList(TreeView1.Handle, FImageHandle, TVSIL_NORMAL);
end;

//=============================================================================
//  フォーム破棄時の処理
//  項目識別子は，ノードのDataプロパティに項目識別子をセットしているので，ノー
//  ドが削除される時に項目識別子も破棄される
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  if FpidlDesktop <> nil then CoTaskMemFree(FpidlDesktop);
end;

//=============================================================================
//  ルートノード(FNodeRoot)の設定メソッド
//
//  引数のpidlはフルパス相当の項目識別子(完全PIDL)
//  1. ルートノードのテキストとDataプロパティに値をセット
//  2. ルートノードのアイコンを取得してセット
//  3. ルートノード直下のフォルダのリストを作成
//  4. ルートノード直下の階層を展開表示
//=============================================================================
function TForm1.SetRootNode(pidl: PItemIDList): Boolean;
var
  pidlFull   : PItemIDList;
  SHFileInfo : TSHFileInfo;
  DispName   : String;
begin
  Edit1.Text := '';
  TreeView1.Items.BeginUpdate;
  TreeView1.Items.Clear;

  FpidlRoot := ILClone(pidl);
  //表示名を取得してノードにセット
  FillChar(SHFileInfo, SizeOf(SHFileInfo), #0);
  SHGetFileInfo(Pointer(pidl),
                0,
                SHFileInfo,
                SizeOf(SHFileInfo),
                SHGFI_DISPLAYNAME or SHGFI_PIDL);
  DispName  := SHFileInfo.szDisplayName;
  FNodeRoot := TreeView1.Items.AddObject(nil, DispName, FpidlRoot);

  pidlFull := ILCombine(FpidlDesktop, FpidlRoot);
  SetIconToTreeViewNode(FNodeRoot,
                        IShellFolder2(FshFolderDesktop),
                        pidlFull,
                        FpidlRoot);
  Result := ExpandFolderTreeFromNode(FNodeRoot);
  if Result then FNodeRoot.Expand(False);

  TreeView1.Items.EndUpdate;
  if pidlFull <> nil then CoTaskMemFree(pidlFull);
end;

//=============================================================================
//  引数のExpandNode(項目識別子はDataプロパティに格納済み)以下を展開するメソッド
//  ルートフォルダの設定の後に呼出した場合は，ExpandNodeはルートノード
//
//  各ノードにはフルパス相当の完全PIDLをDataプロパティに代入していく
//
//  BindToObjectは対象がデスクトップの場合は失敗するので注意
//  フォルダオブジェクトと対象の項目識別子(このコードではItemID)が同じフォルダ
//  でも失敗する
//=============================================================================
function TForm1.ExpandFolderTreeFromNode(ExpandNode:TTreeNode): Boolean;
var
  pidlExpand   : PItemIDList;
  pidlChild    : PItemIDList;
  pidlFull     : PItemIDList;
  Flags        : Cardinal;
  pShellFolder : IShellFolder2;
  pEnumIdList  : IEnumIDList;
  Fetched      : Cardinal;
  AddNode      : TTreeNode;
  Attrib       : Cardinal;
  SHFileInfo   : TSHFileInfo;
  DispName     : String;
begin
  Result     := False;
  pidlChild  := nil;
  pidlExpand := ILClone(ExpandNode.Data);
  if pidlExpand = nil then exit;

  //対象となるフォルダの項目識別子とデスクトップの項目識別子を比較
  //同じなら対象フォルダは[デスクトップ]フォルダ
  if FshFolderDesktop.CompareIDs(0, pidlExpand, FpidlDesktop) = 0 then begin
    pShellFolder := IShellFolder2(FshFolderDesktop);
  end else begin
    //対象の項目識別子を[デスクトップ]のシェルフォルダオブジェクトにバインド
    //対象のシェルフォルダオブジェクトが求まる
    if FshFolderDesktop.BindToObject(pidlExpand, nil, IShellFolder,
                                     Pointer(pShellFolder)) <> S_OK then begin
      if pShellFolder <> nil then pShellFolder := nil;
      if pidlExpand   <> nil then CoTaskMemFree(pidlExpand);
      exit;
    end;
  end;

  Screen.Cursor := crHourGlass;
  if ILIsEqual(pidlExpand, FpidlRoot) = False then TreeView1.Items.BeginUpdate;

  //このFlagsで検索フォルダの属性を指定できる
  //SHCONTF_FOLDERSだけにした方がツリーの取得は速い
  Flags := SHCONTF_INCLUDEHIDDEN or SHCONTF_FOLDERS or SHCONTF_NONFOLDERS;

  //pEnumIDListに情報が格納される
  if (pShellFolder.EnumObjects(Handle, Flags, pEnumIDList)) <> S_OK then begin
    if pShellFolder <> nil then pShellFolder := nil;
    if pidlExpand   <> nil then CoTaskMemFree(pidlExpand);
    Screen.Cursor := crDefault;
    exit;
  end;


  //取得したpEnumIDListから1つづつファイル情報を取り出す
  //このループ内でも，フォルダの属性等を調査してツリーに追加しないようにできる
  //ここで取得したpidlChildは解放しないこと
  while (pEnumIDList.Next(1, pidlChild, Fetched) = S_OK) do begin
    //ノードのDataプロパティに項目識別子をセット
    pidlFull := ILCombine(pidlExpand, pidlChild);

    //表示名を取得してノードにセット
    FillChar(SHFileInfo, SizeOf(SHFileInfo), #0);
    SHGetFileInfo(Pointer(pidlFull),
                  0,
                  SHFileInfo,
                  SizeOf(SHFileInfo),
                  SHGFI_DISPLAYNAME or SHGFI_PIDL);
    DispName := SHFileInfo.szDisplayName;
    AddNode  := TreeView1.Items.AddChildObject(ExpandNode, DispName, pidlFull);

    //アイコンを取得してセット
    SetIconToTreeViewNode(AddNode, pShellFolder, pidlFull, pidlChild);

    //この子ノードの下にフォルダがあれば[+}記号を追加
    Attrib := SFGAO_HASSUBFOLDER;
    pShellFolder.GetAttributesOf(1, pidlChild, Attrib);
    if (SFGAO_HASSUBFOLDER and Attrib) <> 0 then begin
      AddNode.HasChildren := True;
    end;
  end;

  if TreeView1.Items.Count > 2 then begin
    TreeView1.CustomSort(@CustomSortFolderTree, Integer(FshFolderDesktop));
  end;

  if pidlExpand <> nil then CoTaskMemFree(pidlExpand);
  Screen.Cursor := crDefault;

  Result := True;
end;

//=============================================================================
//  各ノードのアイコンの取得とセットを行うメソッド
//  フォルダ数が多いと時間がかかる．CustomDraw等で行うと少しは時間の節約になる
//  かも知れない．シェル名前空間の関数類には，ストリームの操作関係がある．それ
//  を利用したり，あるいはスレッド処理も考えられる．
//
//  ANode        : アイコンをセットするノード
//  AShellFolder : アイコンをセットするノードの項目識別子を求めた時のシェルフ
//                 ォルダオブジェクト
//  pidl         : アイコンをセットするノードの相対項目識別子
//  pidlFull     : ノードの完全PIDL(アイコンの取得には完全PIDLが必要)
//=============================================================================
procedure TForm1.SetIconToTreeViewNode(ANode: TTreeNode;
  AShellFolder: IShellFolder2; pidlFull, pidl: PItemIDList);
var
  SHFileInfo : TSHFileInfo;
  Attrib     : Cardinal;
begin
  if FImageHandle = 0 then exit;
  if pidlFull = nil then exit;

  //通常のアイコン
  //リンク切れファイルやネットワークの検出には非常に時間がかかる．工夫が必要
  SHGetFileInfo(Pointer(pidlFull),
                      0,
                      SHFileInfo,
                      SizeOf(TSHFileInfo),
                      SHGFI_PIDL or SHGFI_SYSICONINDEX);
  ANode.ImageIndex := SHFileInfo.iIcon;

  //選択した時のアイコン(開いたアイコン)
  SHGetFileInfo(Pointer(pidlFull),
                      0,
                      SHFileInfo,
                      SizeOf(TSHFileInfo),
                      SHGFI_PIDL or SHGFI_SYSICONINDEX or SHGFI_OPENICON);
  ANode.SelectedIndex := SHFileInfo.iIcon;

  //リンクのオーバレイアイコン
  Attrib := SFGAO_LINK;
  AShellFolder.GetAttributesOf(1, pidl, Attrib);
  if (SFGAO_LINK and Attrib) <> 0 then ANode.OverlayIndex := 1;

  //共有フォルダのオーバレイアイコン
  Attrib := SFGAO_SHARE;
  AShellFolder.GetAttributesOf(1, pidl, Attrib);
  if (SFGAO_SHARE and Attrib) <> 0 then ANode.OverlayIndex := INDEXTOOVERLAYMASK(3);

  //隠し属性のアイコン
  Attrib := SFGAO_GHOSTED;
  AShellFolder.GetAttributesOf(1, pidl, Attrib);
  if (SFGAO_GHOSTED and Attrib) <> 0 then ANode.Cut := True;
end;

//=============================================================================
//  TTreeViewのOnExpandingイベント
//  ノードを展開しよううとする時のイベント
//  [+]ボタンが表示されていても実際に下位フォルダを取得していない時は取得
//  引数のNodeはこれから展開するノード
//=============================================================================
procedure TForm1.TreeView1Expanding(Sender: TObject; Node: TTreeNode;
  var AllowExpansion: Boolean);
begin
  if (Node.HasChildren) and (Node.Count = 0) then begin
    ExpandFolderTreeFromNode(Node);
    TreeView1.Items.EndUpdate;
  end;
end;

//=============================================================================
//  TTreeViewのOnCollapsedイベント
//  ノードを閉じた時のイベント用
//  ノードを展開した時にエクスプローラとは違い，前の展開状態を再現させないため
//  下位ノードを削除
//  次回ノードを展開時にフォルダ一覧を再取得とする
//  この方式だと展開するたびに最新の情報に更新される利点がある一方，展開するた
//  びにツリーを作成するために表示に時間がかかることになる
//  好みに応じて要変更
//=============================================================================
procedure TForm1.TreeView1Collapsed(Sender: TObject; Node: TTreeNode);
var
  HasChild : Boolean;
begin
  HasChild := Node.Count > 0;

  Node.DeleteChildren;
  TreeView1.Items.EndUpdate;

  Node.HasChildren := HasChild;
end;

//=============================================================================
//  TTreeViewのOnDeletionイベント
//  TTreeViewのDataオブジェクトは自動では解放してくれないのでここで解放
//=============================================================================
procedure TForm1.TreeView1Deletion(Sender: TObject; Node: TTreeNode);
begin
  if Node <> nil then CoTaskMemFree(Node.Data);
  Node.Data := nil;
end;

//=============================================================================
//  TTreeViewのOnEditedイベント
//  名前を変更したら，実際のファイルも項目識別子を使用して更新する
//  更新に失敗したら，TreeViewのItemのTextプロパティの値を元に戻す
//  DlgHandleを0にすると，エラー発生時のダイアログを表示しない
//
//  拡張子を非表示にしている場合には，拡張子関係の処理コードを追加する必要あり
//  (このサンプルプログラムのように，ファイルも表示する場合)
//=============================================================================
procedure TForm1.TreeView1Edited(Sender: TObject; Node: TTreeNode;
  var S: string);
var
  pShellFolder : IShellFolder2;
  pidlOrigin   : PItemIDList;
  pidlDest     : PItemIDList;
  DlgHandle    : HWND;
  hr           : HRESULT;
begin
  pidlDest := nil;
  if Node.Data = nil then exit;
  //ルートフォルダは編集できない
  if Node.Parent = nil then begin
    S := Node.Text;
    exit;
  end;

  //SetNameOfメソッドの引数には相対項目識別子が必要なので親のIShellFolderを取得
  //SHBindToParentの最後の引数の項目識別子は解放しないこと(MSDNの記事による)
  //一般に，シェル関係の関数で取得した項目識別子は解放しないこと
  SHBindToParent(Node.Data, IShellFolder, Pointer(pShellFolder), pidlOrigin);

  //実際のファイルの名前変更
  DlgHandle := Application.Handle;
  hr := pShellFolder.SetNameOf(DlgHandle,
                               pidlOrigin,
                               PChar(S),
                               SHGDN_NORMAL,
                               pidlDest);
  if Succeeded(hr) then begin
    Node.Data := ILClone(pidlDest);
  end else begin
    S := Node.Text;
  end;

  if pidlDest <> nil then CoTaskMemFree(pidlDest);
end;

//=============================================================================
//  TTreeViewのOnDblClickイベント
//  選択項目のダブルクリック動作
//
//  このコードでは，フォルダの場合，ダブルクリックしたフォルダをこのプログラム
//  で，ルートフォルダにして表示しているが，実際には他のプログラム，例えばダブ
//  ルクリックしたフォルダを，ファイルリストするのが一般的な用途だろう
//=============================================================================
procedure TForm1.TreeView1DblClick(Sender: TObject);
var
  Node         : TTreeNode;
  pShellFolder : IShellFolder;
  Attrib       : Cardinal;
  pidl         : PItemIDList;
  pidlFull     : PItemIDList;
  ShExeInfo    : TShellExecuteInfo;
begin
  if TreeView1.Selected = nil then exit;
  Node := TreeView1.Selected;
  if Node.Data = nil then exit;

  //GetAttributesOfの引数には相対項目識別子が必要なので親のIShellFolderを取得
  //SHBindToParentの最後の引数の項目識別子は解放しないこと(MSDNの記事による)
  pidlFull := ILClone(Node.Data);
  SHBindToParent(pidlFull, IShellFolder, Pointer(pShellFolder), pidl);

  //ファイルの属性を調査
  Attrib := SFGAO_FOLDER or SFGAO_FILESYSANCESTOR;
  pShellFolder.GetAttributesOf(1, pidl, Attrib);

  //属性がファイルシステムのフォルダの場合は，pidlFullをルートフォルダにして
  //このプログラムで表示．それ以外は，デフォルトの動作とする
  if (Attrib and (SFGAO_FOLDER or SFGAO_FILESYSANCESTOR)) <> 0 then begin
    SetRootNode(pidlFull);
  end else begin
    //必要があれば，lpParametersやlpDirectory等も設定する
    try
      ShExeInfo.cbSize       := sizeof(TShellExecuteInfo);
      ShExeInfo.fMask        := SEE_MASK_INVOKEIDLIST;
      ShExeInfo.wnd          := Handle;
      ShExeInfo.lpVerb       := '';
      ShExeInfo.lpFile       := nil;
      ShExeInfo.lpParameters := '';
      ShExeInfo.lpDirectory  := '';
      ShExeInfo.nShow        := SW_SHOWNORMAL;
      ShExeInfo.hInstApp     := 0;
      ShExeInfo.lpIDList     := pidlFull;
      ShExeInfo.lpClass      := nil;
      ShExeInfo.hkeyClass    := 0;
      ShExeInfo.dwHotKey     := 0;
      ShExeInfo.hIcon        := 0;

      ShellExecuteEx(@ShExeInfo);
    finally
    end;
  end;

  if pidlFull <> nil then CoTaskMemFree(pidlFull);
end;

//=============================================================================
//  TTreeViewのOnKeDownイベント
//  選択項目での[Enter]キー操作もダブルクリックと同じ動作とする
//  実用的には[F2]等の操作も追加した方がいいだろう
//=============================================================================
procedure TForm1.TreeView1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  //名前の編集中は実行しない
  if not TreeView1.IsEditing then begin
    if Key = VK_RETURN then begin
      if TreeView1.Selected <> nil then begin
        TreeView1DblClick(nil);
        Key:=0;
      end;
    end;
  end;
end;

//=============================================================================
//  TTreeViewのOnChangingイベント
//  選択ノードが変更になる前に発生するイベント
//  Edit1に選択したフォルダのフルパスを表示
//  ノードからフルパスを取得する参考コード
//
//  以下のコードでもフルパスが取得可能だが，仮想フォルダは空文字となる
//  Edit1.Text := GetFullPathFromTreeNode(Node);
//
//  [備考]
//  エクスプローラは，フォルダクリックで展開するようになっている
//=============================================================================
procedure TForm1.TreeView1Changing(Sender: TObject; Node: TTreeNode;
  var AllowChange: Boolean);
begin
  Edit1.Text := GetFullPathFromTreeNodeEx(Node);
end;

//=============================================================================
//  ノードからフルパスを求める関数
//  仮想フォルダ等は空文字出力
//  仮想フォルダを扱わない場合はこれで十分と思われる
//
//  Node.Dataにはフルパス相当の項目識別子(完全PIDL)が格納されている
//=============================================================================
function TForm1.GetFullPathFromTreeNode(Node: TTreeNode): String;
var
  Buff : array[0..MAX_PATH - 1] of Char;
begin
  FillChar(Buff, SizeOf(Buff), 0);
  SHGetPathFromIDList(Node.Data, Buff);
  Result := Buff;
end;

//=============================================================================
//  ノードからフルパスを求める関数
//  仮想フォルダはGUID文字列となる
//  SHBindToParentの最後の引数の項目識別子は解放しないこと(MSDNの記事による)
//=============================================================================
function TForm1.GetFullPathFromTreeNodeEx(Node: TTreeNode): String;
var
  pShFolder : IShellFolder;
  pidl      : PItemIDList;
  StrRet    : TStrRet;
begin
  Result := '';

  //該当ファイルのフォルダオブジェクト(pShFolder)と，相対項目識別子をpidlに取得
  SHBindToParent(Node.Data, IShellFolder, Pointer(pShFolder), pidl);
  FillChar(StrRet, SizeOf(StrRet), 0);
  if pShFolder.GetDisplayNameOf(pidl, SHGDN_FORPARSING, StrRet) = S_OK then begin
    Result := StrRet.pOleStr;
  end;
end;

end.