Registriert seit: 16. Aug 2004
165 Beiträge
Delphi 7 Enterprise
|
AW: ACL eines Folders auf anderen übertragen
20. Dez 2011, 03: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;
|