paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 12:49:33 +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
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,
but WITHOUT ANY WARRANTY; without even the implied warranty of
@ -45,7 +45,7 @@ TTarWriter Usage
- Now your tar file is ready.
Source
Source
--------------------------
The official site to get this code is http://www.destructor.de/
@ -86,13 +86,13 @@ INTERFACE
{$DEFINE Kylix}
{$DEFINE LIBCUNIT}
{$ENDIF}
{$ENDIF}
{$ENDIF}
USES
{$IFDEF LIBCUNIT}
Libc, // MvdV: Nothing is used from this???
{$ENDIF}
{$ifdef Unix}
{$ifdef Unix}
BaseUnix, Unix,
{$endif}
(*$IFDEF MSWINDOWS *)
@ -187,7 +187,7 @@ TYPE
CONSTRUCTOR Create (TargetStream : TStream); OVERLOAD;
CONSTRUCTOR Create (TargetFilename : STRING; Mode : INTEGER = fmCreate); OVERLOAD;
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 AddString (Contents : STRING; TarFilename : STRING; FileDateGmt : TDateTime);
PROCEDURE AddDir (Dirname : STRING; DateGmt : TDateTime; MaxDirSize : INT64 = 0);
@ -250,7 +250,7 @@ END;
FUNCTION ConvertFilename (Filename : STRING) : STRING;
// 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.
BEGIN
(*$IFDEF Unix *)
@ -787,17 +787,30 @@ BEGIN
END;
PROCEDURE TTarWriter.AddFile (Filename : STRING; TarFilename : STRING = '');
FUNCTION TTarWriter.AddFile (Filename : STRING; TarFilename : STRING = '') : BOOLEAN;
VAR
S : TFileStream;
Date : TDateTime;
BEGIN
AddFile:=false;
Date := FileTimeGMT (Filename);
IF TarFilename = '' THEN
TarFilename := ConvertFilename (Filename);
TRY
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
AddStream (S, TarFilename, Date);
// No error, AddFile succeeded
AddFile:=true;
FINALLY
S.Free
END;