Rede - descobrir se a pasta esta compartilhada

{Following code needs to use ShlObj, ComObj, ActiveX Units} 

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

  //Convert TStrRet to string 

  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; 

  //Get Desktop's IShellFolder interface 

  function DesktopShellFolder: IShellFolder; 

  begin 

    OleCheck(SHGetDesktopFolder(Result)); 

  end; 

  //delete the first ID from IDList 

  function NextPIDL(IDList: PItemIDList): PItemIDList; 

  begin 

    Result := IDList; 

    Inc(PChar(Result), IDList^.mkid.cb); 

  end; 

  //get the length of 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; 

  //get ID count from IDList 

  function GetItemCount(IDList: PItemIDList): Integer; 

  begin 

    Result := 0; 

    while IDList^.mkid.cb <> 0 do 

    begin 

      Inc(Result); 

      IDList := NextPIDL(IDList); 

    end; 

  end; 

  //create an ItemIDList object 

  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; 

  function CopyPIDL(IDList: PItemIDList): PItemIDList; 

  var 

    Size: Integer; 

  begin 

    Size   := GetPIDLSize(IDList); 

    Result := CreatePIDL(Size); 

    if Assigned(Result) then 

      CopyMemory(Result, IDList, Size); 

  end; 

  //get the last ItemID from AbsoluteID 

  function RelativeFromAbsolute(AbsoluteID: PItemIDList): PItemIDList; 

  begin 

    Result := AbsoluteID; 

    while GetItemCount(Result) > 1 do 

      Result := NextPIDL(Result); 

    Result := CopyPIDL(Result); 

  end; 

  //remove the last ID from IDList 

  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; 

  //if Flag include 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); 

  //get the folder's full ItemIDList 

  OleCheck(DesktopShellFolder.ParseDisplayName(0, nil, P, NumChars, NewPIDL, Flags)); 

  if NewPIDL <> nil then 

  begin 

    ParentPIDL := CopyPIDL(NewPIDL); 

    StripLastID(ParentPIDL);      //get the folder's parent object's ItemIDList 

    ID := RelativeFromAbsolute(NewPIDL);  //get the folder's relative ItemIDList 

    //get the folder's parent object's IShellFolder interface 

    OleCheck(DesktopShellFolder.BindToObject(ParentPIDL, nil, IID_IShellFolder, 

      Pointer(ParentShellFolder))); 

    if ParentShellFolder <> nil then 

    begin 

      Flags := SFGAO_SHARE; 

      //get the folder's attributes 

      OleCheck(ParentShellFolder.GetAttributesOf(1, ID, Flags)); 

      if IsElement(SFGAO_SHARE, Flags) then Result := True; 

    end; 

  end; 

end; 

{How to use the function? 

 The parameter in is the full path of a folder} 

procedure TForm1.Button1Click(Sender: TObject); 

begin 

  if IfFolderShared('C:\My Documents\WinPopup') then ShowMessage('shared') 

  else 

    ShowMessage('not shared'); 

end;