This repository was archived by the owner on Oct 11, 2022. It is now read-only.
forked from nickelsworth/swag
-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy path0059.pas
More file actions
53 lines (51 loc) · 1.37 KB
/
Copy path0059.pas
File metadata and controls
53 lines (51 loc) · 1.37 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
{
You included one of my subroutines in the SWAG-library. Unfortunately
it was buggy. Below you will find the, hopefully, bugfree code.
}
function GetRelativeFileName (F: FNameStr): FNameStr;
var
D: DirStr;
N: NameStr;
E: ExtStr;
i: integer;
rd: string;
begin
F := FExpand(F);
FSplit(F, D, N, E);
if GetCurDrive = D[1] then begin
{ Same Drive - remove Driveinformation from D }
Delete (D,1,2);
F := GetCurDir;
Delete (F,1,2);
{ Maybe it is a file in a directory higher than the actual directory }
i := Pos(F,d);
if i > 0 then begin
if length(f) = 1 then Delete (d,1,length(F))
else Delete (d,1,length(F)+1);
end
else begin
rd := '';
if Pos(d,F) = 0 then begin
repeat
repeat
rd := d[Ord(d[0])]+rd;
dec(d[0]);
until d[Ord(d[0])] = '\';
until Pos(d,F) > 0;
end;
{ Maybe it is a file in a directory lower than the actual directory }
if length(d)=1 then
d:= '\'+rd
else if Pos(d,F) > 0 then begin
repeat
rd := '..\'+rd;
dec (F[0]);
while F[Ord(F[0])] <> '\' do dec(F[0]);
until (Pos(F,D) > 0) and not((d='\') and (F<>'\'));
d := rd;
end
end;
end;
GetRelativeFileName := lower(D+N+E);
end;