delphi 判断一目录是否共享


本文整理自网络,侵删。

 关键词:判断 共享目录 共享文件夹 
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:Documents') then showmessage('shared')

else showmessage('not shared');

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

相关阅读 >>

快速查询posex与posrightex

Delphi 深入了解unigui hyperserver

Delphi 10.3 处理csv tstreamreader 自带split用法

Delphi webbrowser控件里编辑网页

Delphi 校验注册码时的技巧

Delphi olevariant excel保存文件

Delphi获取外部程序菜单并模拟点击菜单

Delphi xe 安卓web开发 错误:net::err_cleartext_not_permitted

Delphi 如何获取窗口的图标

Delphi 数据类型cardinal 怎么转换成 string?

更多相关阅读请进入《Delphi》频道 >>



打赏

取消

感谢您的支持,我会继续努力的!

扫码支持
扫码打赏,您说多少就多少

打开支付宝扫一扫,即可进行扫码打赏哦

分享从这里开始,精彩与您同在

评论

管理员已关闭评论功能...