{ ***************************************************************************** * * * This file is part of the iPhone Laz Extension * * * * See the file COPYING.modifiedLGPL.txt, included in this distribution, * * for details about the copyright. * * * * This program is distributed in the hope that it will be useful, * * but WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * * * ***************************************************************************** } unit LazFilesUtils; {$mode objfpc}{$H+} interface uses {$ifdef Unix}BaseUnix,{$endif} Classes, SysUtils, FileUtil, Masks, LazIDEIntf, ProjectIntf, process; function ResolveProjectPath(const path: string; project: TLazProject = nil): string; function BreakPathsStringToOption(const Paths, Switch: String; const Quotes: string = '"'; project: TLazProject = nil): String; function RelativeToFullPath(const BasePath, Relative: string): String; function NeedQuotes(const path: string): Boolean; function CopySymLinks(const SrcDir, DstDir, FilterMask: string): Boolean; procedure EnumFilesAtDir(const PathUtf8 : AnsiString; Dst: TStrings); procedure EnumFilesAtDir(const PathUtf8, AMask : AnsiString; Dst: TStrings); procedure ExecCmdLineNoWait(const CmdLineUtf8: AnsiString); implementation {$ifdef Unix} function CopySymLinks(const SrcDir, DstDir, FilterMask: string): Boolean; var allfiles : TStringList; i : Integer; pth : string; MaskList : TMaskList; curdir : string; linkdir : string; linkname : string; begin Result:=DirectoryExistsUTF8(SrcDir) and ForceDirectoriesUTF8(DstDir); if not Result then Exit; //todo: don't use FindAllFiles(), use sub dir search allfiles:=FindAllFiles(SrcDir, AllFilesMask, False); Result:=Assigned(allfiles); if not Result then Exit; MaskList := TMaskList.Create(FilterMask); curdir:=IncludeTrailingPathDelimiter(SrcDir); linkdir:=IncludeTrailingPathDelimiter(DstDir); for i:=0 to allfiles.Count-1 do begin pth:=allfiles[i]; if (FilterMask='') or (not MaskList.Matches(pth)) then begin linkname:=linkdir+Copy(pth, length(curdir), length(pth)); fpSymlink(PAnsiChar(pth), PAnsiChar(linkname)); end; end; allfiles.Free; end; {$else} function CopySymLinks(const SrcDir, DstDir, FilterMask: string): Boolean; begin Result:=false; end; {$endif} function GetNextDir(const Path: string; var index: integer; var Name: string): Boolean; var i : Integer; begin Result:=index<=length(Path); if not Result then Exit; if Path[index]=PathDelim then inc(index); Result:=index<=length(Path); if not Result then Exit; for i:=index to length(Path) do if Path[i]=PathDelim then begin Name:=Copy(Path, index, i - index); index:=i+1; Exit; end; Name:=Copy(Path, index, length(Path) - index+1); index:=length(Path)+1; end; function RelativeToFullPath(const BasePath, Relative: string): String; var i : integer; nm : string; begin Result:=ExcludeTrailingPathDelimiter(BasePath); i:=1; while GetNextDir(Relative, i, nm) do if nm = '..' then Result:=ExtractFileDir(Result) else if nm <> '.' then Result:=IncludeTrailingPathDelimiter(Result)+nm; end; function NeedQuotes(const path: string): Boolean; var i : integer; const SpaceChars = [#32,#9]; begin for i:=1 to length(path) do if path[i] in SpaceChars then begin Result:=true; Exit; end; Result:=false; end; function QuoteStrIfNeeded(const path: string; const quotes: String): String; begin if NeedQuotes(path) then Result:=quotes+path+quotes else Result:=path; end; function ResolveProjectPath(const path: string; project: TLazProject): string; var base : string; begin if project=nil then project:=LazarusIDE.ActiveProject; if FilenameIsAbsolute(Path) then Result:=Path else begin base:=''; base:=ExtractFilePath(project.ProjectInfoFile); Result:=RelativeToFullPath(base, Path); end; end; function BreakPathsStringToOption(const Paths, Switch, Quotes: String; project: TLazProject): String; var i, j : Integer; fixed : String; begin Result:=''; if not Assigned(project) then project:=LazarusIDE.ActiveProject; if not Assigned(project) then Exit; j:=1; for i:=1 to length(paths)-1 do if Paths[i]=';' then begin fixed:=Trim(Copy(paths,j, i-j) ); if fixed<>'' then begin fixed:=ResolveProjectPath(fixed, project); Result:=Result+' ' + Switch + QuoteStrIfNeeded(fixed, quotes); end; j:=i+1; end; fixed:=Trim(Copy(paths,j, length(paths)-j+1) ); if fixed<>'' then begin fixed:=ResolveProjectPath(fixed, project); Result:=Result+' ' + Switch + QuoteStrIfNeeded(fixed, quotes); end; end; procedure EnumFilesAtDir(const PathUtf8, AMask : AnsiString; Dst: TStrings); var mask : TMask; sr : TSearchRec; path : AnsiString; begin if (AMask='') or (trim(AMask)='*') then mask:=nil else mask:=TMask.Create(AMask); try path:=IncludeTrailingPathDelimiter(PathUtf8); if FindFirstUTF8(path+AllFilesMask, faAnyFile, sr) = 0 then begin repeat if (sr.Name<>'.') and (sr.Name<>'..') then if not Assigned(mask) or mask.Matches(sr.Name) then Dst.Add(path+sr.Name); until FindNextUTF8(sr)<>0; FindCloseUTF8(sr); end; finally mask.Free; end; end; procedure EnumFilesAtDir(const PathUtf8 : AnsiString; Dst: TStrings); begin EnumFilesAtDir(PathUTF8, AllFilesMask, Dst); end; procedure ExecCmdLineNoWait(const CmdLineUtf8: AnsiString); var proc : TProcess; begin proc:=TProcess.Create(nil); try proc.CommandLine:=CmdLineUtf8; //proc.WaitOnExit:=WaitExit; proc.Execute; finally proc.Free; end; end; end.