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

MG: backuping files now save file attributes/permissions

Browse Source 
git-svn-id: trunk@1684 -
This commit is contained in:
lazarus 2002-05-16 14:01:45 +00:00
parent 78372e4147
commit 15aa57881a
2 changed files with 59 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
ide/ideprocs.pp
View File

@ -41,6 +41,7 @@ const
function FilenameIsAbsolute(Filename: string):boolean;
function DirectoryExists(DirectoryName: string): boolean;
function ForceDirectory(DirectoryName: string): boolean;
function BackupFile(const Filename, BackupFilename: string): boolean;
function ExtractFileNameOnly(const AFilename: string): string;
procedure CheckIfFileIsExecutable(const AFilename: string);
function FileIsExecutable(const AFilename: string): boolean;
@ -489,4 +490,46 @@ begin
Obj:=nil;
end;
{-------------------------------------------------------------------------------
BackupFile
Params: const Filename, BackupFilename: string
Result: boolean
Rename Filename to Backupfilename and create empty Filename with same
file attributes
-------------------------------------------------------------------------------}
function BackupFile(const Filename, BackupFilename: string): boolean;
var
FHandle: Integer;
{$IFDEF Win32}
OldAttr: Longint;
{$ELSE}
OldInfo: Stat;
{$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);
// restore file attributes
{$IFDEF Win32}
FileSetAttr(FileName,OldAttr);
{$ELSE}
Chmod(Filename,
OldInfo.Mode and (STAT_IRWXO+STAT_IRWXG+STAT_IRWXU
+STAT_ISUID+STAT_ISGID+STAT_ISVTX));
{$ENDIF}
Result:=true;
end;
end.

21
ide/main.pp
View File

@ -4733,6 +4733,15 @@ begin
until Result<>mrRetry;
end;
{-------------------------------------------------------------------------------
TMainIDE DoBackupFile
Params: const Filename:string;
IsPartOfProject:boolean
Returns: TModalResult
Rename existing file to backup file.
-------------------------------------------------------------------------------}
function TMainIDE.DoBackupFile(const Filename:string;
IsPartOfProject:boolean): TModalResult;
var BackupFilename, CounterFilename: string;
@ -4752,8 +4761,7 @@ begin
exit;
FilePath:=ExtractFilePath(Filename);
FileExt:=ExtractFileExt(Filename);
FileNameOnly:=ExtractFilename(Filename);
FileNameOnly:=copy(FilenameOnly,1,length(FilenameOnly)-length(FileExt));
FileNameOnly:=ExtractFilenameOnly(Filename);
if BackupInfo.SubDirectory<>'' then begin
SubDir:=FilePath+BackupInfo.SubDirectory;
repeat
@ -4853,9 +4861,9 @@ begin
end;
// backup file
repeat
if not RenameFile(Filename,BackupFilename) then begin
ACaption:='Rename file failed';
AText:='Unable to rename file "'+Filename+'" to "'+BackupFilename+'"!';
if not BackupFile(Filename,BackupFilename) then begin
ACaption:='Backup file failed';
AText:='Unable to backup file "'+Filename+'" to "'+BackupFilename+'"!';
Result:=MessageDlg(ACaption,AText,mterror,[mbabort,mbretry,mbignore],0);
if Result=mrAbort then exit;
if Result=mrIgnore then Result:=mrOk;
@ -6362,6 +6370,9 @@ end.
{ =============================================================================
$Log$
Revision 1.296 2002/05/16 14:01:45 lazarus
MG: backuping files now save file attributes/permissions
Revision 1.295 2002/05/16 13:00:55 lazarus
MG: fixed changing syntax highlighter on save as