Shell編程---如何判斷一目錄是否共享？

下面函數要額外引用 ShlObj, ComObj, ActiveX 單元。

function TForm1.IfFolderShared(FullFolderPath: string): Boolean;

  //將TStrRet類型轉換為字符串
  function StrRetToString(PIDL: PItemIDList; StrRet: TStrRet; Flag:string=): string;
  var
    P: PChar;
  begin
    case StrRet.uType of
      STRRET_CSTR:
        SetString(Result, StrRet.cStr, lStrLen(StrRet.cStr));
      STRRET_OFFSET:
        begin
          P := @PIDL.mkid.abID[StrRet.uOffset - SizeOf(PIDL.mkid.cb)];
          SetString(Result, P, PIDL.mkid.cb - StrRet.uOffset);
        end;
      STRRET_WSTR:
        if Assigned(StrRet.pOleStr) then
          Result := StrRet.pOleStr
        else
          Result := ;
    end;
    { This is a hack bug fix to get around Windows Shell Controls returning
      spurious "?"s in date/time detail fields }
    if (Length(Result) > 1) and (Result[1] = ?) and (Result[2] in [0..9]) then
      Result := StringReplace(Result,?,,[rfReplaceAll]);
  end;

  //返回Desktop的IShellFolder接口
  function DesktopShellFolder: IShellFolder;
  begin
    OleCheck(SHGetDesktopFolder(Result));
  end;

  //返回IDList去掉第一個ItemID後的IDList
  function NextPIDL(IDList: PItemIDList): PItemIDList;
  begin
    Result := IDList;
    Inc(PChar(Result), IDList^.mkid.cb);
  end;

  //返回IDList的長度
  function GetPIDLSize(IDList: PItemIDList): Integer;
  begin
    Result := 0;
    if Assigned(IDList) then
    begin
      Result := SizeOf(IDList^.mkid.cb);
      while IDList^.mkid.cb <> 0 do
      begin
        Result := Result + IDList^.mkid.cb;
        IDList := NextPIDL(IDList);
      end;
    end;
  end;

  //取得IDList中ItemID的個數
  function GetItemCount(IDList: PItemIDList): Integer;
  begin
    Result := 0;
    while IDList^.mkid.cb <> 0 do
    begin
      Inc(Result);
      IDList := NextPIDL(IDList);
    end;
  end;

  //創建一ItemIDList對象
  function CreatePIDL(Size: Integer): PItemIDList;
  var
    Malloc: IMalloc;
  begin
    OleCheck(SHGetMalloc(Malloc));

    Result := Malloc.Alloc(Size);
    if Assigned(Result) then
      FillChar(Result^, Size, 0);
  end;

  //返回IDList的一個內存拷貝
  function CopyPIDL(IDList: PItemIDList): PItemIDList;
  var
    Size: Integer;
  begin
    Size := GetPIDLSize(IDList);
    Result := CreatePIDL(Size);
    if Assigned(Result) then
      CopyMemory(Result, IDList, Size);
  end;

  //返回AbsoluteID最後一個ItemID，即此對象相對於父對象的ItemID
  function RelativeFromAbsolute(AbsoluteID: PItemIDList): PItemIDList;
  begin
    Result := AbsoluteID;
    while GetItemCount(Result) > 1 do
       Result := NextPIDL(Result);
    Result := CopyPIDL(Result);
  end;

  //將IDList的最後一個ItemID去掉，即得到IDList的父對象的ItemID
  procedure StripLastID(IDList: PItemIDList);
  var
    MarkerID: PItemIDList;
  begin
    MarkerID := IDList;
    if Assigned(IDList) then
    begin
      while IDList.mkid.cb <> 0 do
      begin
        MarkerID := IDList;
        IDList := NextPIDL(IDList);
      end;
      MarkerID.mkid.cb := 0;
    end;
  end;

  //判斷返回值Flag中是否包含屬性Element
  function IsElement(Element, Flag: Integer): Boolean;
  begin
    Result := Element and Flag <> 0;
  end;

var
  P: Pointer;
  NumChars, Flags: LongWord;
  ID, NewPIDL, ParentPIDL: PItemIDList;
  ParentShellFolder: IShellFolder;
begin
  Result := false;
  NumChars := Length(FullFolderPath);
  P := StringToOleStr(FullFolderPath);
  //取出該目錄的絕對ItemIDList
  OleCheck(DesktopShellFolder.ParseDisplayName(0, nil, P, NumChars, NewPIDL, Flags));
  if NewPIDL <> nil then
  begin
    ParentPIDL := CopyPIDL(NewPIDL);
    StripLastID(ParentPIDL);      //得到該目錄上一級目錄的ItemIDList

    ID := RelativeFromAbsolute(NewPIDL);  //得到該目錄相對於上一級目錄的ItemIDList

    //取得該目錄上一級目錄的IShellFolder接口
    OleCheck(DesktopShellFolder.BindToObject(ParentPIDL, nil, IID_IShellFolder,
      Pointer(ParentShellFolder)));

    if ParentShellFolder <> nil then
    begin
      Flags := SFGAO_SHARE;
      //取得該目錄的屬性
      OleCheck(ParentShellFolder.GetAttributesOf(1, ID, Flags));
      if IsElement(SFGAO_SHARE, Flags) then Result := true;
    end;
  end;
end;

此函數的用法：
  //傳進的參數為一目錄的全路經
  if IfFolderShared(C:My DocumentsWinPopup) then showmessage(shared)
  else showmessage(not shared);

  另外，有一函數 SHBindToParent 可以直接取得此目錄的上一級目錄的IShellFolder接口和此目錄相對於上一級目錄的ItemIDList，這樣一來就省去了上面多個對ItemIDList進行操作的函數（這些函數從delphi6的TShellTreeView所在的單元拷貝而來），但是此函數為新加入的API，只在win2000、winxp和winme下可以使用（這麼有用的函數微軟怎麼就沒早點想出來呢）.

歡迎大家來討論