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

2024-03-06 07:33•JavaScript•阅读 3393

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;

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

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;

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;

procedure TForm1.Button1Click(Sender: TObject);

begin

DeleteShare('test_folder2'); //取消共享

ShareDirectory('D:\test_folder2', 'test_folder2', ''); //共享文件夹

showmessage('share ok');

end;

end.

上一篇 »在Linux下，SVN服务器的简单配置
下一篇 »windows下python文件与文件夹操作

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

相关推荐

kali linux下的文件的创建,以及编辑保存

python虚拟环境管理 Pipenv 使用说明

java在不存在文件夹的目录下创建文件

delphi7在win7系统如何安装spcomm控件？

VM CentOS建立共享文件夹实现VS Code在windows环境下go开发，在centos环境里编译

Delphi 编写定制显示叠加图标的Shell扩展

webstorm+webpack创建项目

win7连接centos的nfs