［原创］delphi在win7下创建共享文件夹源代码

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,AclApi, AccCtrl, StdCtrls;

type
PShareInfo2 = ^TShareInfo2;
TShareInfo2 = packed record
shi2_netname: PWideChar;
shi2_type: DWORD;
shi2_remark: PWideChar;
shi2_permissions: DWORD;
shi2_max_uses: DWORD;
shi2_current_uses: DWORD;
shi2_path: PWideChar;
shi2_passwd: PWideChar;
end;

const
NERR_SUCCESS = 0;
STYPE_DISKTREE = 0;
STYPE_PRINTQ = 1;
STYPE_DEVICE = 2;
STYPE_IPC = 3;
SHI_USES_UNLIMITED=20;
ACCESS_READ = $01; //可读
ACCESS_WRITE = $02; //可写
ACCESS_CREATE = $04; //创建资源的一个实例的权限
ACCESS_EXEC = $08; //执行资源的权限
ACCESS_DELETE = $10;//删除资源的权限
ACCESS_ATRIB = $20; //修改资源属性的权限
ACCESS_PERM = $40;
ACCESS_ALL = ACCESS_READ or ACCESS_WRITE or ACCESS_CREATE or ACCESS_EXEC or ACCESS_DELETE or ACCESS_ATRIB or ACCESS_PERM; //全部权限

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

const
SECURITY_WORLD_SID_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 1));
SECURITY_WORLD_RID = ($00000000);

const
ACL_REVISION = 2;
ACL_REVISION2 = 2;

advapi = 'advapi32.dll';
netapi = 'netapi32.dll';

Type
ACE_HEADER = record
AceType: Byte;
AceFlags: Byte;
AceSize: Word;
end;

ACCESS_ALLOWED_ACE = record
Header:ACE_HEADER;
Mask:ACCESS_MASK;
SidStart:DWORD;
end;

ACL_SIZE_INFORMATION = record
AceCount: DWORD;
AclBytesInUse: DWORD;
AclBytesFree: DWORD;
end;

PACE_HEADER = ^ACE_HEADER;

var
Form1: TForm1;

procedure BuildExplicitAccessWithNameW(pExplicitAccess: PEXPLICIT_ACCESS_W; pTrusteeName: PWideChar;
AccessPermissions: DWORD; AccessMode: ACCESS_MODE; Ineritance: DWORD); stdcall;
external advapi name 'BuildExplicitAccessWithNameW';
function GetNamedSecurityInfoW(pObjectName: PWideChar; ObjectType: SE_OBJECT_TYPE; SecurityInfo: SECURITY_INFORMATION;
ppsidOwner, ppsidGroup: PPSID; ppDacl, ppSacl: PACL; var ppSecurityDescriptor: PSECURITY_DESCRIPTOR): DWORD; stdcall;
external advapi name 'GetNamedSecurityInfoW';
function NetShareAdd(servername: PWideChar; level: DWORD; buf: Pointer; parm_err: LPDWORD): DWORD; stdcall;
external netapi;
function NetShareDel(servername, netname: PWideChar; reserved: DWORD): DWORD; stdcall; external netapi;
function SetNamedSecurityInfoW(pObjectName: PWideChar; ObjectType: SE_OBJECT_TYPE; SecurityInfo: SECURITY_INFORMATION;
ppsidOwner, ppsidGroup: PPSID; ppDacl, ppSacl: PACL): DWORD; stdcall; external advapi name 'SetNamedSecurityInfoW';

implementation

{$R *.dfm}

function SetFileAccesRights(const FileName, UserName: string;
dwAccessMask: DWORD): boolean;
var
// SID variables
snuType : SID_NAME_USE;
szDomain : PChar;
cbDomain: DWORD;
pUserSID: Pointer;
cbUserSID: DWORD;
// File SD variables.
pFileSD: PSECURITY_DESCRIPTOR;
cbFileSD: DWORD;
// New SD variables.
pNewSD: PSECURITY_DESCRIPTOR;
// ACL variables.
p_ACL : PACL;
fDaclPresent, fDaclDefaulted : LongBool;
AclInfo: ACL_SIZE_INFORMATION;
// New ACL variables.
pNewACL : PACL;
cbNewACL: DWORD;
// Temporary ACE.
pTempAce: Pointer;
CurrentAceIndex : Cardinal;
begin
szDomain := nil;
cbDomain := 0;
pUserSID := nil;
cbUserSID := 0;
pFileSD := nil;
cbFileSD := 0;
pNewSD := nil;
p_ACL := nil;
pNewACL := nil;
pTempAce := nil;

