Registriert seit: 20. Sep 2010
4 Beiträge
|
AW: Pfad ermitteln
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)
|
|
Zitat
|