paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-11 21:29:42 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ archive validity checking, progress indicator, better error checking

Browse Source
This commit is contained in:
Tomas Hajny 2000-06-18 18:27:32 +00:00
parent a2aca573f4
commit f6bcd5c791
2 changed files with 91 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

117
install/fpinst/install.pas
View File

@ -86,6 +86,10 @@ program install;
CfgExt = '.dat'; CfgExt = '.dat';
MaxStatusPos = 4;
StatusChars: string [MaxStatusPos] = '/-\|';
StatusPos: byte = 1;
{$ifdef linux} {$ifdef linux}
DirSep='/'; DirSep='/';
{$else} {$else}
@ -184,6 +188,12 @@ program install;
CfgName: NameStr; CfgName: NameStr;
DStr: DirStr; DStr: DirStr;
EStr: ExtStr; EStr: ExtStr;
UnzDlg : punzipdialog;
{$IFNDEF DLL}
const
UnzipErr: longint = 0;
{$ENDIF}
{***************************************************************************** {*****************************************************************************
@ -283,8 +293,11 @@ program install;
s : string; s : string;
begin begin
s:=zipfile+#0; s:=zipfile+#0;
uncompressed:=UnzipSize(@s[1],compressed); if not (IsZip (@S [1])) then DiskSpaceN := -1 else
DiskSpaceN:=uncompressed shr 10; begin
Uncompressed:=UnzipSize(@s[1],compressed);
DiskSpaceN:=uncompressed shr 10;
end;
end; end;
@ -294,8 +307,11 @@ program install;
s : string; s : string;
begin begin
uncompressed:=DiskSpaceN (zipfile); uncompressed:=DiskSpaceN (zipfile);
str(uncompressed,s); if Uncompressed = -1 then DiskSpace := ' [INVALID]' else
diskspace:=' ('+s+' KB)'; begin
str(uncompressed,s);
diskspace:=' ('+s+' KB)';
end;
end; end;
@ -412,41 +428,65 @@ program install;
r : trect; r : trect;
begin begin
inherited init(bounds,atitle); inherited init(bounds,atitle);
R.Assign(11, 4, 38, 5); (* R.Assign (11, 4, 38, 6);*)
filetext:=new(pstatictext,init(r,'File: ')); R.Assign (1, 4, 39, 6);
filetext:=new(pstatictext,init(r,#3'File: '));
insert(filetext); insert(filetext);
end; 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); procedure tunzipdialog.do_unzip(s,topath : string);
var var
again : boolean; again : boolean;
fn,dir,wild : string; fn,dir,wild : string;
Cnt: integer;
begin begin
Disposestr(filetext^.text); Disposestr(filetext^.text);
filetext^.Text:=NewStr('File: '+s); filetext^.Text:=NewStr(#3'File: '+s + #13#3' ');
filetext^.drawview; filetext^.drawview;
if not(file_exists(s,startpath)) then if not(file_exists(s,startpath)) then
begin begin
messagebox('File: '+s+' missed for the selected installation. '+ messagebox('File "'+s+'" missing for the selected installation. '+
'Installation doesn''t becomes complete',nil,mferror+mfokbutton); 'Installation hasn''t been completed.',nil,mferror+mfokbutton);
errorhalt; errorhalt;
end; end;
{$IFNDEF DLL}
{$IFDEF FPC}
SetUnzipReportProc (@UnzipCheckFn);
{$ELSE FPC}
SetUnzipReportProc (UnzipCheckFn);
{$ENDIF FPC}
{$ENDIF DLL}
repeat repeat
fn:=startpath+DirSep+s+#0; fn:=startpath+DirSep+s+#0;
dir:=topath+#0; dir:=topath+#0;
wild:=AllFiles + #0; wild:=AllFiles + #0;
DosError := 0;
again:=false; again:=false;
{$IFDEF DLL}
doserror:=FileUnzipEx(@fn[1],@dir[1],@wild[1]);
{$ELSE}
FileUnzipEx(@fn[1],@dir[1],@wild[1]); FileUnzipEx(@fn[1],@dir[1],@wild[1]);
{$ENDIF} if (UnzipErr <> 0) then
if (doserror<>0) then
begin begin
str(doserror,s); Str(UnzipErr,s);
if messagebox('Error ('+s+') when extracting. Disk full?'#13+ if messagebox('Error (' + S + ') while extracting. Disk full?'#13+
#13#3'Try again?',nil,mferror+mfyesbutton+mfnobutton)=cmNo then #13#3'Try again?',nil,mferror+mfyesbutton+mfnobutton)=cmNo then
errorhalt errorhalt
else else
@ -578,7 +618,7 @@ program install;
begin begin
f:=nil; f:=nil;
{ walk packages reverse and insert a newsitem for each, and set the mask } { 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 with cfg.pack[j] do
begin begin
firstitem[j]:=0; firstitem[j]:=0;
@ -599,7 +639,7 @@ program install;
{ If no component found abort } { If no component found abort }
found:=false; found:=false;
for j:=1to cfg.packs do for j:=1 to cfg.packs do
if packmask[j]<>0 then if packmask[j]<>0 then
found:=true; found:=true;
if not found then if not found then
@ -643,7 +683,7 @@ program install;
data.cfgval:=1; data.cfgval:=1;
{-------- Pack Sheets ----------} {-------- Pack Sheets ----------}
for j:=1to cfg.packs do for j:=1 to cfg.packs do
begin begin
R.Copy(TabIR); R.Copy(TabIR);
new(packcbs[j],init(r,items[j])); new(packcbs[j],init(r,items[j]));
@ -694,7 +734,6 @@ program install;
procedure tapp.do_installdialog; procedure tapp.do_installdialog;
var var
p : pinstalldialog; p : pinstalldialog;
p2 : punzipdialog;
p3 : penddialog; p3 : penddialog;
r : trect; r : trect;
result, result,
@ -702,13 +741,13 @@ program install;
i,j : longint; i,j : longint;
found : boolean; found : boolean;
{$ifndef linux} {$ifndef linux}
DSize,Space : longint; DSize,Space,ASpace : longint;
S: DirStr; S: DirStr;
{$endif} {$endif}
begin begin
data.basepath:=cfg.basepath; data.basepath:=cfg.basepath;
data.cfgval:=0; data.cfgval:=0;
for j:=1to cfg.packs do for j:=1 to cfg.packs do
data.packmask[j]:=$ffff; data.packmask[j]:=$ffff;
repeat repeat
@ -722,7 +761,7 @@ program install;
else else
begin begin
found:=false; found:=false;
for j:=1to cfg.packs do for j:=1 to cfg.packs do
if data.packmask[j]>0 then if data.packmask[j]>0 then
found:=true; found:=true;
if found then if found then
@ -730,13 +769,20 @@ program install;
{$IFNDEF LINUX} {$IFNDEF LINUX}
{ TH - check the available disk space here } { TH - check the available disk space here }
DSize := 0; DSize := 0;
for j:=1to cfg.packs do for j:=1 to cfg.packs do
with cfg.pack[j] do with cfg.pack[j] do
begin begin
for i:=1 to packages do for i:=1 to packages do
begin begin
if data.packmask[j] and packagemask(i)<>0 then 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;
end; end;
S := FExpand (Data.BasePath); S := FExpand (Data.BasePath);
@ -770,7 +816,7 @@ program install;
mfinformation+mfyesbutton+mfnobutton); mfinformation+mfyesbutton+mfnobutton);
if (result=cmYes) and createinstalldir(data.basepath) then if (result=cmYes) and createinstalldir(data.basepath) then
begin begin
for i:=1to cfg.packs do for i:=1 to cfg.packs do
if cfg.pack[i].defcfgfile<>'' then if cfg.pack[i].defcfgfile<>'' then
writedefcfg(data.basepath+cfg.pack[i].binsub+DirSep+cfg.pack[i].defcfgfile); writedefcfg(data.basepath+cfg.pack[i].binsub+DirSep+cfg.pack[i].defcfgfile);
end; end;
@ -795,21 +841,21 @@ program install;
with cfg.pack[j] do with cfg.pack[j] do
begin begin
r.assign(20,7,60,16); r.assign(20,7,60,16);
p2:=new(punzipdialog,init(r,'Extracting Packages')); UnzDlg:=new(punzipdialog,init(r,'Extracting Packages'));
desktop^.insert(p2); desktop^.insert(UnzDlg);
for i:=1 to packages do for i:=1 to packages do
begin begin
if data.packmask[j] and packagemask(i)<>0 then 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; end;
desktop^.delete(p2); desktop^.delete(UnzDlg);
dispose(p2,done); dispose(UnzDlg,done);
end; end;
{ write config } { write config }
if (data.cfgval and 1)<>0 then if (data.cfgval and 1)<>0 then
begin begin
for i:=1to cfg.packs do for i:=1 to cfg.packs do
if cfg.pack[i].defcfgfile<>'' then if cfg.pack[i].defcfgfile<>'' then
writedefcfg(data.basepath+cfg.pack[i].binsub+DirSep+cfg.pack[i].defcfgfile); writedefcfg(data.basepath+cfg.pack[i].binsub+DirSep+cfg.pack[i].defcfgfile);
end; end;
@ -1154,7 +1200,10 @@ begin
end. end.
{ {
$Log$ $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 * last fixes for 0.99.14a release
Revision 1.17 2000/02/23 17:17:56 peter Revision 1.17 2000/02/23 17:17:56 peter

10
install/fpinst/unzipdll.pas
View File

@ -19,6 +19,7 @@ const
{$ELSE} {$ELSE}
AllFiles: string [3] = '*.*'; AllFiles: string [3] = '*.*';
{$ENDIF} {$ENDIF}
UnzipErr: longint = 0;
type type
TArgV = array [0..1024] of PChar; TArgV = array [0..1024] of PChar;
@ -28,6 +29,7 @@ type
function FileUnzipEx (SourceZipFile, TargetDirectory, function FileUnzipEx (SourceZipFile, TargetDirectory,
FileSpecs: PChar): integer; FileSpecs: PChar): integer;
(* Returns non-zero result on success. *)
implementation implementation
@ -186,7 +188,8 @@ begin
ArgV [ArgC] := TargetDirectory; ArgV [ArgC] := TargetDirectory;
Inc (ArgC); Inc (ArgC);
ArgV [ArgC] := @ExDirOpt [3]; (* contains #0 *) 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]); for I := 1 to FCount do FreeMem (ArgV [I + OptCount], StrLen [I + OptCount]);
end; end;
@ -207,7 +210,10 @@ begin
end. end.
{ {
$Log$ $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 * Win32 support corrected/completed
Revision 1.3 2000/03/05 17:57:08 hajny Revision 1.3 2000/03/05 17:57:08 hajny