mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-24 19:39:17 +02:00
aarre: compress via gzip
git-svn-id: trunk@41705 -
This commit is contained in:
parent
191934ab45
commit
33cfc279d4
@ -541,14 +541,23 @@ end;
|
|||||||
|
|
||||||
procedure TAarrePkgList.SaveToFile(const aFilename: string);
|
procedure TAarrePkgList.SaveToFile(const aFilename: string);
|
||||||
var
|
var
|
||||||
xml: TXMLConfig;
|
fs: TGZFileStream;
|
||||||
|
ms: TMemoryStream;
|
||||||
|
Cnt: LongInt;
|
||||||
begin
|
begin
|
||||||
xml:=TXMLConfig.Create(aFilename);
|
fs:=TGZFileStream.create(aFilename,gzopenwrite);
|
||||||
try
|
try
|
||||||
Save(XML,'');
|
ms:=TMemoryStream.Create;
|
||||||
xml.Flush;
|
try
|
||||||
|
SaveToStream(ms);
|
||||||
|
Cnt:=fs.write(ms.Memory^,ms.Size);
|
||||||
|
if Cnt<ms.Size then
|
||||||
|
raise Exception.Create('write error "'+aFilename+'"');
|
||||||
finally
|
finally
|
||||||
xml.Free;
|
ms.Free;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
fs.Free;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user