The following functions should be additionally reference SHLOBJ, COMOBJ, ACTIVEX units.
Function TFORM1.IFFoldershared (FullfolderPath: String): boolean;
// The TStrRet type into a 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 (Result> 1) and (Result [1] = '?') and (Result [2] in ['0' .. '9']) Then Result: = StringReplace Result, '?', '', [RFREPLACEALL]);
// Return to Desktop's ISHELLFOLDER interface Function Desktopshellfolder: ishellfolder; begin olecheck (result);
// Returns IDList Function nextPIDL (Idlist: pitemidlist): pitemidlist; begin result: = id1midlist; melin result: = id1;
/ / Return to IDList's length 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);
// Number of ItemId in idList (IDList: pitemidlist): integer; begin result: = 0; while idlist ^ .mkid.cb <> 0 do begin inckey; IDList: = NextPIDL (Idlist); End; end; // Create a 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);
// Returns IDList of a memory copy function CopyPIDL (IDList: PItemIDList): PItemIDList; var Size: Integer; begin Size: = GetPIDLSize (IDList); Result: = CreatePIDL (Size); if Assigned (Result) then CopyMemory (Result, IDLIST, SIZE); END;
// Returns AbsoluteID last ItemID, i.e. the object relative ItemID function RelativeFromAbsolute (AbsoluteID: PItemIDList): For the parent object PItemIDList; begin Result: = AbsoluteID; while GetItemCount (Result)> 1 do Result: = NextPIDL (Result); Result : = CopyPIDL (Result);
// the last IDList the ItemID removed, to obtain ItemID procedure StripLastID IDList the parent object (IDList: PItemIDList); var MarkerID: PItemIDList; begin MarkerID: = IDList; if Assigned (IDList) then begin while IDList.mkid.cb <> 0 do begin marker: = idlist; idlist: = nextPIDL (IDLIST); END; markerid.mkid.cb: = 0; end;
// Deconstimate whether the return value FLAG contains attribute Element Function ISELEMENT (Element, Flag: Integer): Boolean; Begin Result: = Element And Flag <> 0;
var P: Pointer; NumChars, Flags: LongWord; ID, NewPIDL, ParentPIDL: PItemIDList; ParentShellFolder: IShellFolder; begin Result: = false; NumChars: = Length (FullFolderPath); P: = StringToOleStr (FullFolderPath); // remove the directory // get a directory on the; = CopyPIDL (NewPIDL); StripLastID (ParentPIDL):; absolute ItemIDList OleCheck (DesktopShellFolder.ParseDisplayName (0, nil, P, NumChars, NewPIDL, Flags)) if NewPIDL <> nil then begin ParentPIDL ItemidListid: = relativeFromabsolute (newPIDL); // gets this directory with ItemIdList with respect to the previous directory
// A ISHELLFOLDER interface Olecheck (Desktopshellfolder.BindToObject (PARENTPIDL, NIL, IID_IDTOOBIT (PARENTSHELLFOLDER));
if ParentShellFolder <> nil then begin Flags: = SFGAO_SHARE; // attribute OleCheck acquired the directory (ParentShellFolder.GetAttributesOf (1, ID, Flags)); if IsElement (SFGAO_SHARE, Flags) then Result: = true; end; end; END;
Usage of this function:
/ / Parametric parameter is a directory
If ifffoldershared ('c: / my documents / winpopup') Then ShowMessage ('Shared')
Else ShowMessage ('not shared');
In addition, there is a function shbindtoparent to acquire the ISHELLFOLDER interface of the previous directory of this directory and this directory relative to the ItemIdList of the previous directory, so that multiple functions that operate on ItemIDLIST (these functions from " Delphi6's TshellTreeView is located, but this function is a newly added API, only in Win2000, WinXP, and WinMe (such a useful function Microsoft how to think out early).).
Welcome everyone to discuss
