From f6bcd5c791aa40d34e0bc612f10dcd9c24c8b993 Mon Sep 17 00:00:00 2001 From: Tomas Hajny Date: Sun, 18 Jun 2000 18:27:32 +0000 Subject: [PATCH] + archive validity checking, progress indicator, better error checking --- install/fpinst/install.pas | 117 +++++++++++++++++++++++++----------- install/fpinst/unzipdll.pas | 10 ++- 2 files changed, 91 insertions(+), 36 deletions(-) diff --git a/install/fpinst/install.pas b/install/fpinst/install.pas index 0a7e114f29..f6ea5e0715 100644 --- a/install/fpinst/install.pas +++ b/install/fpinst/install.pas @@ -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 diff --git a/install/fpinst/unzipdll.pas b/install/fpinst/unzipdll.pas index 37492856f9..91050500b1 100644 --- a/install/fpinst/unzipdll.pas +++ b/install/fpinst/unzipdll.pas @@ -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