請問各位先進，我要怎樣用 DELPHI 得知某一個 FOLDER 是不是有資源分享？

發表時間：2003-02-21 00:18:10

IP:61.216.xxx.xxx 未訂閱

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

GiABin 一般會員發表：6 回覆：8 積分：2 註冊：2002-11-11 發送簡訊給我	#1 引用回覆回覆發表時間：2003-02-20 15:57:05 IP:203.75.xxx.xxx 未訂閱請問各位先進，我要怎樣用 DELPHI 得知某一個 FOLDER 是不是有資源分享？或者是我如何列出硬碟中所有有資源分享的 FOLDER？不知道怎樣做，可否分享您寶貴的經驗，魯力
hagar 版主發表：143 回覆：4056 積分：4445 註冊：2002-04-14 發送簡訊給我	#2 引用回覆回覆發表時間：2003-02-20 20:37:40 IP:202.39.xxx.xxx 未訂閱 http://www.swissdelphicenter.ch/en/showcode.php?id=1248
flyup 資深會員發表：280 回覆：508 積分：385 註冊：2002-04-15 發送簡訊給我	#3 引用回覆回覆發表時間：2003-02-21 00:18:10 IP:61.216.xxx.xxx 未訂閱 {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;