AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein .NET-Framework (managed code) C# ACL eines Folders auf anderen übertragen
Thema durchsuchen
Ansicht
Themen-Optionen

ACL eines Folders auf anderen übertragen

Ein Thema von xaromz · begonnen am 19. Dez 2011 · letzter Beitrag vom 20. Dez 2011
 
ASM

Registriert seit: 15. Aug 2004
165 Beiträge
 
Delphi 7 Enterprise
 
#2

AW: ACL eines Folders auf anderen übertragen

  Alt 20. Dez 2011, 02:26
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;
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 14:15 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz