Ordner aus Pfad extrahieren

[CReber]

Da ich die Funktion vermisst hab und hier Beiträge erwünscht sind, dachte ich mir evtl. wäre das ja für Dateien und Laufwerke erwünschenswert.

Suchbegriffe:

Ordner extrahieren ableiten kriegen Verzeichniss Dir

Delphi-Quellcode:

function ExtractDirName(Path:string):string;
var
  i:integer;
begin
  // Check if last Char is \
  if Pos('\', Path[Length(Path)]) = 1 then
    Path:=Copy(Path,1,Length(Path) - 1);
  // ExtractDirName
  for i:=Length(Path) downto 0 do
    if Pos('\', Path[i]) = 1 then
    begin
      Result:=Copy(Path,i+1,Length(Path)-i);
      Exit;
    end;
end;

Aufruf:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(ExtractDirName('c:\Programme\blubb\'))
end;

oder

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(ExtractDirName(ExtractFilePath('c:\Programme\blubb\datei.exe')))
end;

[edit=Chakotay1308][delphi]-Tags schonmal eingefügt. Mfg, Chakotay1308[/edit]
[edit=Matze]Code formatiert. Mfg, Matze[/edit]

[Luckie]

Macht das nicht die Funktion ExtractPathname aus der Unit SysUtils? :gruebel:

Und falls es ein Ersatz sein soll, hier meine Versionen ohne pos:

Delphi-Quellcode:

////////////////////////////////////////////////////////////////////////////////
// Procedure : CutPathname
// Comment   : ExtractFilename

function CutPathname(s: string): string;
var
  i: integer;
begin
  result := s;
  for i := length(s) downto 1 do
    // Von hinten den Backslash suchen. Wenn gefunden alles ab Backslash kopieren
    if s[i] in ['\','/',':'] then
      begin
        result := copy(s, i + 1, length(s));
        // Nach dem ersten Backslash beenden
        break;
      end;
end;


////////////////////////////////////////////////////////////////////////////////
// Procedure : CutFilename
// Comment   : ExtractFilepath

function CutFilename(s: string): string;
var
  i: integer;
begin
  result := s;
  for i := length(s) downto 1 do
    // Von hinten den Backslash suchen. Wenn gefunden alles bis inkl. Backslash kopieren
    if s[i] in ['\','/',':'] then
      begin
        result := copy(s, 1, i);
        // Nach dem ersten Backslash beenden
        break;
      end;
end;

[edit=Chakotay1308]Kleine Korrektur. Mfg, Chakotay1308[/edit]