mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-13 14:19:31 +02:00
+ added tar creation
git-svn-id: trunk@5046 -
This commit is contained in:
parent
0f6355e805
commit
bfeae0c5f1
@ -18,19 +18,30 @@
|
|||||||
program prepup;
|
program prepup;
|
||||||
|
|
||||||
uses
|
uses
|
||||||
sysutils;
|
sysutils,libtar,zstream;
|
||||||
|
|
||||||
|
var
|
||||||
|
tarwriter : ttarwriter;
|
||||||
|
c : tgzfilestream;
|
||||||
|
|
||||||
procedure dosearch(const dir : string);
|
procedure dosearch(const dir : string);
|
||||||
|
|
||||||
procedure domask(const s : string);
|
procedure domask(const s : string);
|
||||||
Var Info : TSearchRec;
|
Var
|
||||||
|
Info : TSearchRec;
|
||||||
|
hs : string;
|
||||||
|
i : integer;
|
||||||
begin
|
begin
|
||||||
If FindFirst (dir+DirectorySeparator+s,faAnyFile,Info)=0 then
|
If FindFirst (dir+DirectorySeparator+s,faAnyFile,Info)=0 then
|
||||||
begin
|
begin
|
||||||
Repeat
|
Repeat
|
||||||
With Info do
|
With Info do
|
||||||
writeln (dir+DirectorySeparator+Name);
|
begin
|
||||||
|
hs:=dir+DirectorySeparator+Name;
|
||||||
|
{ strip leading ./ }
|
||||||
|
delete(hs,1,2);
|
||||||
|
tarwriter.addfile(hs);
|
||||||
|
end;
|
||||||
Until FindNext(info)<>0;
|
Until FindNext(info)<>0;
|
||||||
end;
|
end;
|
||||||
FindClose(Info);
|
FindClose(Info);
|
||||||
@ -41,13 +52,13 @@ Var Info : TSearchRec;
|
|||||||
Begin
|
Begin
|
||||||
If FindFirst (dir+DirectorySeparator+'*',faDirectory,Info)=0 then
|
If FindFirst (dir+DirectorySeparator+'*',faDirectory,Info)=0 then
|
||||||
begin
|
begin
|
||||||
Repeat
|
Repeat
|
||||||
With Info do
|
With Info do
|
||||||
begin
|
begin
|
||||||
If ((Attr and faDirectory) = faDirectory) and (name<>'.') and (name<>'..') then
|
If ((Attr and faDirectory) = faDirectory) and (name<>'.') and (name<>'..') then
|
||||||
dosearch(dir+DirectorySeparator+name);
|
dosearch(dir+DirectorySeparator+name);
|
||||||
end;
|
end;
|
||||||
Until FindNext(info)<>0;
|
Until FindNext(info)<>0;
|
||||||
end;
|
end;
|
||||||
FindClose(Info);
|
FindClose(Info);
|
||||||
domask('*.elg');
|
domask('*.elg');
|
||||||
@ -55,7 +66,19 @@ Begin
|
|||||||
End;
|
End;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
if paramcount<>1 then
|
||||||
|
begin
|
||||||
|
writeln('Usage: prepup <name of .tar.gz>');
|
||||||
|
halt(1);
|
||||||
|
end;
|
||||||
|
C:=TGZFileStream.Create(paramstr(1),gzOpenWrite);
|
||||||
|
TarWriter := TTarWriter.Create (C);
|
||||||
dosearch('.');
|
dosearch('.');
|
||||||
|
TarWriter.AddFile('dbdigest.cfg');
|
||||||
|
TarWriter.AddFile('log');
|
||||||
|
|
||||||
|
TarWriter.free;
|
||||||
|
c.free;
|
||||||
end.
|
end.
|
||||||
|
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user