Delphi-PRAXiS
Seite 3 von 3     123   

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Neuen Beitrag zur Code-Library hinzufügen (https://www.delphipraxis.net/33-neuen-beitrag-zur-code-library-hinzufuegen/)
-   -   Delphi Unit zur Verwendung von SHGetKnownFolderPath (https://www.delphipraxis.net/135471-unit-zur-verwendung-von-shgetknownfolderpath.html)

KodeZwerg 18. Sep 2018 18:19

AW: Unit zur Verwendung von SHGetKnownFolderPath
 
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;

EWeiss 18. Sep 2018 18:29

AW: Unit zur Verwendung von SHGetKnownFolderPath
 
Wenn schon denn schon..
CreateFileW(PWideChar(...

gruss

KodeZwerg 18. Sep 2018 18:37

AW: Unit zur Verwendung von SHGetKnownFolderPath
 
Zitat:

Zitat von EWeiss (Beitrag 1413514)
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.dll' name {$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;

MicMic 19. Sep 2018 14:13

AW: Unit zur Verwendung von SHGetKnownFolderPath
 
Danke für's coden
Micha

DeddyH 19. Sep 2018 14:40

AW: Unit zur Verwendung von SHGetKnownFolderPath
 
Meistens kommt man aber auch mit einem einzigen IFDEF aus:
Delphi-Quellcode:
  function GetFinalPathNameByHandle(hFile: THandle; lpszFilePath: PChar; cchFilePath: DWORD; dwFlags: DWORD): DWORD; stdcall;
  external 'Kernel32.dll' name {$IFDEF UNICODE}'GetFinalPathNameByHandleW'{$ELSE}'GetFinalPathNameByHandleA'{$ENDIF};
Und dann benutzt man nur noch den Alias GetFinalPathNameByHandle, sollte automatisch passen.

KodeZwerg 19. Sep 2018 15:16

AW: Unit zur Verwendung von SHGetKnownFolderPath
 
Zitat:

Zitat von MicMic (Beitrag 1413637)
Danke für's coden
Micha

Gerne doch.:wink:
Zitat:

Zitat von DeddyH (Beitrag 1413651)
Meistens kommt man aber auch mit einem einzigen IFDEF aus

Dankeschön für Tipp, habe Code oben geupdatet.:thumb:


Alle Zeitangaben in WEZ +1. Es ist jetzt 00:45 Uhr.
Seite 3 von 3     123   

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz