mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-11 09:26:15 +02:00
+ archive validity checking, progress indicator, better error checking
This commit is contained in:
Tomas Hajny
parent
a2aca573f4
commit
f6bcd5c791
@ -86,6 +86,10 @@ program install;
|
||||
|
||||
CfgExt = '.dat';
|
||||
|
||||
MaxStatusPos = 4;
|
||||
StatusChars: string [MaxStatusPos] = '/-\|';
|
||||
StatusPos: byte = 1;
|
||||
|
||||
{$ifdef linux}
|
||||
DirSep='/';
|
||||
{$else}
|
||||
@ -184,6 +188,12 @@ program install;
|
||||
CfgName: NameStr;
|
||||
DStr: DirStr;
|
||||
EStr: ExtStr;
|
||||
UnzDlg : punzipdialog;
|
||||
{$IFNDEF DLL}
|
||||
|
||||
const
|
||||
UnzipErr: longint = 0;
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
@ -283,8 +293,11 @@ program install;
|
||||
s : string;
|
||||
begin
|
||||
s:=zipfile+#0;
|
||||
uncompressed:=UnzipSize(@s[1],compressed);
|
||||
DiskSpaceN:=uncompressed shr 10;
|
||||
if not (IsZip (@S [1])) then DiskSpaceN := -1 else
|
||||
begin
|
||||
Uncompressed:=UnzipSize(@s[1],compressed);
|
||||
DiskSpaceN:=uncompressed shr 10;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -294,8 +307,11 @@ program install;
|
||||
s : string;
|
||||
begin
|
||||
uncompressed:=DiskSpaceN (zipfile);
|
||||
str(uncompressed,s);
|
||||
diskspace:=' ('+s+' KB)';
|
||||
if Uncompressed = -1 then DiskSpace := ' [INVALID]' else
|
||||
begin
|
||||
str(uncompressed,s);
|
||||
diskspace:=' ('+s+' KB)';
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -412,41 +428,65 @@ program install;
|
||||
r : trect;
|
||||
begin
|
||||
inherited init(bounds,atitle);
|
||||
R.Assign(11, 4, 38, 5);
|
||||
filetext:=new(pstatictext,init(r,'File: '));
|
||||
(* R.Assign (11, 4, 38, 6);*)
|
||||
R.Assign (1, 4, 39, 6);
|
||||
filetext:=new(pstatictext,init(r,#3'File: '));
|
||||
insert(filetext);
|
||||
end;
|
||||
|
||||
{$IFNDEF DLL}
|
||||
procedure UnzipCheckFn (Retcode: longint; Rec: pReportRec );{$ifdef Delphi32}STDCALL;{$endif}
|
||||
{$IFNDEF BIT32} FAR;{$ENDIF BIT32}
|
||||
begin
|
||||
case Rec^.Status of
|
||||
unzip_starting: UnzipErr := 0;
|
||||
file_failure: UnzipErr := RetCode;
|
||||
file_unzipping:
|
||||
begin
|
||||
with UnzDlg^.FileText^ do
|
||||
begin
|
||||
Inc (StatusPos);
|
||||
if StatusPos > MaxStatusPos then StatusPos := 1;
|
||||
Text^ [Length (Text^)] := StatusChars [StatusPos];
|
||||
DrawView;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
procedure tunzipdialog.do_unzip(s,topath : string);
|
||||
var
|
||||
again : boolean;
|
||||
fn,dir,wild : string;
|
||||
Cnt: integer;
|
||||
begin
|
||||
Disposestr(filetext^.text);
|
||||
filetext^.Text:=NewStr('File: '+s);
|
||||
filetext^.Text:=NewStr(#3'File: '+s + #13#3' ');
|
||||
filetext^.drawview;
|
||||
if not(file_exists(s,startpath)) then
|
||||
begin
|
||||
messagebox('File: '+s+' missed for the selected installation. '+
|
||||
'Installation doesn''t becomes complete',nil,mferror+mfokbutton);
|
||||
messagebox('File "'+s+'" missing for the selected installation. '+
|
||||
'Installation hasn''t been completed.',nil,mferror+mfokbutton);
|
||||
errorhalt;
|
||||
end;
|
||||
{$IFNDEF DLL}
|
||||
{$IFDEF FPC}
|
||||
SetUnzipReportProc (@UnzipCheckFn);
|
||||
{$ELSE FPC}
|
||||
SetUnzipReportProc (UnzipCheckFn);
|
||||
{$ENDIF FPC}
|
||||
{$ENDIF DLL}
|
||||
repeat
|
||||
fn:=startpath+DirSep+s+#0;
|
||||
dir:=topath+#0;
|
||||
wild:=AllFiles + #0;
|
||||
DosError := 0;
|
||||
again:=false;
|
||||
{$IFDEF DLL}
|
||||
doserror:=FileUnzipEx(@fn[1],@dir[1],@wild[1]);
|
||||
{$ELSE}
|
||||
FileUnzipEx(@fn[1],@dir[1],@wild[1]);
|
||||
{$ENDIF}
|
||||
if (doserror<>0) then
|
||||
if (UnzipErr <> 0) then
|
||||
begin
|
||||
str(doserror,s);
|
||||
if messagebox('Error ('+s+') when extracting. Disk full?'#13+
|
||||
Str(UnzipErr,s);
|
||||
if messagebox('Error (' + S + ') while extracting. Disk full?'#13+
|
||||
#13#3'Try again?',nil,mferror+mfyesbutton+mfnobutton)=cmNo then
|
||||
errorhalt
|
||||
else
|
||||
@ -578,7 +618,7 @@ program install;
|
||||
begin
|
||||
f:=nil;
|
||||
{ walk packages reverse and insert a newsitem for each, and set the mask }
|
||||
for j:=1to cfg.packs do
|
||||
for j:=1 to cfg.packs do
|
||||
with cfg.pack[j] do
|
||||
begin
|
||||
firstitem[j]:=0;
|
||||
@ -599,7 +639,7 @@ program install;
|
||||
|
||||
{ If no component found abort }
|
||||
found:=false;
|
||||
for j:=1to cfg.packs do
|
||||
for j:=1 to cfg.packs do
|
||||
if packmask[j]<>0 then
|
||||
found:=true;
|
||||
if not found then
|
||||
@ -643,7 +683,7 @@ program install;
|
||||
data.cfgval:=1;
|
||||
|
||||
{-------- Pack Sheets ----------}
|
||||
for j:=1to cfg.packs do
|
||||
for j:=1 to cfg.packs do
|
||||
begin
|
||||
R.Copy(TabIR);
|
||||
new(packcbs[j],init(r,items[j]));
|
||||
@ -694,7 +734,6 @@ program install;
|
||||
procedure tapp.do_installdialog;
|
||||
var
|
||||
p : pinstalldialog;
|
||||
p2 : punzipdialog;
|
||||
p3 : penddialog;
|
||||
r : trect;
|
||||
result,
|
||||
@ -702,13 +741,13 @@ program install;
|
||||
i,j : longint;
|
||||
found : boolean;
|
||||
{$ifndef linux}
|
||||
DSize,Space : longint;
|
||||
DSize,Space,ASpace : longint;
|
||||
S: DirStr;
|
||||
{$endif}
|
||||
begin
|
||||
data.basepath:=cfg.basepath;
|
||||
data.cfgval:=0;
|
||||
for j:=1to cfg.packs do
|
||||
for j:=1 to cfg.packs do
|
||||
data.packmask[j]:=$ffff;
|
||||
|
||||
repeat
|
||||
@ -722,7 +761,7 @@ program install;
|
||||
else
|
||||
begin
|
||||
found:=false;
|
||||
for j:=1to cfg.packs do
|
||||
for j:=1 to cfg.packs do
|
||||
if data.packmask[j]>0 then
|
||||
found:=true;
|
||||
if found then
|
||||
@ -730,13 +769,20 @@ program install;
|
||||
{$IFNDEF LINUX}
|
||||
{ TH - check the available disk space here }
|
||||
DSize := 0;
|
||||
for j:=1to cfg.packs do
|
||||
for j:=1 to cfg.packs do
|
||||
with cfg.pack[j] do
|
||||
begin
|
||||
for i:=1 to packages do
|
||||
begin
|
||||
if data.packmask[j] and packagemask(i)<>0 then
|
||||
Inc (DSize, DiskSpaceN(package[i].zip));
|
||||
begin
|
||||
ASpace := DiskSpaceN (package[i].zip);
|
||||
if ASpace = -1 then
|
||||
MessageBox ('File ' + package[i].zip +
|
||||
' is probably corrupted!', nil,
|
||||
mferror + mfokbutton)
|
||||
else Inc (DSize, ASpace);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
S := FExpand (Data.BasePath);
|
||||
@ -770,7 +816,7 @@ program install;
|
||||
mfinformation+mfyesbutton+mfnobutton);
|
||||
if (result=cmYes) and createinstalldir(data.basepath) then
|
||||
begin
|
||||
for i:=1to cfg.packs do
|
||||
for i:=1 to cfg.packs do
|
||||
if cfg.pack[i].defcfgfile<>'' then
|
||||
writedefcfg(data.basepath+cfg.pack[i].binsub+DirSep+cfg.pack[i].defcfgfile);
|
||||
end;
|
||||
@ -795,21 +841,21 @@ program install;
|
||||
with cfg.pack[j] do
|
||||
begin
|
||||
r.assign(20,7,60,16);
|
||||
p2:=new(punzipdialog,init(r,'Extracting Packages'));
|
||||
desktop^.insert(p2);
|
||||
UnzDlg:=new(punzipdialog,init(r,'Extracting Packages'));
|
||||
desktop^.insert(UnzDlg);
|
||||
for i:=1 to packages do
|
||||
begin
|
||||
if data.packmask[j] and packagemask(i)<>0 then
|
||||
p2^.do_unzip(package[i].zip,data.basepath);
|
||||
UnzDlg^.do_unzip(package[i].zip,data.basepath);
|
||||
end;
|
||||
desktop^.delete(p2);
|
||||
dispose(p2,done);
|
||||
desktop^.delete(UnzDlg);
|
||||
dispose(UnzDlg,done);
|
||||
end;
|
||||
|
||||
{ write config }
|
||||
if (data.cfgval and 1)<>0 then
|
||||
begin
|
||||
for i:=1to cfg.packs do
|
||||
for i:=1 to cfg.packs do
|
||||
if cfg.pack[i].defcfgfile<>'' then
|
||||
writedefcfg(data.basepath+cfg.pack[i].binsub+DirSep+cfg.pack[i].defcfgfile);
|
||||
end;
|
||||
@ -1154,7 +1200,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.18 2000-02-24 17:47:47 peter
|
||||
Revision 1.19 2000-06-18 18:27:32 hajny
|
||||
+ archive validity checking, progress indicator, better error checking
|
||||
|
||||
Revision 1.18 2000/02/24 17:47:47 peter
|
||||
* last fixes for 0.99.14a release
|
||||
|
||||
Revision 1.17 2000/02/23 17:17:56 peter
|
||||
|
||||
@ -19,6 +19,7 @@ const
|
||||
{$ELSE}
|
||||
AllFiles: string [3] = '*.*';
|
||||
{$ENDIF}
|
||||
UnzipErr: longint = 0;
|
||||
|
||||
type
|
||||
TArgV = array [0..1024] of PChar;
|
||||
@ -28,6 +29,7 @@ type
|
||||
|
||||
function FileUnzipEx (SourceZipFile, TargetDirectory,
|
||||
FileSpecs: PChar): integer;
|
||||
(* Returns non-zero result on success. *)
|
||||
|
||||
implementation
|
||||
|
||||
@ -186,7 +188,8 @@ begin
|
||||
ArgV [ArgC] := TargetDirectory;
|
||||
Inc (ArgC);
|
||||
ArgV [ArgC] := @ExDirOpt [3]; (* contains #0 *)
|
||||
if UzpMain (ArgC, ArgV) <> 0 then FileUnzipEx := 0 else FileUnzipEx := FCount;
|
||||
UnzipErr := UzpMain (ArgC, ArgV);
|
||||
if UnzipErr <> 0 then FileUnzipEx := 0 else FileUnzipEx := FCount;
|
||||
for I := 1 to FCount do FreeMem (ArgV [I + OptCount], StrLen [I + OptCount]);
|
||||
end;
|
||||
|
||||
@ -207,7 +210,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 2000-06-13 16:21:36 hajny
|
||||
Revision 1.5 2000-06-18 18:27:32 hajny
|
||||
+ archive validity checking, progress indicator, better error checking
|
||||
|
||||
Revision 1.4 2000/06/13 16:21:36 hajny
|
||||
* Win32 support corrected/completed
|
||||
|
||||
Revision 1.3 2000/03/05 17:57:08 hajny
|
||||
|
||||
Loading…
Reference in New Issue
Block a user