ACL eines Folders auf anderen übertragen

[ASM]

Hier ist alles, um
(1) zum Handle eines Folders den zugehörigen Pfadnamen zu erhalten
(2) zum Pfadnamen eines geöffneten Folders dessen zugehöriges Handle zu ermitteln.

Im ersten Fall muss man einen Umweg nehmen, indem man mit Hilfe des Handles zuerst den DevicePath (z.B. "\device\HardDisk1\...") bekommt und diesen dann in den üblichen DOSPath (z.B. "c:\..."} konvertieren muss.

Code:

const
  ObjectNameInformation = 1;
  FileDirectoryInformation = 1;
  FileNameInformation = 9;

type
  NT_STATUS = Cardinal;

const
  STATUS_SUCCESS = NT_STATUS($00000000);

type
  PGetFileNameThreadParam = ^TGetFileNameThreadParam;
  TGetFileNameThreadParam = packed record
    hFile: THandle;
    Data: array[0..MAX_PATH - 1] of Char;
    Status: NT_STATUS;
  end;

  FILE_NAME_INFORMATION = packed record
    FileNameLength: ULONG;
    FileName: array[0..MAX_PATH - 1] of WideChar;
  end;

  TUNICODE_STRING = packed record
    Length: WORD;
    MaximumLength: WORD;
    Buffer: array[0..MAX_PATH - 1] of WideChar;
  end;

  TOBJECT_NAME_INFORMATION = packed record
    Name: TUNICODE_STRING;
  end;

  PIO_STATUS_BLOCK = ^IO_STATUS_BLOCK;
  IO_STATUS_BLOCK = packed record
    Status: NT_STATUS;
    Information: DWORD;
  end;

function NtQueryInformationFile(FileHandle: THandle;
  IoStatusBlock: PIO_STATUS_BLOCK; FileInformation: Pointer;
  Length: DWORD; FileInformationClass: DWORD): NT_STATUS;
  stdcall; external 'ntdll.dll';

function NtQueryObject(ObjectHandle: THandle;
  ObjectInformationClass: DWORD; ObjectInformation: Pointer;
  ObjectInformationLength: ULONG;
  ReturnLength: PDWORD): NT_STATUS; stdcall; external 'ntdll.dll';

function GetFileNameThread(lpParameters: Pointer): DWORD; stdcall;
var
  FileNameInfo: FILE_NAME_INFORMATION;
  ObjectNameInfo: TOBJECT_NAME_INFORMATION;
  IoStatusBlock: IO_STATUS_BLOCK;
  pThreadParam: TGetFileNameThreadParam;
  dwReturn: DWORD;
begin
  ZeroMemory(@FileNameInfo, SizeOf(FILE_NAME_INFORMATION));
  pThreadParam := PGetFileNameThreadParam(lpParameters)^;
  Result := NtQueryInformationFile(pThreadParam.hFile, @IoStatusBlock,
    @FileNameInfo, MAX_PATH * 2, FileNameInformation);
  if Result = STATUS_SUCCESS then
  begin
    Result := NtQueryObject(pThreadParam.hFile, ObjectNameInformation,
      @ObjectNameInfo, MAX_PATH * 2, @dwReturn);
    if Result = STATUS_SUCCESS then
    begin
      pThreadParam.Status := Result;
      WideCharToMultiByte(CP_ACP, 0,
        @ObjectNameInfo.Name.Buffer[ObjectNameInfo.Name.MaximumLength -
        ObjectNameInfo.Name.Length],
          ObjectNameInfo.Name.Length, @pThreadParam.Data[0],
        MAX_PATH, nil, nil);
    end
    else
    begin
      pThreadParam.Status := STATUS_SUCCESS;
      Result := STATUS_SUCCESS;
      WideCharToMultiByte(CP_ACP, 0,
        @FileNameInfo.FileName[0], IoStatusBlock.Information,
        @pThreadParam.Data[0],
        MAX_PATH, nil, nil);
    end;
  end;
  PGetFileNameThreadParam(lpParameters)^ := pThreadParam;
  ExitThread(Result);
end;

function GetFileNameFromHandle(hFile: THandle): string;
var
  lpExitCode: DWORD;
  pThreadParam: TGetFileNameThreadParam;
  hThread: THandle;
begin
  Result := '';
  ZeroMemory(@pThreadParam, SizeOf(TGetFileNameThreadParam));
  pThreadParam.hFile := hFile;
  hThread := CreateThread(nil, 0, @GetFileNameThread, @pThreadParam, 0, 0);
  if hThread <> 0 then
  try
    case WaitForSingleObject(hThread, 100) of
      WAIT_OBJECT_0:
        begin
          GetExitCodeThread(hThread, lpExitCode);
          if lpExitCode = STATUS_SUCCESS then
            Result := pThreadParam.Data;
        end;
      WAIT_TIMEOUT:
        TerminateThread(hThread, 0);
    end;
  finally
    CloseHandle(hThread);
  end;
end;

function ConvertDevicePathToDOSPath(DevicePath: string): string;
var
  i: integer;
  root: string;
  device: string;
  buffer: string; // pChar;
begin
  result := DevicePath;
  setlength(buffer, 1000);
  for i := Ord('c') to Ord('z') do
  begin
    root := Char(i) + ':';
    if (QueryDosDevice(PChar(root), pchar(buffer), 1000) <> 0) then
    begin
      device := pchar(buffer);
      if pos(device, DevicePath) > 0 then
      begin
        result := StringReplace(DevicePath, device, root, []);
        break;
      end;
    end;
  end;
end;

function GetDirnameFromHandle(DirHandle: THandle): string;
var
  DevicePath: string;
begin
  result := '';
  if DirHandle <> INVALID_HANDLE_VALUE then
  begin
    DevicePath := GetFileNameFromHandle(DirHandle);
    result := ConvertDevicePathToDOSPath(DevicePath);
  end;
end;

function GetHandleFromDirName(Folder: string): THandle;
begin
  result := CreateFile(PChar(folder),
    FILE_LIST_DIRECTORY or GENERIC_READ,
    FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,
    nil, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS or
    FILE_FLAG_OVERLAPPED, 0);
end;

// Beispiel:

Code:

// Beispiel:
Var folderpath: String = 'c:\temp\';

procedure TForm1.Button1Click(Sender: TObject);
var
  hdl: THandle;
  FolderZuHandle, FolderNameFromHandle: string;
begin
  memo1.Clear;
  folderZuHandle := FolderPath;
  if not DirectoryExists(folderZuHandle) then exit;
  memo1.Lines.add('Get Handle of Startfolder: '+folderZuHandle);
  hdl := GetHandleFromDirName(FolderZuHandle);
  FolderNameFromHandle := GetDirnameFromHandle(hdl);
  memo1.Lines.add('Foldername from Handle: '+FolderNameFromHandle);
end;

Und um die Zugriffsrechte eines Folders zu ändern (wozu man aber ggf. Administratorrechte braucht):

Code:

function ChangeUserPermission(aFile, Name: string; aMode: TACCESSMODE): string;
var
  pDACL: PACL;
  R: DWORD;
  pEA: TExplicitAccess;
begin
  result := '';
  try
    try
      BuildExplicitAccessWithName(@pEA, PAnsiChar(Name), GENERIC_READ, aMode,
        NO_INHERITANCE);
      R := SetEntriesInAcl(1, @pEA, nil, pDACL);
      if R = ERROR_SUCCESS then
      begin
        if SetNamedSecurityInfo(PAnsiChar(aFile), SE_FILE_OBJECT,
          DACL_SECURITY_INFORMATION,
          nil, nil, pDACL, nil) <> ERROR_SUCCESS then
          result := '*:' + SysErrorMessage(GetLastError);
        LocalFree(Cardinal(pDACL));
      end
      else
      begin
        result := '#:' + SysErrorMessage(R);
      end;
    except
      result := 'Exception raised';
    end;
  finally
  end;
end;

// Beispiel:

Code:

procedure TForm1.Button2Click(Sender: TObject);
var
  report: string;
  AccountName: string;
  SecuritySetting: _ACCESS_MODE;
begin
  AccountName := 'USER';
  SecuritySetting := GRANT_ACCESS; // GRANT_ACCESS oder DENY_ACCESS
  if ChangeUserPermission(FolderPath, AccountName, SecuritySetting) = '' then
    showmessage('Permission has been changed successfully')
  else
    Showmessage('Changing permission failed: '#13#10 + report);
end;

Für alles braucht man:

Code:

Uses {...,} JwaAclApi, JwaWinNT, JwaAccCtrl, JwaWinBase;