Registriert seit: 1. Feb 2018
3.691 Beiträge
Delphi 11 Alexandria
|
AW: Unit zur Verwendung von SHGetKnownFolderPath
18. Sep 2018, 19:19
Schnell rumgewurschtelt, nun sollte es Unicode sein?
Delphi-Quellcode:
const FILE_NAME_NORMALIZED = $0;
//Function GetFinalPathNameByHandleA(hFile: THandle; lpszFilePath: LPSTR; cchFilePath: DWORD; dwFlags: DWORD): DWORD; stdcall; external 'Kernel32.dll';
Function GetFinalPathNameByHandleW(hFile: THandle; lpszFilePath: LPWSTR; cchFilePath: DWORD; dwFlags: DWORD): DWORD; stdcall; external ' Kernel32.dll';
function _FileGetSymLinkTarget( const APathToLink : string; var ATarget : string ) : boolean;
var
LinkHandle: THandle;
TargetName: array [0..OFS_MAXPATHNAME-1] of WideChar;
begin
ATarget := ' ';
LinkHandle := CreateFileW( PWideChar(APathToLink), 0, FILE_SHARE_READ, nil,
OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
Win32Check(LinkHandle <> INVALID_HANDLE_VALUE);
try
Result := GetFinalPathNameByHandleW(LinkHandle, @TargetName, OFS_MAXPATHNAME, FILE_NAME_NORMALIZED) > 0;
if Result then
begin
ATarget := TargetName;
if Pos( ' \\?\UNC\', ATarget ) = 1 then
begin
Delete( ATarget, 1, 8 );
Insert( ' \\', ATarget, 1 );
end
else
if Pos( ' \\?\', ATarget ) = 1 then
Delete( ATarget, 1, 4 );
end;
finally
CloseHandle(LinkHandle);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
s: String;
begin
s := ' ';
_FileGetSymLinkTarget(' c:\programme',s);
ShowMessage(s);
end;
Geändert von KodeZwerg (18. Sep 2018 um 19:40 Uhr)
Grund: Danke an EWeiss für Meldung
|
|
Zitat
|