Thema: Delphi Pfad ermitteln

Einzelnen Beitrag anzeigen

swoga

Registriert seit: 20. Sep 2010
4 Beiträge
 
#8

AW: Pfad ermitteln

  Alt 26. Mai 2011, 14:32
Danke himitsu

Ich habe mir jetzt eine Funktion gebastelt die das für mich erledigt...

Delphi-Quellcode:
type
  TStringDynArray = array of string;

//benötigte funktionen nicht von mir!
function GetEnvVarValue(const VarName: string): string;
var
  BufSize: Integer; // buffer size required for value
begin
  // Get required buffer size (inc. terminal #0)
  BufSize := GetEnvironmentVariable(PChar(VarName), nil, 0);
  if BufSize > 0 then
  begin
    // Read env var value into result string
    SetLength(Result, BufSize - 1);
    GetEnvironmentVariable(PChar(VarName), PChar(Result), BufSize);
  end
  else
    // No such environment variable
    Result := '';
end;

function Explode(const Separator, S: string; Limit: Integer = 0): TStringDynArray;
var
  SepLen: Integer;
  F, P: PChar;
  ALen, Index: Integer;
begin
  SetLength(Result, 0);
  if (S = '') or (Limit < 0) then
    Exit;
  if Separator = 'then
  begin
    SetLength(Result, 1);
    Result[0] := S;
    Exit;
  end;
  SepLen := Length(Separator);
  ALen := Limit;
  SetLength(Result, ALen);

  Index := 0;
  P := PChar(S);
  while P^ <> #0 do
  begin
    F := P;
    P := AnsiStrPos(P, PChar(Separator));
    if (P = nil) or ((Limit > 0) and (Index = Limit - 1)) then
      P := StrEnd(F);
    if Index >= ALen then
    begin
      Inc(ALen, 5);
      SetLength(Result, ALen);
    end;
    SetString(Result[Index], F, P - F);
    Inc(Index);
    if P^ <> #0 then
      Inc(P, SepLen);
  end;
  if Index < ALen then
    SetLength(Result, Index);
end;

//meine beiden funktionen


function getfullext(prefix: string; filename: string): string;
var
  o: Integer;
  extes: TStringDynArray;
begin
  // wenn der dateiname keine dateierweiterung enthält
  if (ExtractFileExt(filename) = '') then
  begin
    // alle möglichen dateierweiterungen laden
    extes := Explode(';', GetEnvVarValue('pathext'));
    // alle dateierweiterungen durchgehen
    for o := 0 to Length(extes) - 1 do
      // wenn die datei mit dieser dateierweiterung existiert
      if fileexists(prefix + filename + extes[o]) then
      begin
        filename := prefix + filename + extes[o];
        break;
      end;
  end
  // wenn der dateiname eine dateierweiterung enthält
  else
  begin
    if fileexists(prefix + filename) then
    begin
      filename := prefix + filename;
    end;
  end;
  Result := filename;
end;

function getfullpath(filename: string): string;
var
  pathes: TStringDynArray;
  i: Integer;
begin
  // wenn die datei nicht existiert
  if not(fileexists(filename)) then
  begin
    // wenn der dateiname keinen pfad enthält
    if ExtractFilePath(filename) = 'then
    begin
      // alle möglichen pfade laden und aufsplitten
      pathes := Explode(';', GetEnvVarValue('path'));
      // alle pfade durchgehen
      for i := 0 to Length(pathes) - 1 do
      begin
        //passende erweiterung suchen
        filename := getfullext(pathes[i] + '\', filename);
      end;
    end
    // wenn der dateiname einen pfad enthält
    else
    begin
      //passende erweiterung suchen
      filename := getfullext('', filename);
    end;

  end;
  Result := filename;
end;


...
  ShowMessage(getfullpath('cmd'));
  ShowMessage(getfullpath('cmd.exe'));
  ShowMessage(getfullpath('D:\Windows\System32\cmd'));
  ShowMessage(getfullpath('D:\Windows\System32\cmd.exe'));
Kritik & Anregungen zum Code erwünscht

Geändert von swoga (26. Mai 2011 um 14:39 Uhr)
  Mit Zitat antworten Zitat