mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-16 23:49:28 +02:00
added basic file handling functions to filectrl
git-svn-id: trunk@3010 -
This commit is contained in:
mattias
parent
0f1d76a734
commit
d2df832c6b
@ -47,7 +47,7 @@ uses
|
||||
SynEditTypes, SynEdit, SynEditHighlighter, SynHighlighterPas,
|
||||
SynEditAutoComplete, SynEditKeyCmds, SynCompletion, GraphType, Graphics,
|
||||
Extctrls, Menus, FindInFilesDlg, LMessages, IDEProcs, IDEOptionDefs,
|
||||
InputHistory, LazarusIDEStrConsts, BaseDebugManager, Debugger;
|
||||
InputHistory, LazarusIDEStrConsts, BaseDebugManager, Debugger, FileCtrl;
|
||||
|
||||
type
|
||||
TSourceNoteBook = class;
|
||||
|
||||
@ -41,18 +41,34 @@ interface
|
||||
{$endif}
|
||||
|
||||
uses
|
||||
SysUtils;
|
||||
Classes, SysUtils;
|
||||
|
||||
// file attributes and states
|
||||
function FilenameIsAbsolute(TheFilename: string):boolean;
|
||||
procedure CheckIfFileIsExecutable(const AFilename: string);
|
||||
function FileIsReadable(const AFilename: string): boolean;
|
||||
function FileIsWritable(const AFilename: string): boolean;
|
||||
function FileIsText(const AFilename: string): boolean;
|
||||
function FileIsExecutable(const AFilename: string): boolean;
|
||||
function GetFileDescription(const AFilename: string): string;
|
||||
|
||||
{
|
||||
@abstract (Function to determine if a directory exists or not.)
|
||||
Introduced by Curtis White
|
||||
Currently maintained by Curtis White
|
||||
}
|
||||
function DirectoryExists(const Name: String): Boolean;
|
||||
function FileIsWritable(const AFilename: string): boolean;
|
||||
function GetFileDescription(const AFilename: string): string;
|
||||
// directories
|
||||
function DirectoryExists(const Name: String): Boolean;
|
||||
function ForceDirectory(DirectoryName: string): boolean;
|
||||
|
||||
// filename parts
|
||||
function ExtractFileNameOnly(const AFilename: string): string;
|
||||
function CompareFileExt(const Filename, Ext: string;
|
||||
CaseSensitive: boolean): integer;
|
||||
function AppendPathDelim(const Path: string): string;
|
||||
function ChompPathDelim(const Path: string): string;
|
||||
function TrimFilename(const AFilename: string): string;
|
||||
function CleanAndExpandFilename(const Filename: string): string;
|
||||
function CleanAndExpandDirectory(const Filename: string): string;
|
||||
|
||||
// file search
|
||||
function SearchFileInPath(const Filename, BasePath, SearchPath,
|
||||
Delimiter: string; SearchLoUpCase: boolean): string;
|
||||
|
||||
implementation
|
||||
|
||||
@ -61,10 +77,23 @@ uses
|
||||
{$IFDEF Ver1_0}Linux{$ELSE}Unix{$ENDIF};
|
||||
{$ENDIF}
|
||||
|
||||
var
|
||||
UpChars: array[char] of char;
|
||||
|
||||
|
||||
{$I filectrl.inc}
|
||||
|
||||
procedure InternalInit;
|
||||
var
|
||||
c: char;
|
||||
begin
|
||||
for c:=Low(char) to High(char) do begin
|
||||
UpChars[c]:=upcase(c);
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
InternalInit;
|
||||
|
||||
finalization
|
||||
|
||||
@ -72,6 +101,9 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.5 2002/12/09 16:48:36 mattias
|
||||
added basic file handling functions to filectrl
|
||||
|
||||
Revision 1.4 2002/05/29 21:44:38 lazarus
|
||||
MG: improved TCommon/File/OpenDialog, fixed TListView scrolling and broder
|
||||
|
||||
|
||||
@ -34,6 +34,276 @@ begin
|
||||
Result := dirExist;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function FilenameIsAbsolute(TheFilename: string):boolean;
|
||||
------------------------------------------------------------------------------}
|
||||
function FilenameIsAbsolute(TheFilename: string):boolean;
|
||||
begin
|
||||
DoDirSeparators(TheFilename);
|
||||
{$IFDEF win32}
|
||||
// windows
|
||||
Result:=(copy(TheFilename,1,2)='\\') or ((length(TheFilename)>3) and
|
||||
(upcase(TheFilename[1]) in ['A'..'Z']) and (copy(TheFilename,2,2)=':\'));
|
||||
{$ELSE}
|
||||
Result:=(TheFilename<>'') and (TheFilename[1]='/');
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function AppendPathDelim(const Path: string): string;
|
||||
------------------------------------------------------------------------------}
|
||||
function AppendPathDelim(const Path: string): string;
|
||||
begin
|
||||
if (Path<>'') and (Path[length(Path)]<>PathDelim) then
|
||||
Result:=Path+PathDelim
|
||||
else
|
||||
Result:=Path;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function TrimFilename(const AFilename: string): string;
|
||||
------------------------------------------------------------------------------}
|
||||
function TrimFilename(const AFilename: string): string;
|
||||
// trim double path delims, heading and trailing spaces
|
||||
// and special dirs . and ..
|
||||
var SrcPos, DestPos, l, DirStart: integer;
|
||||
c: char;
|
||||
begin
|
||||
Result:=AFilename;
|
||||
l:=length(AFilename);
|
||||
SrcPos:=1;
|
||||
DestPos:=1;
|
||||
|
||||
// skip trailing spaces
|
||||
while (l>=1) and (AFilename[SrcPos]=' ') do dec(l);
|
||||
|
||||
// skip heading spaces
|
||||
while (SrcPos<=l) and (AFilename[SrcPos]=' ') do inc(SrcPos);
|
||||
|
||||
// trim double path delims and special dirs . and ..
|
||||
while (SrcPos<=l) do begin
|
||||
c:=AFilename[SrcPos];
|
||||
// check for double path delims
|
||||
if (c=PathDelim) then begin
|
||||
inc(SrcPos);
|
||||
{$IFDEF win32}
|
||||
if (DestPos>2)
|
||||
{$ELSE}
|
||||
if (DestPos>1)
|
||||
{$ENDIF}
|
||||
and (Result[DestPos-1]=PathDelim) then begin
|
||||
// skip second PathDelim
|
||||
continue;
|
||||
end;
|
||||
Result[DestPos]:=c;
|
||||
inc(DestPos);
|
||||
continue;
|
||||
end;
|
||||
// check for special dirs . and ..
|
||||
if (c='.') then begin
|
||||
if (SrcPos<l) then begin
|
||||
if (AFilename[SrcPos+1]=PathDelim) then begin
|
||||
// special dir ./
|
||||
// -> skip
|
||||
inc(SrcPos,2);
|
||||
continue;
|
||||
end else if (AFilename[SrcPos+1]='.')
|
||||
and (SrcPos+1=l) or (AFilename[SrcPos+2]=PathDelim) then
|
||||
begin
|
||||
// special dir ..
|
||||
// 1. .. -> copy
|
||||
// 2. /.. -> skip .., keep /
|
||||
// 3. C:.. -> copy
|
||||
// 4. C:\.. -> skip .., keep C:\
|
||||
// 5. \\.. -> skip .., keep \\
|
||||
// 6. xxx../.. -> copy
|
||||
// 7. xxxdir/.. -> trim dir and skip ..
|
||||
if DestPos=1 then begin
|
||||
// 1. .. -> copy
|
||||
end else if (DestPos=2) and (Result[1]=PathDelim) then begin
|
||||
// 2. /.. -> skip .., keep /
|
||||
inc(SrcPos,2);
|
||||
continue;
|
||||
{$IFDEF win32}
|
||||
end else if (DestPos=3) and (Result[2]=':')
|
||||
and (Result[1] in ['a'..'z','A'..'Z']) then begin
|
||||
// 3. C:.. -> copy
|
||||
end else if (DestPos=4) and (Result[2]=':') and (Result[3]=PathDelim)
|
||||
and (Result[1] in ['a'..'z','A'..'Z']) then begin
|
||||
// 4. C:\.. -> skip .., keep C:\
|
||||
inc(SrcPos,2);
|
||||
continue;
|
||||
end else if (DestPos=3) and (Result[1]=PathDelim)
|
||||
and (Result[2]=PathDelim) then begin
|
||||
// 5. \\.. -> skip .., keep \\
|
||||
inc(SrcPos,2);
|
||||
continue;
|
||||
{$ENDIF}
|
||||
end else if (DestPos>1) and (Result[DestPos-1]=PathDelim) then begin
|
||||
if (DestPos>3)
|
||||
and (Result[DestPos-2]='.') and (Result[DestPos-3]='.')
|
||||
and ((DestPos=4) or (Result[DestPos-4]=PathDelim)) then begin
|
||||
// 6. ../.. -> copy
|
||||
end else begin
|
||||
// 7. xxxdir/.. -> trim dir and skip ..
|
||||
DirStart:=DestPos-2;
|
||||
while (DirStart>1) and (Result[DirStart-1]<>PathDelim) do
|
||||
dec(DirStart);
|
||||
DestPos:=DirStart;
|
||||
inc(SrcPos,2);
|
||||
continue;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end else begin
|
||||
// special dir . at end of filename
|
||||
if DestPos=1 then begin
|
||||
Result:='.';
|
||||
exit;
|
||||
end else begin
|
||||
// skip
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
// copy directory
|
||||
repeat
|
||||
Result[DestPos]:=c;
|
||||
inc(DestPos);
|
||||
inc(SrcPos);
|
||||
if (SrcPos>l) then break;
|
||||
c:=AFilename[SrcPos];
|
||||
if c=PathDelim then break;
|
||||
until false;
|
||||
end;
|
||||
// trim result
|
||||
if DestPos<=length(AFilename) then
|
||||
SetLength(Result,DestPos-1);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function CompareFileExt(const Filename, Ext: string;
|
||||
CaseSensitive: boolean): integer;
|
||||
------------------------------------------------------------------------------}
|
||||
function CompareFileExt(const Filename, Ext: string;
|
||||
CaseSensitive: boolean): integer;
|
||||
var
|
||||
FileLen, FilePos, ExtLen, ExtPos: integer;
|
||||
FileChar, ExtChar: char;
|
||||
begin
|
||||
FileLen:=length(Filename);
|
||||
ExtLen:=length(Ext);
|
||||
FilePos:=FileLen;
|
||||
while (FilePos>=1) and (Filename[FilePos]<>'.') do dec(FilePos);
|
||||
if FilePos<1 then begin
|
||||
// no extension in filename
|
||||
Result:=1;
|
||||
exit;
|
||||
end;
|
||||
// skip point
|
||||
inc(FilePos);
|
||||
ExtPos:=1;
|
||||
if (ExtPos<=ExtLen) and (Ext[1]='.') then inc(ExtPos);
|
||||
// compare extensions
|
||||
while true do begin
|
||||
if FilePos<=FileLen then begin
|
||||
if ExtPos<=ExtLen then begin
|
||||
FileChar:=Filename[FilePos];
|
||||
ExtChar:=Ext[ExtPos];
|
||||
if not CaseSensitive then begin
|
||||
FileChar:=UpChars[FileChar];
|
||||
ExtChar:=UpChars[ExtChar];
|
||||
end;
|
||||
if FileChar=ExtChar then begin
|
||||
inc(FilePos);
|
||||
inc(ExtPos);
|
||||
end else if FileChar>ExtChar then begin
|
||||
Result:=1;
|
||||
exit;
|
||||
end else begin
|
||||
Result:=-1;
|
||||
exit;
|
||||
end;
|
||||
end else begin
|
||||
// fileext longer than ext
|
||||
Result:=1;
|
||||
exit;
|
||||
end;
|
||||
end else begin
|
||||
if ExtPos<=ExtLen then begin
|
||||
// fileext shorter than ext
|
||||
Result:=-1;
|
||||
exit;
|
||||
end else begin
|
||||
// equal
|
||||
Result:=0;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function ChompPathDelim(const Path: string): string;
|
||||
------------------------------------------------------------------------------}
|
||||
function ChompPathDelim(const Path: string): string;
|
||||
begin
|
||||
if (Path<>'') and (Path[length(Path)]=PathDelim) then
|
||||
Result:=LeftStr(Path,length(Path)-1)
|
||||
else
|
||||
Result:=Path;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function FileIsText(const AFilename: string): boolean;
|
||||
------------------------------------------------------------------------------}
|
||||
function FileIsText(const AFilename: string): boolean;
|
||||
var fs: TFileStream;
|
||||
Buf: string;
|
||||
Len, i: integer;
|
||||
NewLine: boolean;
|
||||
begin
|
||||
Result:=false;
|
||||
try
|
||||
fs:=TFileStream.Create(AFilename,fmOpenRead);
|
||||
try
|
||||
// read the first 1024 bytes
|
||||
Len:=1024;
|
||||
if Len>fs.Size then Len:=fs.Size;
|
||||
if Len>0 then begin
|
||||
SetLength(Buf,Len);
|
||||
fs.Read(Buf[1],length(Buf));
|
||||
NewLine:=false;
|
||||
for i:=1 to length(Buf) do begin
|
||||
case Buf[i] of
|
||||
#0..#8,#11..#12,#14..#31: exit;
|
||||
#10,#13: NewLine:=true;
|
||||
end;
|
||||
end;
|
||||
if NewLine or (Len<1024) then
|
||||
Result:=true;
|
||||
end else
|
||||
Result:=true;
|
||||
finally
|
||||
fs.Free;
|
||||
end;
|
||||
except
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function FileIsReadable(const AFilename: string): boolean;
|
||||
------------------------------------------------------------------------------}
|
||||
function FileIsReadable(const AFilename: string): boolean;
|
||||
begin
|
||||
{$IFDEF win32}
|
||||
Result:=true;
|
||||
{$ELSE}
|
||||
Result:={$IFDEF Ver1_0}Linux{$ELSE}Unix{$ENDIF}.Access(
|
||||
AFilename,{$IFDEF Ver1_0}Linux{$ELSE}Unix{$ENDIF}.R_OK);
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
FileIsWritable
|
||||
------------------------------------------------------------------------------}
|
||||
@ -138,9 +408,175 @@ begin
|
||||
FileDateToDateTime(FileAge(AFilename)));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function ExtractFileNameOnly(const AFilename: string): string;
|
||||
------------------------------------------------------------------------------}
|
||||
function ExtractFileNameOnly(const AFilename: string): string;
|
||||
var ExtLen: integer;
|
||||
begin
|
||||
Result:=ExtractFilename(AFilename);
|
||||
ExtLen:=length(ExtractFileExt(Result));
|
||||
Result:=copy(Result,1,length(Result)-ExtLen);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function FileIsExecutable(const AFilename: string): boolean;
|
||||
------------------------------------------------------------------------------}
|
||||
function FileIsExecutable(const AFilename: string): boolean;
|
||||
begin
|
||||
try
|
||||
CheckIfFileIsExecutable(AFilename);
|
||||
Result:=true;
|
||||
except
|
||||
Result:=false;
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
procedure CheckIfFileIsExecutable(const AFilename: string);
|
||||
------------------------------------------------------------------------------}
|
||||
procedure CheckIfFileIsExecutable(const AFilename: string);
|
||||
{$IFNDEF win32}
|
||||
var AText: string;
|
||||
{$ENDIF}
|
||||
begin
|
||||
// TProcess does not report, if a program can not be executed
|
||||
// to get good error messages consider the OS
|
||||
if not FileExists(AFilename) then begin
|
||||
raise Exception.Create('file "'+AFilename+'" does not exist');
|
||||
end;
|
||||
{$IFNDEF win32}
|
||||
if not{$IFDEF Ver1_0}Linux{$ELSE}Unix{$ENDIF}.Access(
|
||||
AFilename,{$IFDEF Ver1_0}Linux{$ELSE}Unix{$ENDIF}.X_OK) then
|
||||
begin
|
||||
AText:='"'+AFilename+'"';
|
||||
case LinuxError of
|
||||
sys_eacces: AText:='execute access denied for '+AText;
|
||||
sys_enoent: AText:='a directory component in '+AText
|
||||
+' does not exist or is a dangling symlink';
|
||||
sys_enotdir: AText:='a directory component in '+Atext+' is not a directory';
|
||||
sys_enomem: AText:='insufficient memory';
|
||||
sys_eloop: AText:=AText+' has a circular symbolic link';
|
||||
else
|
||||
AText:=AText+' is not executable';
|
||||
end;
|
||||
raise Exception.Create(AText);
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
// ToDo: windows and xxxbsd
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function ForceDirectory(DirectoryName: string): boolean;
|
||||
------------------------------------------------------------------------------}
|
||||
function ForceDirectory(DirectoryName: string): boolean;
|
||||
var i: integer;
|
||||
Dir: string;
|
||||
begin
|
||||
DoDirSeparators(DirectoryName);
|
||||
i:=1;
|
||||
while i<=length(DirectoryName) do begin
|
||||
if DirectoryName[i]=PathDelim then begin
|
||||
Dir:=copy(DirectoryName,1,i-1);
|
||||
if not DirectoryExists(Dir) then begin
|
||||
Result:=CreateDir(Dir);
|
||||
if not Result then exit;
|
||||
end;
|
||||
end;
|
||||
inc(i);
|
||||
end;
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function CleanAndExpandFilename(const Filename: string): string;
|
||||
------------------------------------------------------------------------------}
|
||||
function CleanAndExpandFilename(const Filename: string): string;
|
||||
begin
|
||||
Result:=ExpandFilename(TrimFileName(Filename));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function CleanAndExpandDirectory(const Filename: string): string;
|
||||
------------------------------------------------------------------------------}
|
||||
function CleanAndExpandDirectory(const Filename: string): string;
|
||||
begin
|
||||
Result:=AppendPathDelim(CleanAndExpandFilename(Filename));
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
function SearchFileInPath(const Filename, BasePath, SearchPath,
|
||||
Delimiter: string; SearchLoUpCase: boolean): string;
|
||||
------------------------------------------------------------------------------}
|
||||
function SearchFileInPath(const Filename, BasePath, SearchPath,
|
||||
Delimiter: string; SearchLoUpCase: boolean): string;
|
||||
|
||||
function FileDoesExists(const AFilename: string): boolean;
|
||||
var s: string;
|
||||
begin
|
||||
s:=ExpandFilename(TrimFilename(AFilename));
|
||||
Result:=FileExists(s);
|
||||
if Result then begin
|
||||
SearchFileInPath:=s;
|
||||
exit;
|
||||
end;
|
||||
{$IFNDEF Win32}
|
||||
if SearchLoUpCase then begin
|
||||
|
||||
end;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
var
|
||||
p, StartPos, l: integer;
|
||||
CurPath, Base: string;
|
||||
begin
|
||||
//writeln('[SearchFileInPath] Filename="',Filename,'" BasePath="',BasePath,'" SearchPath="',SearchPath,'" Delimiter="',Delimiter,'"');
|
||||
if (Filename='') then begin
|
||||
Result:=Filename;
|
||||
exit;
|
||||
end;
|
||||
// check if filename absolute
|
||||
if FilenameIsAbsolute(Filename) then begin
|
||||
if FileExists(Filename) then begin
|
||||
Result:=ExpandFilename(Filename);
|
||||
exit;
|
||||
end else begin
|
||||
Result:='';
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
Base:=ExpandFilename(AppendPathDelim(BasePath));
|
||||
// search in current directory
|
||||
if FileExists(Base+Filename) then begin
|
||||
Result:=Base+Filename;
|
||||
exit;
|
||||
end;
|
||||
// search in search path
|
||||
StartPos:=1;
|
||||
l:=length(SearchPath);
|
||||
while StartPos<=l do begin
|
||||
p:=StartPos;
|
||||
while (p<=l) and (pos(SearchPath[p],Delimiter)<1) do inc(p);
|
||||
CurPath:=Trim(copy(SearchPath,StartPos,p-StartPos));
|
||||
if CurPath<>'' then begin
|
||||
if not FilenameIsAbsolute(CurPath) then
|
||||
CurPath:=Base+CurPath;
|
||||
Result:=ExpandFilename(AppendPathDelim(CurPath)+Filename);
|
||||
if FileExists(Result) then exit;
|
||||
end;
|
||||
StartPos:=p+1;
|
||||
end;
|
||||
Result:='';
|
||||
end;
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 2002/12/09 16:48:36 mattias
|
||||
added basic file handling functions to filectrl
|
||||
|
||||
Revision 1.3 2002/05/29 21:44:38 lazarus
|
||||
MG: improved TCommon/File/OpenDialog, fixed TListView scrolling and broder
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user