paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-12 21:39:49 +02:00
Code Issues Packages Projects Releases Wiki Activity

lazutils: merged code

Browse Source 
git-svn-id: trunk@42360 -
This commit is contained in:
mattias 2013-08-05 19:24:41 +00:00
parent d46e886263
commit 283ae2bad5
3 changed files with 16 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
components/lazutils/fileutil.inc
View File

@ -398,24 +398,10 @@ end;
function ExtractFileNameOnly(const AFilename: string): string;
------------------------------------------------------------------------------}
function ExtractFileNameOnly(const AFilename: string): string;
var
StartPos: Integer;
ExtPos: Integer;
begin
StartPos:=length(AFilename)+1;
while (StartPos>1)
and (AFilename[StartPos-1]<>PathDelim)
{$IFDEF Windows}and (AFilename[StartPos-1]<>':'){$ENDIF}
do
dec(StartPos);
ExtPos:=length(AFilename);
while (ExtPos>=StartPos) and (AFilename[ExtPos]<>'.') do
dec(ExtPos);
if (ExtPos<StartPos) then ExtPos:=length(AFilename)+1;
Result:=copy(AFilename,StartPos,ExtPos-StartPos);
Result := LazFileUtils.ExtractFileNameOnly(AFilename);
end;
{------------------------------------------------------------------------------
function ForceDirectory(DirectoryName: string): boolean;
------------------------------------------------------------------------------}

17
components/lazutils/fileutil.pas
View File

@ -23,21 +23,6 @@ maintain compatibility with Delphi's FileUtil unit.
File routines that specifically deal with UTF8 filenames should go into
the LazFileUtils unit.
ATM we have too much duplicate code in FileUtil, LazFileUtils and LazUtf8
ToDo:
- copy all Utf8 file routines to LazFileUtils and
in FileUtil inline them to LazFileutils counterparts
(The windows implementation of current FileUtil functions
deals better with unicode characters outside current codepage,
then the old implementations in LazFileUtils that only call Utf8ToSys and vice versa)
(This part is in progres...)
- At a later stage, we might declare the FileUtil versions ot these routines as deprecated
and remove them at some point in time
- Any other functions/procedures that are needed in LazFileUtils too, should be moved
to LazFileUtils, and in Fileutil inlined to use LazileUtils counterparts
DO NOT ADD MORE UTF8 RELATED (FILE) ROUTINES TO THIS UNIT !
***************************************************************************** }
unit FileUtil;
@ -97,7 +82,7 @@ function DirectoryIsWritable(const DirectoryName: string): boolean; inline;
const
PascalFileExt: array[1..3] of string = ('.pas','.pp','.p');
function ExtractFileNameOnly(const AFilename: string): string;
function ExtractFileNameOnly(const AFilename: string): string; inline;
function ExtractFileNameWithoutExt(const AFilename: string): string;
function CompareFileExt(const Filename, Ext: string; CaseSensitive: boolean): integer; overload; inline;
function CompareFileExt(const Filename, Ext: string): integer; overload; inline;

19
components/lazutils/lazfileutils.pas
View File

@ -234,12 +234,21 @@ begin
end;
function ExtractFileNameOnly(const AFilename: string): string;
var ExtLen: integer;
var
StartPos: Integer;
ExtPos: Integer;
begin
// beware: filename.ext1.ext2
Result:=ExtractFilename(AFilename);
ExtLen:=length(ExtractFileExt(Result));
Result:=copy(Result,1,length(Result)-ExtLen);
StartPos:=length(AFilename)+1;
while (StartPos>1)
and (AFilename[StartPos-1]<>PathDelim)
{$IFDEF Windows}and (AFilename[StartPos-1]<>':'){$ENDIF}
do
dec(StartPos);
ExtPos:=length(AFilename);
while (ExtPos>=StartPos) and (AFilename[ExtPos]<>'.') do
dec(ExtPos);
if (ExtPos<StartPos) then ExtPos:=length(AFilename)+1;
Result:=copy(AFilename,StartPos,ExtPos-StartPos);
end;
{$IFDEF darwin}