whats new ¦  programming tips ¦  indy articles ¦  intraweb articles ¦  informations ¦  links ¦  interviews
 misc ¦  tutorials ¦  Add&Win Game

Tips (1548)

Database (90)
Files (137)
Forms (107)
Graphic (116)
IDE (21)
Indy (5)
Internet / LAN (131)
IntraWeb (0)
Math (76)
Misc (127)
Multimedia (45)
Objects/
ActiveX (51)

OpenTools API (3)
Printing (35)
Strings (83)
System (268)
VCL (243)

Top15

Tips sort by
component


Search Tip

Add new Tip

Add&Win Game

Advertising

28 Visitors Online


 
...tell if a folder is shared?
Autor: happyjoe
[ Print tip ]  

Tip Rating (16):  
     


{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;

 

Rate this tip:

poor
very good


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners