AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Code-Bibliothek Neuen Beitrag zur Code-Library hinzufügen Delphi Unit zur Verwendung von SHGetKnownFolderPath

Unit zur Verwendung von SHGetKnownFolderPath

Ein Thema von ringli · begonnen am 11. Jun 2009 · letzter Beitrag vom 19. Sep 2018
Antwort Antwort
Seite 3 von 3     123
Benutzerbild von KodeZwerg
KodeZwerg

Registriert seit: 1. Feb 2018
2.263 Beiträge
 
Delphi 2010 Professional
 
#21

AW: Unit zur Verwendung von SHGetKnownFolderPath

  Alt 18. Sep 2018, 18: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;
Gruß vom KodeZwerg
Wenn ein unerwarteter Fehler aufgetreten ist, frage ich mich immer, welche Fehler erwartet wurden...

Geändert von KodeZwerg (18. Sep 2018 um 18:40 Uhr) Grund: Danke an EWeiss für Meldung
  Mit Zitat antworten Zitat
EWeiss
(Gast)

n/a Beiträge
 
#22

AW: Unit zur Verwendung von SHGetKnownFolderPath

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

gruss
  Mit Zitat antworten Zitat
Benutzerbild von KodeZwerg
KodeZwerg

Registriert seit: 1. Feb 2018
2.263 Beiträge
 
Delphi 2010 Professional
 
#23

AW: Unit zur Verwendung von SHGetKnownFolderPath

  Alt 18. Sep 2018, 18: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
Wenn ein unerwarteter Fehler aufgetreten ist, frage ich mich immer, welche Fehler erwartet wurden...

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

Registriert seit: 26. Mai 2018
134 Beiträge
 
Delphi 10.2 Tokyo Starter
 
#24

AW: Unit zur Verwendung von SHGetKnownFolderPath

  Alt 19. Sep 2018, 14:13
Danke für's coden
Micha
  Mit Zitat antworten Zitat
Benutzerbild von DeddyH
DeddyH

Registriert seit: 17. Sep 2006
Ort: Barchfeld
26.827 Beiträge
 
Delphi 10.3 Rio
 
#25

AW: Unit zur Verwendung von SHGetKnownFolderPath

  Alt 19. Sep 2018, 14:40
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.dllname {$IFDEF UNICODE}'GetFinalPathNameByHandleW'{$ELSE}'GetFinalPathNameByHandleA'{$ENDIF};
Und dann benutzt man nur noch den Alias GetFinalPathNameByHandle, sollte automatisch passen.
Detlef
"Ich habe Angst vor dem Tag, an dem die Technologie unsere menschlichen Interaktionen übertrumpft. Die Welt wird eine Generation von Idioten bekommen." (Albert Einstein)
Dieser Tag ist längst gekommen
  Mit Zitat antworten Zitat
Benutzerbild von KodeZwerg
KodeZwerg

Registriert seit: 1. Feb 2018
2.263 Beiträge
 
Delphi 2010 Professional
 
#26

AW: Unit zur Verwendung von SHGetKnownFolderPath

  Alt 19. Sep 2018, 15:16
Danke für's coden
Micha
Gerne doch.
Meistens kommt man aber auch mit einem einzigen IFDEF aus
Dankeschön für Tipp, habe Code oben geupdatet.
Gruß vom KodeZwerg
Wenn ein unerwarteter Fehler aufgetreten ist, frage ich mich immer, welche Fehler erwartet wurden...
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

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 12:13 Uhr.
Powered by vBulletin® Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2019 by Daniel R. Wolf