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下可以使用（这么有用的函数微软怎么就没早点想出来呢）.
var
MyReg:TRegistry;
//以下为注册表修改
MyReg:=TRegistry.Create ;
MyReg.RootKey :=HKEY_LOCAL_MACHINE;MyReg.OpenKey ('\SOFTWARE\Microsoft\Windows\CurrentVersion\Network\LanMan\C',True)
begin
MyReg.WriteInteger('Flags',258); //共享为完全共享
MyReg.WriteInteger('Type',0);
MyReg.WriteString('Path','C:\');//共享
MyReg.WriteString('Re','');
MyReg.CloseKey ;
end;见笑了
***************
DELPHI 关于WIN9X下共享文件夹问题
作者：房客（Jason）
经常看到有人问起如何在程序中增加和删除共享文件夹，于是就尽可能把相关信息写出来，更深入答案还请大虾共同讨论。
共享/删除共享可以直接调用标准的Win32API函数 NetShareAdd()和NetShareDel()。
建立共享目录函数：Function NetShareAdd(servername:PChar; level:SmallInt;buf:Pointer; buf_len:SmallInt):SmallInt;far;stdcall;external 'svrapi.dll';
撤销共享目录函数：Function NetShareDel(servername:PChar;buf:Pointer; reserved:SmallInt):SmallInt;far;stdcall;external 'svrapi.dll';
这里再提供两个关于连接共享目录/撤销共享目录函数WnetAddConnection和WnetCancelConnection。
关于映射网络驱动器的方法如下：
WNetAddConnection(%共享目录名%,%口令%,'X:'); //映射X盘
WNetCancelConnection('X:',True); //撤销X盘映射
关于建立/撤消共享的函数返回变量说明如下：
const NETNAME_LEN = 13;PASSWORD_LEN = 9;SHI50F_RDONLY = $0001;
SHI50F_FULL = $0002;SHI50F_DEPENDSON = $0003;
SHI50F_ACCESSMASK = $0003;SHI50F_PERSIST = $0100;
SHI50F_SYSTEM = $0200;STYPE_DISKTREE = 0;
STYPE_PRINTQ = 1;STYPE_DEVICE = 2;
STYPE_IPC = 3;NERR_Success = 0;
NERR_BASE = 2100; //常量说明
NERR_UnKnownDevDir=(NERR_BASE+16);NERR_UnknownServer=(NERR_BASE+3);
NERR_ServerNotStarted=(NERR_BASE+14);NERR_RedirectedPath=(NERR_BASE+17);
NERR_DuplicateShare=(NERR_BASE+18);NERR_BufTooSmalll=(NERR_BASE+23); //NetShareAdd返回错误
NERR_NetNotStarted = (NERR_BASE+2);
NERR_ServerNotStarted = (NERR_BASE+14);
NERR_NetNameNotFound = (NERR_BASE+210);
NERR_ShareNotFound = (NERR_BASE+292); //NetShareDel返回错误
SHARE_INFO_50=Record
netname:array [0..NETNAME_LEN-1] of Char;
sharetype:ShortInt;
flags:SmallInt;
re:PChar;
path:PChar;
rw_password:array [0..PASSWORD_LEN-1] of Char;
ro_password:array [0..PASSWORD_LEN-1] of Char;
End; //以上为类型定义
再有就是关于Window9X共享目录口令问题（其实屏保口令也是同样保存的）,口令（原始为十六进制字符）在注册表位置：HKEY_LOCAL_MACHINE\SOFTWARE\micorsoft\windows\current_version\network\lanman\共享文件夹名\Parm1enc和Parm2enc两位置，Parm1enc为对应的是完全共享密码，Parm2enc对应的是只读共享密码。字符与数列(前八个数是35,9A,4D,A6,53,A9,D4,6A)作异或运算即得密码的二进制ASCII码，转换后可得到密码。
另外提供一个比较幼稚但可行的方案（在注册表做动作）：
var reg : TRegistry; name : String; //s是在网上邻居里的文件夹名
begin
name := 'DirName'；//建立一个只读,无密码共享目录
reg := TRegistry.Create;
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Network\LanMan\'+name,true );
reg.WriteInteger( 'Flags', 401 ) ; //权限:401代表为访问，258为完全访问，259为密码访问
reg.WriteInteger( 'Parm1enc', 0 ) ; //参数2,放置完全访问密码,已加密
reg.WriteInteger( 'Parm2enc', 0 ) ; //参数2,放置只读访问密码,已加密
reg.WriteString( 'Path', 'C:\MYDIR' ) ; //放置要共享的目录的绝对路径
reg.WriteString( 'Re', '' ) ;
reg.WriteInteger( 'Type', 0 ) ;
end;
这样的缺点就是要重启系统，可以ExitWindowsEx( EWX_FORCE and EWX_SHUTDOWN , 0 )来重启。
此外你还可以使用控件File Sharing 95/98，该控件包含了几个方便的function：ShareResource、DeleteShare、GetShareInfo、SetShareInfo、GetNetErrorString等。
附：关于NetUserAdd等相关API
WNetCloseEnum 结束网络资源列表
WNetConnectionDialog 开始网络连接对话框
WNetDisconnectDialog 断开网络对话框
WNetEnumResource 继续列表网络资源
WNetGetConnection 获取网络资源名
WNetGetLastError 返回网络函数最近错误
WNetGetUser 获取当前网络用户名
WNetOpenEnum 列出网络资源
关键字 delphi api 共享
局域网中文件夹的共享 Windows NT/2000/XP在局域网中通过程序实现文件夹的共享，就我知道的应该至少有两种实现方式。一是修改注册表，但是这种方法存在的问题也是很明显的，必须重起机器才能生效。二就是利用 Windows Api函数 NetShareAdd ,通过这个函数我们可以很容易的实现文件夹的共享，而且无需重起计算机。使用这个函数时我们必须注意的是在 Windows NT/2000/XP 和 Windows 95/98/Me 下用法是有很大差别的，这一点我相信大家都有体会，明明在 95 或 98 下实现好好的，可是一到 NT 下就出问题。 其实不光是各位仁兄，我早就提出过这个问题，怎奈一直都没有解决掉。现在好了，希望读完后能给大家一点点帮助。 Windows 95/98/Me 下 NetShareAdd 函数声明在 SVRAPI.DLL 动态连接库中，而在 2000/XP/NT 下声明在 NETAPI32.DLL 动态连接库中。所以我们在不同的操作系统下一定要注意调用不同的 DLL 库。这些函数详细的声明，在新版 MSDN 2002 中有介绍。由于在Delphi中没有声明这些函数和他们的参数所以我们要想实现这个函数还必须自己声明（可能delphi 有声明我不知道在那个单元中）。顺便说一句，我使用的是 delphi5.0 版，可惜他的帮助文件实在是太陈旧了，还是先看看 MSDN 2002 中关于 NetShareAdd 函数的声明巴！Windows NT/2000/XP: NET_API_STATUS NetShareAdd(
LPWSTR servername, //对应 Delphi 中 PWideChar
DWORD level, //对应 DELPHI 中 DWOED
LPBYTE buf, //对应 DELPHI 中 PBYTE
LPDWORD parm_err // 对应 DELPHI 中 PDWORD
);
Windows 95/98/Me: 下面的对应参数就不用说了吧！可以直接看看DELPHI帮助文件。extern API_FUNCTION
NetShareAdd(
const char FAR * pszServer,
short sLevel,
const char FAR * pbBuffer,
unsigned short cbBuffer
);
特别强调： 我们在声明上面的函数时，函数参数一定要写对，也就是一定要正确对应到DELPHI 自己的类型上。不然函数功能无法实现，这一点我已经尝试了。之所以在NT 下实现不了主要还是，参数类型对应的不对。我们还需要声明一个记录类型，在98/95/me 和 nt/2000/xp下声明如下： Windows NT/2000/XP: SHARE_INFO_2 和 SHARE_INFO_502 结构 Windows 95/98/Me: share_info_50 结构 对以上这个结构的声明更应该注意参数类型的正确对应。原始声明如下： typedef struct _SHARE_INFO_502 {
LPWSTR shi502_netname; // PWideChar; DWORD shi502_type; // DWORD; LPWSTR shi502_re; // PWideChar; DWORD shi502_permissions; // DWORD; DWORD shi502_max_uses; // DWORD; DWORD shi502_current_uses; //DWORD; LPWSTR shi502_path; //PWideChar; LPWSTR shi502_passwd; // PWideChar; DWORD shi502_reserved; // DWORD ； // PSECURITY_DESCRIPTOR ；一般设为 Nil PSECURITY_DESCRIPTOR shi502_security_descriptor;} SHARE_INFO_502, *PSHARE_INFO_502, *LPSHARE_INFO_502; 对应 Delphi 纪录声明如下：一定要注意参数类型的正确对应，如果你把PWideChar 声明为 pchar 函数将无法实现此功能，我已经尝试了，你可以再试试，至于原因是什么，我也不太清楚。type TSHARE_INFO_502 = record shi502_netname: PWideChar; shi502_type: DWORD; shi502_re: PWideChar; shi502_permissions: DWORD; shi502_max_uses: DWORD; shi502_current_uses: DWORD; shi502_path: PWideChar; shi502_passwd: PWideChar; shi502_reserved: DWORD; shi502_security_descriptor: PSECURITY_DESCRIPTOR; end; 下面是完成的程序代码，其中有两部分，主程序和单元文件。运行环境 windows 2000 Ads 开发工具 Delphi5.0 。运行通过。 unit Share; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,FileCtrl,My_Share; type TFormShare = class(TForm) Label1: TLabel; Label2: TLabel; Label3: TLabel; BtSelect: TButton; EditDir: TEdit;//文件共享目录 EditSharename: TEdit; //共享名称 EditInfo: TEdit;//备注 Button1: TButton; Button2: TButton; procedure BtSelectClick(Sender: TObject); procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var FormShare: TFormShare; implementation {$R *.DFM} procedure TFormShare.BtSelectClick(Sender: TObject);var directory: string;begin if SelectDirectory('选择一个目录','', directory) then EditDir.Text := directory;end; procedure TFormShare.Button1Click(Sender: TObject);begin if EditDir.Text = '' then begin Application.MessageBox('请先选择一个目录！', '共享', MB_ICONINFORMATION + MB_OK); BtSelect.Click; Exit; end; if EditSharename.Text = '' then begin Application.MessageBox('请先输入共享名称！', '共享', MB_ICONINFORMATION + MB_OK); EditSharename.SetFocus; Exit; end; ShareResource('eengi',EditDir.Text,EditSharename.Text,EditInfo.Text); {注意：如果在共享目录名称后面添加 $ 符号，共享后在网络邻居里看不到此文件夹 但实际上已经共享了，你可以在本地看到}end; end. 以下是单元文件： unit My_Share; interfaceuses Windows,Sysutils ;type //纪录类型声明，注意参数类型的正确对应，最好别看 delphi 的帮助，引起误导 TSHARE_INFO_502 = record shi502_netname: PWideChar; shi502_type: DWORD; shi502_re: PWideChar; shi502_permissions: DWORD; shi502_max_uses: DWORD; shi502_current_uses: DWORD; shi502_path: PWideChar; shi502_passwd: PWideChar; shi502_reserved: DWORD; shi502_security_descriptor: PSECURITY_DESCRIPTOR; end;//添加共享function NetShareAdd(servername:Widestring; level: DWORD; Buf: PBYTE; var parm_err: PDWORD ): DWORD; stdcall;//删除共享function NetShareDel(ServerName:Widestring; NetName: Widestring; Reserved: DWord): Integer; StdCall;
const {共享类型} STYPE_DISKTREE = 0 ; STYPE_PRINTQ = 1 ; STYPE_DEVICE = 2 ; STYPE_IPC = 3 ; {访问权限} ACCESS_READ = 0 ; ACCESS_WRITE = 1 ; ACCESS_CREATE = 2 ; ACCESS_EXEC = 3 ; ACCESS_DELETE = 4 ; ACCESS_ALL = 7 ;//自己声明的函数，为了调用方便，参数就不用说明了吧！function ShareResource(ServerName,FilePath,NetName, Re : string): Integer;//function DeleteShare(ServerName: string; NetName: string): Integer;
implementation//注意在 windows95/98/me 下面 dll 库是 SVRAPI.DLL ，而且参数类型也要随之改变的吆！function NetShareAdd; external 'netapi32.DLL' name 'NetShareAdd';function NetShareDel; external 'netapi32.DLL' name 'NetShareDel'; function ShareResource(ServerName,FilePath,NetName, Re : string): Integer;var ShInfo: TSHARE_INFO_502; parm_err:PDWORD; _FilePath,_NetName, _Re : PWideChar ; _ServerName : Pchar ;begin GetMem(_ServerName,255) ; //分配内存 GetMem(_FilePath,255); GetMem(_NetName,255); GetMem(_Re,255); StringToWideChar(FilePath,_FilePath,255); //字符串转换,一定要转换正确 StringToWideChar(NetName,_NetName,255); StringToWideChar(Re,_Re,255); strpcopy(_ServerName,ServerName); //开始创建结构 with ShInfo do begin shi502_netname := _NetName; shi502_type := STYPE_DISKTREE ; shi502_re := _Re ; shi502_max_uses := $FFFFFFFF; shi502_current_uses := 10; shi502_path := _FilePath; shi502_passwd := nil; shi502_reserved := 0; shi502_security_descriptor := nil; shi502_permissions := ACCESS_ALL; end; try Result := NetShareAdd(_ServerName, 502, @ShInfo, parm_err); Finally // 别忘了释放内存 FreeMem(_ServerName,255); FreeMem(_FilePath,255); FreeMem(_NetName,255); FreeMem(_Re,255); end;end; end. 总结： 运行完程序后，相信大家和我有同样的感觉，其实成功就在眼前，就差一
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下可以使用（这么有用的函数微软怎么就没早点想出来呢）.
2000的使用组件LanUser和ComputerAccessRight组件就OK了
98的网上有很多例子的
你们只点了一下WNetAddConnection(%共享目录名%,%口令%,'X:'); //映射X盘
WNetCancelConnection('X:',True); //撤销X盘映射
能否具体给个例子解说一下！！！