Einzelnen Beitrag anzeigen

Benutzerbild von KodeZwerg
KodeZwerg

Registriert seit: 1. Feb 2018
3.691 Beiträge
 
Delphi 11 Alexandria
 
#23

AW: Unit zur Verwendung von SHGetKnownFolderPath

  Alt 18. Sep 2018, 19:37
Wenn schon denn schon..
CreateFileW(PWideChar(...

gruss
Ich wusste doch da war noch was, Dankeschön!

edit
So vielleicht auch für ältere Delphis.
Delphi-Quellcode:
const FILE_NAME_NORMALIZED = $0;
function GetFinalPathNameByHandle(hFile: THandle; lpszFilePath: PChar; cchFilePath: DWORD; dwFlags: DWORD): DWORD; stdcall;
         external 'Kernel32.dllname {$IFDEF UNICODE}'GetFinalPathNameByHandleW'{$ELSE}'GetFinalPathNameByHandleA'{$ENDIF};

function _FileGetSymLinkTarget( const APathToLink : string; var ATarget : string ) : boolean;
  var
    LinkHandle: THandle;
    TargetName: array [0..OFS_MAXPATHNAME-1] of {$IFDEF UNICODE}WideChar{$ELSE}AnsiChar{$ENDIF};
  begin
    ATarget := '';
    LinkHandle := CreateFile( {$IFDEF UNICODE}PWideChar{$ELSE}PAnsiChar{$ENDIF}
                               (APathToLink), 0, FILE_SHARE_READ, nil,
                               OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0);
    Win32Check(LinkHandle <> INVALID_HANDLE_VALUE);
    try
        Result := GetFinalPathNameByHandle(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;
Gruß vom KodeZwerg

Geändert von KodeZwerg (19. Sep 2018 um 16:13 Uhr) Grund: Danke an DeddyH für Meldung
  Mit Zitat antworten Zitat