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

fixed backuping symlinks

Browse Source 
git-svn-id: trunk@3394 -
This commit is contained in:
mattias 2002-10-01 15:45:24 +00:00
parent 3ce0e4a00f
commit a984b4d733
1 changed files with 19 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
ide/ideprocs.pp
View File

@ -30,7 +30,8 @@ unit IDEProcs;
interface
uses
Classes, SysUtils, Laz_XMLCfg, GetText, FileProcs;
Classes, SysUtils, Laz_XMLCfg, GetText,
FileCtrl, FileProcs;
type
TCommentType = (
@ -527,17 +528,29 @@ var
{$ENDIF}
begin
Result:=false;
// store file attributes
{$IFDEF Win32}
OldAttr:=FileGetAttr(Filename);
{$ELSE}
FStat(Filename,OldInfo);
{$ENDIF}
// rename file
if not RenameFile(Filename,BackupFilename) then exit;
// create empty file
FHandle:=FileCreate(FileName);
FileClose(FHandle);
if not FileIsSymlink(Filename) then begin
// not a symlink
// rename old file, create empty new file
// rename file
if not RenameFile(Filename,BackupFilename) then exit;
// create empty file
FHandle:=FileCreate(FileName);
FileClose(FHandle);
end else begin
// file is a symlink
// -> copy file
if not CopyFile(Filename,BackupFilename) then exit;
end;
// restore file attributes
{$IFDEF Win32}
FileSetAttr(FileName,OldAttr);