mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-24 12:58:32 +02:00
453 lines
13 KiB
ObjectPascal
453 lines
13 KiB
ObjectPascal
{
|
|
$Id$
|
|
This file is part of the Free Pascal run time library.
|
|
Copyright (c) 1993-98 by Florian Klaempfl
|
|
member of the Free Pascal development team
|
|
|
|
This is the install program for the DOS version of Free Pascal
|
|
|
|
See the file COPYING.FPC, included in this distribution,
|
|
for details about the copyright.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
|
**********************************************************************}
|
|
|
|
{$A+,B-,D+,E+,F-,G-,I-,L+,N-,O-,P-,Q+,R+,S+,T-,V-,X+,Y+}
|
|
program install;
|
|
|
|
uses
|
|
app,dialogs,views,objects,menus,drivers,strings,msgbox,dos,unzip,ziptypes;
|
|
|
|
var
|
|
binpath,startpath : string;
|
|
successfull : boolean;
|
|
|
|
const
|
|
version = '0';
|
|
release = '99';
|
|
patchlevel = '8';
|
|
|
|
filenr = version+release+patchlevel;
|
|
|
|
doc_version = '110';
|
|
|
|
{*****************************************************************************
|
|
Helpers
|
|
*****************************************************************************}
|
|
|
|
procedure uppervar(var s : string);
|
|
|
|
var
|
|
i : integer;
|
|
|
|
begin
|
|
for i:=1 to length(s) do
|
|
s[i]:=upcase(s[i]);
|
|
end;
|
|
|
|
function file_exists(const f : string;const path : string) : boolean;
|
|
|
|
begin
|
|
file_exists:=fsearch(f,path)<>'';
|
|
end;
|
|
|
|
|
|
function diskspace(const path,zipfile : string) : string;
|
|
var
|
|
compressed,uncompressed : longint;
|
|
s : string;
|
|
begin
|
|
s:=path+zipfile+#0;
|
|
uncompressed:=UnzipSize(@s[1],compressed);
|
|
uncompressed:=uncompressed shr 10;
|
|
str(uncompressed,s);
|
|
diskspace:=' ('+s+' Kb)';
|
|
end;
|
|
|
|
|
|
|
|
function createdir(const s : string) : boolean;
|
|
|
|
var
|
|
result : longint;
|
|
|
|
begin
|
|
chdir(s);
|
|
if ioresult=0 then
|
|
begin
|
|
result:=messagebox('The installation directory exists already. '+
|
|
'Do want to enter a new installation directory ?',nil,
|
|
mferror+mfyesbutton+mfnobutton);
|
|
createdir:=result=cmyes;
|
|
exit;
|
|
end;
|
|
mkdir(s);
|
|
if ioresult<>0 then
|
|
begin
|
|
messagebox('The installation directory couldn''t be created',
|
|
@s,mferror+mfokbutton);
|
|
createdir:=true;
|
|
exit;
|
|
end;
|
|
createdir:=false;
|
|
end;
|
|
|
|
|
|
procedure changedir(const s : string);
|
|
|
|
begin
|
|
chdir(s);
|
|
if ioresult<>0 then
|
|
begin
|
|
messagebox('Error when changing directory ',@s,mferror+mfokbutton);
|
|
halt(1);
|
|
end;
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
TUnZipDialog
|
|
*****************************************************************************}
|
|
|
|
type
|
|
punzipdialog=^tunzipdialog;
|
|
tunzipdialog=object(tdialog)
|
|
filetext : pstatictext;
|
|
constructor Init(var Bounds: TRect; ATitle: TTitleStr);
|
|
procedure do_unzip(s:string);
|
|
end;
|
|
|
|
constructor tunzipdialog.init;
|
|
var
|
|
r : trect;
|
|
begin
|
|
inherited init(bounds,atitle);
|
|
R.Assign(11, 4, 38, 5);
|
|
filetext:=new(pstatictext,init(r,'File: '));
|
|
insert(filetext);
|
|
end;
|
|
|
|
|
|
procedure tunzipdialog.do_unzip(s : string);
|
|
var
|
|
fn,dir,wild : string;
|
|
begin
|
|
s:=s+'.ZIP';
|
|
Disposestr(filetext^.text);
|
|
filetext^.Text:=NewStr('File: '+s);
|
|
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);
|
|
halt(1);
|
|
end;
|
|
fn:=startpath+'\'+s+#0;
|
|
dir:='.'#0;
|
|
wild:='*.*'#0;
|
|
FileUnzipEx(@fn[1],@dir[1],@wild[1]);
|
|
if doserror<>0 then
|
|
begin
|
|
messagebox('Error when extracting. Disk full?',nil,mferror+mfokbutton);
|
|
halt(1);
|
|
end;
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
TInstallDialog
|
|
*****************************************************************************}
|
|
|
|
type
|
|
pinstalldialog = ^tinstalldialog;
|
|
tinstalldialog = object(tdialog)
|
|
constructor init;
|
|
end;
|
|
var
|
|
mask_components : longint;
|
|
|
|
|
|
constructor tinstalldialog.init;
|
|
var
|
|
r : trect;
|
|
line : integer;
|
|
p,f : pview;
|
|
s : string;
|
|
|
|
const breite = 76;
|
|
hoehe = 20;
|
|
x1 = (80-breite) div 2;
|
|
y1 = (23-hoehe) div 2;
|
|
x2 = x1+breite;
|
|
y2 = y1+hoehe;
|
|
|
|
begin
|
|
r.assign(x1,y1,x2,y2);
|
|
inherited init(r,'Install');
|
|
line:=2;
|
|
r.assign(3,line+1,28,line+2);
|
|
p:=new(pinputline,init(r,79));
|
|
f:=p;
|
|
s:='C:\PP';
|
|
p^.setdata(s);
|
|
insert(p);
|
|
r.assign(3,line,8,line+1);
|
|
insert(new(plabel,init(r,'~P~ath',p)));
|
|
insert(p);
|
|
inc(line,3);
|
|
r.assign(3,line+1,breite-3,line+11);
|
|
p:=new(pcheckboxes,init(r,
|
|
newsitem('~B~asic system (required)'+diskspace(startpath,'BASEDOS.ZIP'),
|
|
newsitem('GNU ~L~inker and GNU Assembler (required)'+diskspace(startpath,'GNUASLD.ZIP'),
|
|
newsitem('D~e~mos'+diskspace(startpath,'DEMO.ZIP'),
|
|
newsitem('GNU ~D~ebugger'+diskspace(startpath,'GDB.ZIP'),
|
|
newsitem('GNU ~U~tilities (required to recompile run time library)'+diskspace(startpath,'GNUUTILS.ZIP'),
|
|
newsitem('Documentation (~H~TML)'+diskspace(startpath,'DOCS.ZIP'),
|
|
newsitem('Documentation (~P~ostscript)'+diskspace(startpath,'DOC'+doc_version+'PS.ZIP'),
|
|
newsitem('~R~un time library sources'+diskspace(startpath,'RL'+filenr+'S.ZIP'),
|
|
newsitem('~C~ompiler sources'+diskspace(startpath,'PP'+filenr+'S.ZIP'),
|
|
newsitem('Documentation sources (La~T~eX)'+diskspace(startpath,'DOC'+doc_version+'.ZIP'),
|
|
nil
|
|
))))))))))));
|
|
pcluster(p)^.enablemask:=mask_components;
|
|
insert(p);
|
|
|
|
r.assign(3,line,14,line+1);
|
|
insert(new(plabel,init(r,'~C~omponents',p)));
|
|
|
|
inc(line,12);
|
|
{ Free Vision
|
|
r.assign(3,line+1,breite-3,line+3);
|
|
p:=new(pcheckboxes,init(r,
|
|
newsitem('~B~asic system',
|
|
newsitem('~D~ocumentation',
|
|
newsitem('S~a~mples',
|
|
newsitem('~S~ources',
|
|
nil
|
|
))))));
|
|
pcluster(p)^.enablemask:=mask_freevision;
|
|
insert(p);
|
|
r.assign(3,line,15,line+1);
|
|
insert(new(plabel,init(r,'~F~ree Vision',p)));
|
|
inc(line,4);
|
|
}
|
|
r.assign((breite div 2)-14,line,(breite div 2)-4,line+2);
|
|
insert(new(pbutton,init(r,'~O~k',cmok,bfdefault)));
|
|
r.assign((breite div 2)+4,line,(breite div 2)+14,line+2);
|
|
insert(new(pbutton,init(r,'~C~ancel',cmcancel,bfnormal)));
|
|
f^.select;
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
TApp
|
|
*****************************************************************************}
|
|
|
|
const
|
|
cmstart = 1000;
|
|
|
|
type
|
|
tapp = object(tapplication)
|
|
procedure initmenubar;virtual;
|
|
procedure handleevent(var event : tevent);virtual;
|
|
procedure do_installdialog;
|
|
end;
|
|
|
|
|
|
procedure tapp.do_installdialog;
|
|
var
|
|
p : pinstalldialog;
|
|
p2 : punzipdialog;
|
|
p3 : pstatictext;
|
|
r : trect;
|
|
c : word;
|
|
t : text;
|
|
installdata : record
|
|
path : string[79];
|
|
components : word;
|
|
end;
|
|
f : file;
|
|
label
|
|
newpath;
|
|
begin
|
|
installdata.path:='C:\PP';
|
|
installdata.components:=0;
|
|
|
|
mask_components:=$0;
|
|
|
|
{ searching files }
|
|
if file_exists('BASEDOS.ZIP',startpath) then
|
|
inc(mask_components,1);
|
|
|
|
if file_exists('GNUASLD.ZIP',startpath) then
|
|
inc(mask_components,2);
|
|
|
|
if file_exists('DEMO.ZIP',startpath) then
|
|
inc(mask_components,4);
|
|
|
|
if file_exists('GDB.ZIP',startpath) then
|
|
inc(mask_components,8);
|
|
|
|
if file_exists('GNUUTILS.ZIP',startpath) then
|
|
inc(mask_components,16);
|
|
|
|
if file_exists('DOCS.ZIP',startpath) then
|
|
inc(mask_components,32);
|
|
|
|
if file_exists('DOC+doc_version+PS.ZIP',startpath) then
|
|
inc(mask_components,64);
|
|
|
|
if file_exists('RL'+filenr+'S.ZIP',startpath) then
|
|
inc(mask_components,128);
|
|
|
|
if file_exists('PP'+filenr+'S.ZIP',startpath) then
|
|
inc(mask_components,256);
|
|
|
|
if file_exists('DOC+doc_version+S.ZIP',startpath) then
|
|
inc(mask_components,512);
|
|
|
|
while true do
|
|
begin
|
|
newpath:
|
|
p:=new(pinstalldialog,init);
|
|
{ default settings }
|
|
c:=executedialog(p,@installdata);
|
|
if c=cmok then
|
|
begin
|
|
if installdata.path[length(installdata.path)]='\' then
|
|
dec(byte(installdata.path[0]));
|
|
uppervar(installdata.path);
|
|
binpath:=installdata.path+'\BIN';
|
|
if createdir(installdata.path) then
|
|
goto newpath;
|
|
changedir(installdata.path);
|
|
|
|
r.assign(20,7,60,16);
|
|
p2:=new(punzipdialog,init(r,'Extracting files'));
|
|
desktop^.insert(p2);
|
|
|
|
if (installdata.components and 1)<>0 then
|
|
p2^.do_unzip('BASEDOS');
|
|
|
|
if (installdata.components and 2)<>0 then
|
|
p2^.do_unzip('GNUASLD');
|
|
|
|
if (installdata.components and 4)<>0 then
|
|
p2^.do_unzip('DEMO');
|
|
|
|
if (installdata.components and 8)<>0 then
|
|
p2^.do_unzip('GDB');
|
|
|
|
if (installdata.components and 16)<>0 then
|
|
p2^.do_unzip('GNUUTILS');
|
|
|
|
if (installdata.components and 32)<>0 then
|
|
p2^.do_unzip('DOCS');
|
|
|
|
if (installdata.components and 64)<>0 then
|
|
p2^.do_unzip('DOC+doc_version+PS');
|
|
|
|
if (installdata.components and 128)<>0 then
|
|
p2^.do_unzip('RL'+filenr+'S');
|
|
|
|
if (installdata.components and 256)<>0 then
|
|
p2^.do_unzip('PP'+filenr+'S');
|
|
|
|
if (installdata.components and 512)<>0 then
|
|
p2^.do_unzip('DOC+doc_version+S');
|
|
|
|
assign(t,'BIN\PPC386.CFG');
|
|
rewrite(t);
|
|
writeln(t,'-l');
|
|
writeln(t,'#ifdef GO32V1');
|
|
writeln(t,'-Up',installdata.path+'\RTL\DOS\GO32V1');
|
|
writeln(t,'#endif GO32V1');
|
|
writeln(t,'#ifdef GO32V2');
|
|
writeln(t,'-Up',installdata.path+'\RTL\DOS\GO32V2');
|
|
writeln(t,'#endif GO32V2');
|
|
writeln(t,'#ifdef Win32');
|
|
writeln(t,'-Up',installdata.path+'\RTL\WIN32');
|
|
writeln(t,'#endif Win32');
|
|
close(t);
|
|
|
|
desktop^.delete(p2);
|
|
dispose(p2,done);
|
|
messagebox('Installation successfull',nil,mfinformation+mfokbutton);
|
|
successfull:=true;
|
|
end;
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
procedure tapp.handleevent(var event : tevent);
|
|
|
|
label
|
|
insertdisk1,insertdisk2,newpath;
|
|
|
|
begin
|
|
inherited handleevent(event);
|
|
if event.what=evcommand then
|
|
if event.command=cmstart then
|
|
begin
|
|
clearevent(event);
|
|
do_installdialog;
|
|
if successfull then
|
|
begin
|
|
event.what:=evcommand;
|
|
event.command:=cmquit;
|
|
handleevent(event);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure tapp.initmenubar;
|
|
var
|
|
r : trect;
|
|
begin
|
|
getextent(r);
|
|
r.b.y:=r.a.y+1;
|
|
menubar:=new(pmenubar,init(r,newmenu(
|
|
newsubmenu('~I~nstallation',hcnocontext,newmenu(
|
|
newitem('~S~tart','',kbnokey,cmstart,hcnocontext,
|
|
newline(
|
|
newitem('~E~xit','Alt+X',kbaltx,cmquit,hcnocontext,
|
|
nil)))
|
|
),
|
|
nil))));
|
|
end;
|
|
|
|
|
|
var
|
|
installapp : tapp;
|
|
begin
|
|
getdir(0,startpath);
|
|
successfull:=false;
|
|
installapp.init;
|
|
installapp.do_installdialog;
|
|
installapp.done;
|
|
if successfull then
|
|
begin
|
|
writeln('Extend your PATH variable with');
|
|
writeln(binpath);
|
|
writeln;
|
|
writeln('To compile files enter PPC386 [file]');
|
|
chdir(startpath);
|
|
end;
|
|
end.
|
|
{
|
|
$Log$
|
|
Revision 1.4 1998-09-10 10:50:49 florian
|
|
* DOS install program updated
|
|
|
|
Revision 1.3 1998/09/09 13:39:58 peter
|
|
+ internal unzip
|
|
* dialog is showed automaticly
|
|
|
|
Revision 1.2 1998/04/07 22:47:57 florian
|
|
+ version/release/patch numbers as string added
|
|
|
|
}
|