paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-13 09:39:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

Change AddFile method from procedure to boolean function

Browse Source 
git-svn-id: trunk@29269 -
This commit is contained in:
pierre 2014-12-12 13:55:26 +00:00
parent ec24138bfa
commit 43213dc637
1 changed files with 20 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
tests/utils/libtar.pas
View File

@ -2,7 +2,7 @@
Copyright (c) 2000-2006 by Stefan Heymann Copyright (c) 2000-2006 by Stefan Heymann
See the file COPYING.FPC, included in this distribution, See the file COPYING.FPC, included in this distribution,
for details about the copyright. for details about the copyright.
This program is distributed in the hope that it will be useful, This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of but WITHOUT ANY WARRANTY; without even the implied warranty of
@ -45,7 +45,7 @@ TTarWriter Usage
- Now your tar file is ready. - Now your tar file is ready.
Source Source
-------------------------- --------------------------
The official site to get this code is http://www.destructor.de/ The official site to get this code is http://www.destructor.de/
@ -86,13 +86,13 @@ INTERFACE
{$DEFINE Kylix} {$DEFINE Kylix}
{$DEFINE LIBCUNIT} {$DEFINE LIBCUNIT}
{$ENDIF} {$ENDIF}
{$ENDIF} {$ENDIF}
USES USES
{$IFDEF LIBCUNIT} {$IFDEF LIBCUNIT}
Libc, // MvdV: Nothing is used from this??? Libc, // MvdV: Nothing is used from this???
{$ENDIF} {$ENDIF}
{$ifdef Unix} {$ifdef Unix}
BaseUnix, Unix, BaseUnix, Unix,
{$endif} {$endif}
(*$IFDEF MSWINDOWS *) (*$IFDEF MSWINDOWS *)
@ -187,7 +187,7 @@ TYPE
CONSTRUCTOR Create (TargetStream : TStream); OVERLOAD; CONSTRUCTOR Create (TargetStream : TStream); OVERLOAD;
CONSTRUCTOR Create (TargetFilename : STRING; Mode : INTEGER = fmCreate); OVERLOAD; CONSTRUCTOR Create (TargetFilename : STRING; Mode : INTEGER = fmCreate); OVERLOAD;
DESTRUCTOR Destroy; OVERRIDE; // Writes End-Of-File Tag DESTRUCTOR Destroy; OVERRIDE; // Writes End-Of-File Tag
PROCEDURE AddFile (Filename : STRING; TarFilename : STRING = ''); FUNCTION AddFile (Filename : STRING; TarFilename : STRING = '') : BOOLEAN;
PROCEDURE AddStream (Stream : TStream; TarFilename : STRING; FileDateGmt : TDateTime); PROCEDURE AddStream (Stream : TStream; TarFilename : STRING; FileDateGmt : TDateTime);
PROCEDURE AddString (Contents : STRING; TarFilename : STRING; FileDateGmt : TDateTime); PROCEDURE AddString (Contents : STRING; TarFilename : STRING; FileDateGmt : TDateTime);
PROCEDURE AddDir (Dirname : STRING; DateGmt : TDateTime; MaxDirSize : INT64 = 0); PROCEDURE AddDir (Dirname : STRING; DateGmt : TDateTime; MaxDirSize : INT64 = 0);
@ -250,7 +250,7 @@ END;
FUNCTION ConvertFilename (Filename : STRING) : STRING; FUNCTION ConvertFilename (Filename : STRING) : STRING;
// Converts the filename to Unix conventions // Converts the filename to Unix conventions
// could be empty and inlined away for FPC. FPC I/O should be // could be empty and inlined away for FPC. FPC I/O should be
// forward/backward slash safe. // forward/backward slash safe.
BEGIN BEGIN
(*$IFDEF Unix *) (*$IFDEF Unix *)
@ -787,17 +787,30 @@ BEGIN
END; END;
PROCEDURE TTarWriter.AddFile (Filename : STRING; TarFilename : STRING = ''); FUNCTION TTarWriter.AddFile (Filename : STRING; TarFilename : STRING = '') : BOOLEAN;
VAR VAR
S : TFileStream; S : TFileStream;
Date : TDateTime; Date : TDateTime;
BEGIN BEGIN
AddFile:=false;
Date := FileTimeGMT (Filename); Date := FileTimeGMT (Filename);
IF TarFilename = '' THEN IF TarFilename = '' THEN
TarFilename := ConvertFilename (Filename); TarFilename := ConvertFilename (Filename);
TRY
S := TFileStream.Create (Filename, fmOpenRead OR fmShareDenyWrite); S := TFileStream.Create (Filename, fmOpenRead OR fmShareDenyWrite);
EXCEPT
ON EFOpenError DO
BEGIN
Writeln(stderr,'LibTar error: unable to open file "',Filename,'" for reading.');
S.Free;
exit;
END;
END;
TRY TRY
AddStream (S, TarFilename, Date); AddStream (S, TarFilename, Date);
// No error, AddFile succeeded
AddFile:=true;
FINALLY FINALLY
S.Free S.Free
END; END;