DELPHI设置Windows文件夹权限

unit JkSoft.JkComm.Utils.PathSecurity;

interface

uses
  Winapi.Windows, Winapi.AclAPI, Winapi.AccCtrl,
  System.SysUtils;

type
  TJkPathSecurityAttr = (psAll, psExcute, psWrite, psRead);
  TJkPathSecurityAttrSet = set of TJkPathSecurityAttr;

const
  JkPathSecurityAttrs : array [TJkPathSecurityAttr] of Cardinal =
                        (GENERIC_ALL, GENERIC_EXECUTE, GENERIC_WRITE, GENERIC_READ);


function GetPathSecurityAttrs(const AAttrs: TJkPathSecurityAttrSet): Cardinal;

function SetPathSecurityAttrsForUser(const APath, AUser: string;
  const AAttrs: TJkPathSecurityAttrSet = [psAll]): Boolean;

function CheckPathSecurityAttrsForUser(const APath, AUser: string;
  var AAttrs: TJkPathSecurityAttrSet): Boolean;

function HasAllOrRWERight(const AAttrs: TJkPathSecurityAttrSet): Boolean;
function HasAllRight(const AAttrs: TJkPathSecurityAttrSet): Boolean;
function HasRWERight(const AAttrs: TJkPathSecurityAttrSet): Boolean;
function HasRWRight(const AAttrs: TJkPathSecurityAttrSet): Boolean;
function HasReadRight(const AAttrs: TJkPathSecurityAttrSet): Boolean;
function HasWriteRight(const AAttrs: TJkPathSecurityAttrSet): Boolean;
function HasExcuteRight(const AAttrs: TJkPathSecurityAttrSet): Boolean;

implementation

uses
  JkSoft.JkComm.Utils;

function GetPathSecurityAttrs(const AAttrs: TJkPathSecurityAttrSet): Cardinal;
begin
  Result := 0;
  for var LAttr in AAttrs do
    Result := Result + JkPathSecurityAttrs[LAttr];
end;

function SetPathSecurityAttrsForUser(const APath, AUser: string;
  const AAttrs: TJkPathSecurityAttrSet): Boolean;
var
  LPath, LFile: string;
  LBool: Boolean;
  LEA: EXPLICIT_ACCESS;
  LOldACL: PACL;
  LNewACL: PACL;
  LAttrValue: Cardinal;
begin
  Result := False;
  LOldACL := nil;
  LNewACL := nil;
  if not CheckPathExist(APath, LPath, LFile) then
    Exit;
  try
    if GetNamedSecurityInfo(PChar(APath), SE_FILE_OBJECT, DACL_SECURITY_INFORMATION, nil, nil,
      @LOldACL, nil, nil) <> ERROR_SUCCESS then
      Exit;
    LAttrValue := GetPathSecurityAttrs(AAttrs);

    BuildExplicitAccessWithName(@LEA, PChar(AUser), LAttrValue, GRANT_ACCESS,
      SUB_CONTAINERS_AND_OBJECTS_INHERIT);
    if SetEntriesInAcl(1, @LEA, LOldACL, LNewACL) <> ERROR_SUCCESS then
      Exit;
    if SetNamedSecurityInfo(PChar(APath), SE_FILE_OBJECT, DACL_SECURITY_INFORMATION, nil, nil,
      LNewACL, nil) <> ERROR_SUCCESS then
      Exit;
    if LOldACL <> nil then
      LocalFree(LOldACL);
    if LNewACL <> nil then
    begin
      LocalFree(LNewACL);
      Result := True;
    end;
  except
    //
  end;
end;

function CheckPathSecurityAttrsForUser(const APath, AUser: string;
  var AAttrs: TJkPathSecurityAttrSet): Boolean;
var
  LPath, LFile: string;
  LSIDUser: PSID;
  LAccName: string;
  LDomainName: string;
  LcbSID: DWORD;
  LcbDomainName: DWORD;
  LpeUSE: SID_NAME_USE;
  LBool: BOOL;
  LACL: PACL;
  LMask: ACCESS_MASK;
  LTrustee: TRUSTEE_;
