erabo/spiegel-keyman
1
0
Fork 0
mirror of https://github.com/keymanapp/keyman.git synced 2026-09-19 06:07:40 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions 10

fix(developer): show more useful error if out of space during Setup

Browse source 
Fixes #7261.
This commit is contained in:
Marc Durdin 2022-09-12 12:02:09 +10:00
parent 59262dc747
commit fbb3375ed9
1 changed files with 28 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

45
common/windows/delphi/setup/SFX.pas
View file

@ -82,27 +82,38 @@ var
fs: TFileStream;
ms: TMemoryStream;
begin
fs := TFileStream.Create(ParamStr(0), fmOpenRead or fmShareDenyWrite);
ms := TMemoryStream.Create;
try
if not FindFirstHeader(fs) then
Exit(False);
fs.Seek(StartOfFile, TSeekOrigin.soBeginning);
ms.CopyFrom(fs, fs.Size - StartOfFile);
ms.Position := 0;
with TZipFile.Create do
fs := TFileStream.Create(ParamStr(0), fmOpenRead or fmShareDenyWrite);
ms := TMemoryStream.Create;
try
Open(ms, zmRead);
ExtractAll(ExtPath);
if not FindFirstHeader(fs) then
Exit(False);
fs.Seek(StartOfFile, TSeekOrigin.soBeginning);
ms.CopyFrom(fs, fs.Size - StartOfFile);
ms.Position := 0;
with TZipFile.Create do
try
Open(ms, zmRead);
ExtractAll(ExtPath);
finally
Free;
end;
finally
Free;
fs.Free;
ms.Free;
end;
except
on E:Exception do
begin
raise Exception.Create(
'Failed to extract setup archive. '+
'You may have run out of disk space or there may be a '+
'problem with the source files.'#13#10#13#10+
'The error received was: '+E.Message);
end;
finally
fs.Free;
ms.Free;
end;
Result := True;
end;