paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 18:19:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

* GetLongName hasn't been returning real LFN

Browse Source 
git-svn-id: trunk@4225 -
This commit is contained in:
Tomas Hajny 2006-07-16 12:46:19 +00:00
parent 5622a7ae64
commit 1cc4173738
1 changed files with 59 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

79
rtl/win/dos.pp
View File

@ -669,34 +669,67 @@ end;
function GetLongName(var p : String) : boolean; function GetLongName(var p : String) : boolean;
var var
lfn,sfn : array[0..255] of char; SR: SearchRec;
filename : pchar; FullFN, FinalFN, TestFN: string;
ret : longint; Found: boolean;
SPos: byte;
begin begin
{contrary to shortname, SDK does not mention input buffer can be equal if Length (P) = 0 then
to output.} GetLongName := false
else
if Length(p)>0 then {copy p to array of char} begin
move(p[1],sfn[0],length(p)); FullFN := FExpand (P); (* Needed to be done at the beginning to get proper case for all parts *)
sfn[length(p)]:=chr(0); SPos := 1;
fillchar(lfn,sizeof(lfn),#0); if (Length (FullFN) > 2) then
filename:=nil; if (FullFN [2] = DriveSeparator) then
SPos := 4
{Should return value load loaddoserror?} else
if (FullFN [1] = DirectorySeparator) and (FullFN [2] = DirectorySeparator) then
ret:=GetFullPathName(@sfn,255,@lfn,filename); begin
{lfn here returns full path, filename only fn} SPos := 3;
{ If successful, Ret contains length of the long file name, while (Length (FullFN) > SPos) and (FullFN [SPos] <> DirectorySeparator) do
0 is general error, return value larger than size of buffer (255) means Inc (SPos);
that the buffer size was not sufficient. } if SPos >= Length (FullFN) then
if (Ret > 0) and (Ret <= 255) then SPos := 1
else
begin
Inc (SPos);
while (Length (FullFN) >= SPos) and (FullFN [SPos] <> DirectorySeparator) do
Inc (SPos);
if SPos <= Length (FullFN) then
Inc (SPos);
end;
end;
FinalFN := Copy (FullFN, 1, Pred (SPos));
Delete (FullFN, 1, Pred (SPos));
Found := true;
while (FullFN <> '') and Found do
begin
SPos := Pos (DirectorySeparator, FullFN);
TestFN := Copy (FullFN, 1, Pred (SPos));
Delete (FullFN, 1, Pred (SPos));
FindFirst (FinalFN + TestFN, AnyFile, SR);
if DosError <> 0 then
Found := false
else
begin
FinalFN := FinalFN + SR.Name;
if (FullFN <> '') and (FullFN [1] = DirectorySeparator) then
begin
FinalFN := FinalFN + DirectorySeparator;
Delete (FullFN, 1, 1);
end;
end;
FindClose (SR);
end;
if Found then
begin begin
Move (LFN, P [1], Ret);
byte (P [0]) := Ret;
GetLongName := true; GetLongName := true;
P := FinalFN;
end end
else else
GetLongName := false; GetLongName := false
end;
end; end;
{****************************************************************************** {******************************************************************************