//
// STEP 1: Get SID for given user.
//
Result := LookupAccountName(nil, PChar(UserName),
pUserSID, cbUserSID, szDomain, cbDomain, snuType);

// API should have failed with insufficient buffer.
if (not Result) and (GetLastError <> ERROR_INSUFFICIENT_BUFFER) then
RaiseLastWin32Error;

pUserSID := AllocMem(cbUserSID);
szDomain := AllocMem(cbDomain);
try
Result := LookupAccountName(nil, PChar(UserName),
pUserSID, cbUserSID, szDomain, cbDomain, snuType);

if (not Result) then
RaiseLastWin32Error;

// STEP 2: Get security descriptor (SD) for file.
Result := GetFileSecurity(PChar(FileName),
DACL_SECURITY_INFORMATION, pFileSD, 0, cbFileSD);

if (not Result) and (GetLastError <> ERROR_INSUFFICIENT_BUFFER) then
RaiseLastWin32Error;

pFileSD := AllocMem(cbFileSD);

Result := GetFileSecurity(PChar(FileName),
DACL_SECURITY_INFORMATION, pFileSD, cbFileSD, cbFileSD);
if (not Result) then
RaiseLastWin32Error;

// STEP 3: Initialize new SD.
pNewSD := AllocMem(cbFileSD); // Should be same size as FileSD.

if (not InitializeSecurityDescriptor(pNewSD,
SECURITY_DESCRIPTOR_REVISION)) then
RaiseLastWin32Error;

// STEP 4: Get DACL from SD.
if (not GetSecurityDescriptorDacl(pFileSD, fDaclPresent, p_ACL,
fDaclDefaulted)) then
RaiseLastWin32Error;
// STEP 5: Get size information for DACL.
AclInfo.AceCount := 0; // Assume NULL DACL.
AclInfo.AclBytesFree := 0;
AclInfo.AclBytesInUse := SizeOf(ACL);

if (fDaclPresent and Assigned(p_ACL)) then
begin
if (not GetAclInformation(p_ACL^, @AclInfo,
SizeOf(ACL_SIZE_INFORMATION), AclSizeInformation)) then
RaiseLastWin32Error;

// STEP 6: Compute size needed for the new ACL.
cbNewACL := AclInfo.AclBytesInUse + SizeOf(ACCESS_ALLOWED_ACE)
+ GetLengthSid(pUserSID) - SizeOf(DWORD);

// STEP 7: Allocate memory for new ACL.
pNewACL := AllocMem(cbNewACL);

// STEP 8: Initialize the new ACL.
if (not InitializeAcl(pNewACL^, cbNewACL, ACL_REVISION2)) then
RaiseLastWin32Error;
// STEP 9: If DACL is present, copy it to a new DACL.
if (fDaclPresent) then
begin
// STEP 10: Copy the file's ACEs to the new ACL.
if (AclInfo.AceCount > 0) then
begin
for CurrentAceIndex := 0 to AclInfo.AceCount - 1 do
begin
// STEP 11: Get an ACE.
if (not GetAce(p_ACL^, CurrentAceIndex, pTempAce)) then
RaiseLastWin32Error;
// STEP 12: Add the ACE to the new ACL.
if (not AddAce(pNewACL^, ACL_REVISION, MAXDWORD, pTempAce,
PACE_HEADER(pTempAce)^.AceSize)) then
RaiseLastWin32Error;
end
end
end;

// STEP 13: Add the access-allowed ACE to the new DACL.
if (not AddAccessAllowedAce(pNewACL^, ACL_REVISION2, dwAccessMask,
pUserSID)) then
RaiseLastWin32Error;

// STEP 14: Set the new DACL to the file SD.
if (not SetSecurityDescriptorDacl(pNewSD, True, pNewACL, False)) then
RaiseLastWin32Error;

// STEP 15: Set the SD to the File.
if (not SetFileSecurity(PChar(FileName), DACL_SECURITY_INFORMATION,
pNewSD)) then
RaiseLastWin32Error;
Result := True;
end;
finally
// STEP 16: Free allocated memory
if Assigned(pUserSID) then
FreeMem(pUserSID);
if Assigned(szDomain) then
FreeMem(szDomain);
if Assigned(pFileSD) then
FreeMem(pFileSD);
if Assigned(pNewSD) then
FreeMem(pNewSD);
if Assigned(pNewACL) then
FreeMem(pNewACL);
end;
end;

