Shell编程---如何判断一目录是否共享？

[happyjoe]

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 Documents\WinPopup') then showmessage('shared')
else showmessage('not shared');

另外，有一函数 SHBindToParent 可以直接取得此目录的上一级目录的IShellFolder接口和此目录相对于上一级目录的ItemIDList，这样一来就省去了上面多个对ItemIDList进行操作的函数（这些函数从delphi6的TShellTreeView所在的单元拷贝而来），但是此函数为新加入的API，只在win2000、winxp和winme下可以使用（这么有用的函数微软怎么就没早点想出来呢）.

欢迎大家来讨论

[happyjoe]

up

[woodheadmail]

感觉经验值暴涨

[ehom]

新加入的API!
可以用包含该API的DLL文件替换!

[happyjoe]

ehom(？！) 兄有道理

[wyd124]

up

[kiely]

Up

[happyjoe]

up

[byrrj]

up

[torble]

好

[happyjoe]

人世间最大的痛苦莫过于呐喊于人间而无人应对
程序员最大的痛苦莫过于发贴于csdn而无人回复

[Kingron]

好贴子。
我想，从注册表里面读取一下可能更简单，不过准确性方面可能就有问题。