mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-21 03:09:34 +02:00
+ Added missing functions and some extra
This commit is contained in:
parent
3e9facf089
commit
2de00518e3
@ -83,9 +83,108 @@ if (I > 0) and (FileName[I] = '.') then
|
|||||||
else Result := '';
|
else Result := '';
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function ExpandFileName (Const FileName : string): String;
|
||||||
|
|
||||||
|
Begin
|
||||||
|
{$ifdef linux}
|
||||||
|
Result:=Linux.fexpand(FileName);
|
||||||
|
{$else}
|
||||||
|
Result:=Dos.Fexpand(FileName);
|
||||||
|
{$endif}
|
||||||
|
end;
|
||||||
|
|
||||||
|
function ExpandUNCFileName (Const FileName : string): String;
|
||||||
|
begin
|
||||||
|
Result:=ExpandFileName (FileName);
|
||||||
|
//!! Here should follow code to replace the drive: part with UNC...
|
||||||
|
end;
|
||||||
|
|
||||||
|
Const MaxDirs = 129;
|
||||||
|
|
||||||
|
function ExtractRelativepath (Const BaseName,DestName : String): String;
|
||||||
|
|
||||||
|
Var Source, Dest : String;
|
||||||
|
Sc,Dc,I,J : Longint;
|
||||||
|
SD,DD : Array[1..MaxDirs] of PChar;
|
||||||
|
|
||||||
|
Const OneLevelBack = '..'+OSDirSeparator;
|
||||||
|
|
||||||
|
begin
|
||||||
|
If Upcase(ExtractFileDrive(BaseName))<>Upcase(ExtractFileDrive(DestName)) Then
|
||||||
|
begin
|
||||||
|
Result:=DestName;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
Source:=ExtractFilePath(BaseName);
|
||||||
|
Dest:=ExtractFilePath(DestName);
|
||||||
|
SC:=GetDirs (Source,SD);
|
||||||
|
DC:=GetDirs (Dest,DD);
|
||||||
|
I:=1;
|
||||||
|
While (I<DC) and (I<SC) do
|
||||||
|
begin
|
||||||
|
If StrIcomp(DD[i],SD[i])=0 then
|
||||||
|
Inc(i)
|
||||||
|
else
|
||||||
|
Break;
|
||||||
|
end;
|
||||||
|
Result:='';
|
||||||
|
For J:=I to SC-1 do Result:=Result+OneLevelBack;
|
||||||
|
For J:=I to DC-1 do Result:=Result+DD[J]+OsDirSeparator;
|
||||||
|
Result:=Result+ExtractFileName(DestNAme);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure DoDirSeparators (Var FileName : String);
|
||||||
|
|
||||||
|
VAr I : longint;
|
||||||
|
|
||||||
|
begin
|
||||||
|
For I:=1 to Length(FileName) do
|
||||||
|
If FileName[I] in DirSeparators then
|
||||||
|
FileName[i]:=OSDirSeparator;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
Function SetDirSeparators (Const FileName : string) : String;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result:=FileName;
|
||||||
|
DoDirSeparators (Result);
|
||||||
|
end;
|
||||||
|
|
||||||
|
{
|
||||||
|
DirName is split in a #0 separated list of directory names,
|
||||||
|
Dirs is an array of pchars, pointing to these directory names.
|
||||||
|
The function returns the number of directories found, or -1
|
||||||
|
if none were found.
|
||||||
|
DirName must contain only OSDirSeparator as Directory separator chars.
|
||||||
|
}
|
||||||
|
|
||||||
|
Function GetDirs (Var DirName : String; Var Dirs : Array of pchar) : Longint;
|
||||||
|
|
||||||
|
Var I : Longint;
|
||||||
|
|
||||||
|
begin
|
||||||
|
I:=1;
|
||||||
|
Result:=-1;
|
||||||
|
While I<=Length(DirName) do
|
||||||
|
begin
|
||||||
|
If DirName[i]=OsDirSeparator then
|
||||||
|
begin
|
||||||
|
DirName[i]:=#0;
|
||||||
|
Inc(Result);
|
||||||
|
Dirs[Result]:=@DirName[I+1];
|
||||||
|
end;
|
||||||
|
Inc(I);
|
||||||
|
end;
|
||||||
|
If Result>-1 then inc(Result);
|
||||||
|
end;
|
||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.2 1998-09-16 08:28:38 michael
|
Revision 1.3 1998-10-04 20:19:56 michael
|
||||||
|
+ Added missing functions and some extra
|
||||||
|
|
||||||
|
Revision 1.2 1998/09/16 08:28:38 michael
|
||||||
Update from gertjan Schouten, plus small fix for linux
|
Update from gertjan Schouten, plus small fix for linux
|
||||||
|
|
||||||
Revision 1.1 1998/04/10 15:17:46 michael
|
Revision 1.1 1998/04/10 15:17:46 michael
|
||||||
|
@ -21,15 +21,33 @@
|
|||||||
System Utilities For Free Pascal
|
System Utilities For Free Pascal
|
||||||
}
|
}
|
||||||
|
|
||||||
|
Const
|
||||||
|
DirSeparators : set of char = ['/','\'];
|
||||||
|
{$ifdef Linux}
|
||||||
|
OSDirSeparator = '/';
|
||||||
|
{$else}
|
||||||
|
OsDirSeparator = '\';
|
||||||
|
{$endif}
|
||||||
|
|
||||||
function ChangeFileExt(const FileName, Extension: string): string;
|
function ChangeFileExt(const FileName, Extension: string): string;
|
||||||
function ExtractFilePath(const FileName: string): string;
|
function ExtractFilePath(const FileName: string): string;
|
||||||
function ExtractFileDrive(const FileName: string): string;
|
function ExtractFileDrive(const FileName: string): string;
|
||||||
function ExtractFileName(const FileName: string): string;
|
function ExtractFileName(const FileName: string): string;
|
||||||
function ExtractFileExt(const FileName: string): string; { Returns file extension like '.123' }
|
function ExtractFileExt(const FileName: string): string;
|
||||||
|
function ExtractFileDir(Const FileName : string): string;
|
||||||
|
function ExpandFileName (Const FileName : string): String;
|
||||||
|
function ExpandUNCFileName (Const FileName : string): String;
|
||||||
|
function ExtractRelativepath (Const BaseName,DestNAme : String): String;
|
||||||
|
Procedure DoDirSeparators (Var FileName : String);
|
||||||
|
Function SetDirSeparators (Const FileName : String) : String;
|
||||||
|
Function GetDirs (Var DirName : String; Var Dirs : Array of pchar) : Longint;
|
||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.2 1998-09-16 08:28:39 michael
|
Revision 1.3 1998-10-04 20:19:55 michael
|
||||||
|
+ Added missing functions and some extra
|
||||||
|
|
||||||
|
Revision 1.2 1998/09/16 08:28:39 michael
|
||||||
Update from gertjan Schouten, plus small fix for linux
|
Update from gertjan Schouten, plus small fix for linux
|
||||||
|
|
||||||
Revision 1.1 1998/04/10 15:17:46 michael
|
Revision 1.1 1998/04/10 15:17:46 michael
|
||||||
|
Loading…
Reference in New Issue
Block a user