//
procedure NetApiCheck(RetValue: Cardinal);
begin
if RetValue <> ERROR_SUCCESS then
RaiseLastOSError(RetValue);
end;
//

function WideGetEveryoneName: WideString;
var
psid: PSECURITY_DESCRIPTOR;
Dummy: WideString;
NameLen, DomainNameLen: Cardinal;
Use: SID_NAME_USE;
begin
Result := '';

if not AllocateAndInitializeSid(SECURITY_WORLD_SID_AUTHORITY, 1, SECURITY_WORLD_RID, 0, 0, 0, 0, 0, 0, 0, psid) then
Exit;
try
NameLen := 0;
DomainNameLen := 0;
Use := 0;
if LookupAccountSidW(nil, psid, nil, NameLen, nil, DomainNameLen, Use) or
(GetLastError <> ERROR_INSUFFICIENT_BUFFER) then
Exit;

if NameLen = 1 then
Exit;

SetLength(Result, NameLen - 1);
SetLength(Dummy, DomainNameLen);

if not LookupAccountSidW(nil, psid, PWideChar(Result), NameLen, PWideChar(Dummy), DomainNameLen, Use) then
Result := '';
finally
FreeSid(psid);
end;
end;

//

function DeleteShare(const ShareName: WideString): Boolean;
begin
Result := NetShareDel(nil, PWideChar(ShareName), 0) = NERR_Success;
end;

procedure ShareDirectory(const Directory, ShareName, Description: WideString);
var
ShareInfo: TShareInfo2;
OldAcl, NewAcl: PACL;
psid: PSECURITY_DESCRIPTOR;
ExplicitAccess: EXPLICIT_ACCESS_W;
begin
FillChar(ShareInfo, SizeOf(ShareInfo), 0);
ShareInfo.shi2_netname := PWideChar(ShareName);
ShareInfo.shi2_type := STYPE_DISKTREE;
ShareInfo.shi2_remark := PWideChar(Description);
ShareInfo.shi2_max_uses := SHI_USES_UNLIMITED;
ShareInfo.shi2_path := PWideChar(Directory);
NetApiCheck(NetShareAdd(nil, 2, @ShareInfo, nil));

///////////添加共享资源的访问权限，对应于对象属性页中"共享" 页中的设置

//为已共享对象分配权限

// 第1步：获取文件(夹)安全对象的DACL列表

NetApiCheck(GetNamedSecurityInfoW(PWideChar(ShareName), SE_LMSHARE, DACL_SECURITY_INFORMATION, nil, nil, @OldAcl, nil,
psid));
try
//第2步： 生成指定用户帐户的访问控制信息(这里指定赋予全部的访问权限)

////创建一个ACE,禁止 everyone 组成员完全控制对象，只读且不允许子对象继承此权限
FillChar(ExplicitAccess, SizeOf(ExplicitAccess), 0);

BuildExplicitAccessWithNameW(@ExplicitAccess, PWideChar(WideGetEveryoneName),
GENERIC_ALL or STANDARD_RIGHTS_ALL or SPECIFIC_RIGHTS_ALL ,GRANT_ACCESS{SET_ACCESS}, SUB_CONTAINERS_AND_OBJECTS_INHERIT); //使用共享文件夹被everyone用户完全控制

//第3步： 创建新的ACL对象(合并已有的ACL对象和刚生成的用户帐户访问控制信息)

NetApiCheck(SetEntriesInAclW(1, @ExplicitAccess, OldAcl, NewAcl)); // 将新的ACE加入DACL

try
//// 更新共享对象的DACL
NetApiCheck(SetNamedSecurityInfoW(PWideChar(ShareName), SE_LMSHARE, DACL_SECURITY_INFORMATION, nil, nil, NewAcl,
nil));

finally
LocalFree(HLOCAL(NewAcl)); //释放
end;

////////////////添加文件、目录访问权限，对应于对象属性页中"安全" 页中的设置

SetFileAccesRights(Directory,'Everyone',GENERIC_ALL);
SetFileAccesRights(Directory,'Guest',GENERIC_WRITE or STANDARD_RIGHTS_ALL);

finally
LocalFree(HLOCAL(psid));
end;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
DeleteShare('test_folder2'); //取消共享
ShareDirectory('D:\test_folder2', 'test_folder2', ''); //共享文件夹
showmessage('share ok');
end;

end.