begin
  Result := False;
  AAttrs := [];

  LSIDUser := nil;
  LAccName := '';
  LDomainName := '';
  LcbSID := 1;
  LcbDomainName := 1;
  LpeUSE := SidTypeUnknown;
  LBool := False;
  LACL := nil;

  if not CheckPathExist(APath, LPath, LFile) then
    Exit;
  //第一次调用，取得缓冲区长度
  try
    LBool := LookupAccountName('', PChar(AUser), LSIDUser, LcbSID, PChar(LDomainName),
      LcbDomainName, LpeUSE);
    //设置缓冲区长度
    LSIDUser := AllocMem(LcbSID * SizeOf(Char));
    SetLength(LDomainName, LcbDomainName);
    try

      //第二次调用，取得SID
      LBool := LookupAccountName('', PChar(AUser), LSIDUser, LcbSID, PChar(LDomainName),
        LcbDomainName, LpeUSE);

      if (not LBool) or (not IsValidSid(LSIDUser)) then
        Exit;
      //取的ACL
      if GetNamedSecurityInfo(PChar(APath), SE_FILE_OBJECT, DACL_SECURITY_INFORMATION, nil, nil,
        @LACL, nil, nil) <> ERROR_SUCCESS then
        Exit;

      //建立Trustee
      BuildTrusteeWithSid(@LTrustee, LSIDUser);

      //获取权限掩码
      if GetEffectiveRightsFromAcl(LACL^, LTrustee, LMask) <> ERROR_SUCCESS then
        Exit;

    finally
      FreeMem(LSIDUser);
    end;

    for var I := Low(TJkPathSecurityAttr) to High(TJkPathSecurityAttr) do
      if (LMask and JkPathSecurityAttrs[I]) > 0 then
        Include(AAttrs, I);
    Result := True;
  except
    Result := False;
  end;
end;

function HasAllOrRWERight(const AAttrs: TJkPathSecurityAttrSet): Boolean;
begin
  Result := (psAll in AAttrs) or ((psWrite in AAttrs) and (psExcute in AAttrs) and (psRead in AAttrs));
end;

function HasRWERight(const AAttrs: TJkPathSecurityAttrSet): Boolean;
begin
  Result := (psWrite in AAttrs) and (psExcute in AAttrs) and (psRead in AAttrs);
end;

function HasAllRight(const AAttrs: TJkPathSecurityAttrSet): Boolean;
begin
  Result := psAll in AAttrs;
end;

function HasRWRight(const AAttrs: TJkPathSecurityAttrSet): Boolean;
begin
  Result := (psRead in AAttrs) and (psWrite in AAttrs);
end;

function HasReadRight(const AAttrs: TJkPathSecurityAttrSet): Boolean;
begin
  Result := psRead in AAttrs;
end;

function HasWriteRight(const AAttrs: TJkPathSecurityAttrSet): Boolean;
begin
  Result := psWrite in AAttrs
end;

function HasExcuteRight(const AAttrs: TJkPathSecurityAttrSet): Boolean;
begin
  Result := psExcute in AAttrs;
end;

end.

function SplitFullPathName(const AFullPathName: string; var APathName, AFileName: string): Boolean;
begin
  Result := False;
  try
    if AFullPathName.Trim.IsEmpty then
    begin
      APathName := '';
      AFileName := '';
    end
    else
    begin
      if TPath.GetExtension(AFullPathName).Trim.IsEmpty then
      begin
        APathName := AFullPathName.Trim([' ', PathDelim]);
        AFileName := '';
      end
      else
      begin
        APathName := TPath.GetDirectoryName(AFullPathName);
        AFileName := TPath.GetFileName(AFullPathName);
      end;
    end;
    Result := True;
  except

  end;
end;


function GetApplicationPath: string;
begin
  if FApplicationPath.IsEmpty then
  begin
    {$IFDEF ANDROID}
    FApplicationPath := JStringToString(TAndroidHelper.Context.getApplicationInfo.dataDir);
    {$ELSE}
    FApplicationPath := TPath.GetDirectoryName(GetApplicationName);
    {$ENDIF}
  end;
  Result := FApplicationPath;
end;


function CheckPathExist(const APathName: string; var APath, AFile: string): Boolean;
begin
  Result := False;
  if SplitFullPathName(APathName, APath, AFile) then
  begin
    if APath.IsEmpty then
      Exit;
    if TPath.IsRelativePath(APath) then
      APath := TPath.Combine(GetApplicationPath, APath);
    Result := TDirectory.Exists(APath);
  end;
end;

DELPHI 检查和设置WINDOW文件夹的安全属性。只对通用权限操作，标准权限未处理。

      做一个生成SQL SERVER 数据库的小工具，当创建数据库文件时，如果是新的文件夹或者未授权的文件夹，就拒绝访问(用SQL Server Management Studio平台时，如果数据库文件要存入一个未授权的文件夹时，也是拒绝的)。
     因为是运行时创建文件夹，也不能事先首先手动设置文件夹权限（除非固定文件夹），所以就想到了JEDI里的库JWSCL，研究了半天，好庞大，看的晕。不需要这么强大的功能，只需要文件夹的权限检查和设置功能。
     网上找资料，基本都是C++和C#的，甚至是java和python的，就没有delphi的。。。
还好C++的资料全面，也更容易转到Delphi。结合MSDN的文档，简单粗暴实现了。