{$A+,B-,D+,E+,F-,G-,I-,L+,N-,O-,P-,Q+,R+,S+,T-,V-,X+,Y+}
{$M 16384,0,16384}
program install;
uses
app,dialogs,views,objects,menus,drivers,strings,msgbox,dos;
var
binpath,startpath : string;
successfull : boolean;
procedure uppervar(var s : string);
var
i : integer;
begin
for i:=1 to length(s) do
s[i]:=upcase(s[i]);
end;
procedure do_install(const s : string);
begin
swapvectors;
exec('UNZIP.EXE','-qq -o '+startpath+'\'+s);
swapvectors;
if doserror<>0 then
begin
messagebox('Fehler beim Entpacken. Datenträger voll?',nil,mferror+mfokbutton);
halt(1);
end;
end;
function createdir(const s : string) : boolean;
begin
chdir(s);
if ioresult=0 then
begin
{$ifdef german}
createdir:=messagebox('Das Installationsverzeichnis existiert schon. '+
'Soll ein neues Installationsverzeichnis angegeben werden?',nil,
mferror+mfyesbutton+mfnobutton)=mfyesbutton;
{$else}
createdir:=messagebox('The installation directory exists already. '+
'Do want to enter a new installation directory ?',nil,
mferror+mfyesbutton+mfnobutton)=mfyesbutton;
{$endif}
exit;
end;
mkdir(s);
if ioresult<>0 then
begin
{$ifdef german}
messagebox('Das Installationsverzeichnis konnte nicht angelegt werden',
@s,mferror+mfokbutton);
{$else}
messagebox('The installation directory could''t be created',
@s,mferror+mfokbutton);
{$endif}
createdir:=true;
exit;
end;
createdir:=false;
end;
procedure changedir(const s : string);
begin
chdir(s);
if ioresult<>0 then
begin
{$ifdef german}
messagebox('Fehler beim Wechseln in das Installationsverzeichnis. '+
'Installationsprogramm wird beendet',@s,mferror+mfokbutton);
{$else}
messagebox('Error when changing directory ',@s,mferror+mfokbutton);
{$endif}
halt(1);
end;
end;
const
cmstart = 1000;
type
pinstalldialog = ^tinstalldialog;
tinstalldialog = object(tdialog)
constructor init;
end;
tapp = object(tapplication)
procedure initmenubar;virtual;
procedure handleevent(var event : tevent);virtual;
end;
constructor tinstalldialog.init;
var
r : trect;
line : integer;
p,f : pview;
s : string;
const breite = 31;
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);
{$ifdef german}
inherited init(r,'Installieren');
{$else}
inherited init(r,'Install');
{$endif}
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);
{$ifdef german}
insert(new(plabel,init(r,'~P~fad',p)));
{$else}
insert(new(plabel,init(r,'~P~ath',p)));
{$endif}
insert(p);
inc(line,3);
r.assign(3,line+1,28,line+3);
p:=new(pcheckboxes,init(r,
newsitem('~D~OS',
{ newsitem('~O~S/2', }
nil
)));
insert(p);
r.assign(3,line,21,line+1);
{$ifdef german}
insert(new(plabel,init(r,'~B~etriebssystem',p)));
{$else}
insert(new(plabel,init(r,'~O~perating system',p)));
{$endif}
inc(line,4);
r.assign(3,line+1,28,line+3);
{$ifdef german}
p:=new(pcheckboxes,init(r,
newsitem('~R~untime-Library',
newsitem('~C~ompiler',
nil
))));
{$else}
p:=new(pcheckboxes,init(r,
newsitem('~R~un time library',
newsitem('~C~ompiler',
nil
))));
{$endif}
insert(p);
r.assign(3,line,14,line+1);
{$ifdef german}
insert(new(plabel,init(r,'~Q~uelltexte',p)));
{$else}
insert(new(plabel,init(r,'~S~ources',p)));
{$endif}
inc(line,4);
r.assign(3,line+1,28,line+3);
{$ifdef german}
p:=new(pcheckboxes,init(r,
newsitem('~B~eispielprogramme',
newsitem('~F~reeVision',
nil
))));
{$else}
p:=new(pcheckboxes,init(r,
newsitem('S~a~mples',
newsitem('~F~reeVision',
nil
))));
{$endif}
insert(p);
r.assign(3,line,13,line+1);
{$ifdef german}
insert(new(plabel,init(r,'~S~onstiges',p)));
{$else}
insert(new(plabel,init(r,'O~t~her',p)));
{$endif}
inc(line,4);
r.assign(3,line,13,line+2);
insert(new(pbutton,init(r,'~O~k',cmok,bfdefault)));
r.assign(18,line,28,line+2);
insert(new(pbutton,init(r,'~C~ancel',cmcancel,bfnormal)));
f^.select;
end;
procedure tapp.handleevent(var event : tevent);
var
p : pinstalldialog;
p2 : pdialog;
p3 : pstatictext;
r : trect;
c : word;
t : text;
installdata : record
path : string[79];
bsys : word;
quellen : word;
samples : word;
end;
f : file;
label
insertdisk1,insertdisk2;
begin
inherited handleevent(event);
if event.what=evcommand then
if event.command=cmstart then
begin
clearevent(event);
installdata.path:='C:\PP';
installdata.bsys:=$1;
installdata.quellen:=0;
installdata.samples:=$3;
while true do
begin
p:=new(pinstalldialog,init);
{ Standardeinstellungen }
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
continue;
changedir(installdata.path);
assign(t,'SET_PP.BAT');
rewrite(t);
if ioresult<>0 then
{$ifdef german}
messagebox('Datei SET_PP.BAT konnte nicht erstellt werden',nil,mfokbutton+mferror)
{$else}
messagebox('File SET_PP.BAT can''t be created',nil,mfokbutton+mferror)
{$endif}
else
begin
writeln(t,'SET PPBIN='+installdata.path+'\BIN');
writeln(t,'SET PASLIB='+installdata.path+'\LIB');
writeln(t,'SET OS2UNITS='+installdata.path+'\OS2UNITS');
writeln(t,'SET DOSUNITS='+installdata.path+'\DOSUNITS;'+installdata.path+'\BIN');
writeln(t,'SET GO32TMP='+installdata.path);
writeln(t,'SET LINUXUNITS='+installdata.path+'\LINUXUNITS');
write(t,'SET GO32=');
{$ifdef german}
if messagebox('Wollen Sie den Coprozessoremulator verwenden?',
nil,mfyesbutton+mfnobutton)=mfyesbutton then
write(t,'emu '+installdata.path+'\DRIVERS\EMU387');
{$else}
if messagebox('Install math processor emulation?',
nil,mfyesbutton+mfnobutton)=mfyesbutton then
write(t,'emu '+installdata.path+'\DRIVERS\EMU387');
{$endif}
writeln(t);
end;
close(t);
if (installdata.bsys and $2)<>0 then
begin
assign(t,'SET_PP.CMD');
rewrite(t);
if ioresult<>0 then
{$ifdef german}
messagebox('Datei SET_PP.CMD konnte nicht erstellt werden',nil,mfokbutton+mferror)
{$else}
messagebox('File SET_PP.CMD can''t be created',nil,mfokbutton+mferror)
{$endif}
else
begin
writeln(t,'SET LIB='+installdata.path+'\OS2LIB');
writeln(t,'SET TMPDIR='+installdata.path);
end;
close(t);
end;
if getenv('UNZIP')<>'' then
begin
{$ifdef german}
messagebox('Die Umgebungsvariable UNZIP sollte'#13+
'nicht gesetzt sein',nil,mfokbutton+mfinformation)
{$else}
messagebox('The enviroment variable UNZIP shouldn''t be set',nil,
mfokbutton+mfinformation)
{$endif}
end;
insertdisk1:
{$ifdef german}
if messagebox('Legen Sie Diskette 1 ein',nil,
mfconfirmation+mfokbutton+mfcancelbutton)=mfcancelbutton then
break;
{$else}
if (messagebox('Insert disk 1',nil,
mfconfirmation+mfokbutton+mfcancelbutton) and mfcancelbutton)<>0 then
break;
{$endif}
assign(f,startpath+'\'+'DISK1');
reset(f);
if ioresult<>0 then
goto insertdisk1;
close(f);
r.assign(20,7,60,16);
p2:=new(pdialog,init(r,'Information'));
r.assign(6,4,38,5);
{$ifdef german}
p3:=new(pstatictext,init(r,'Dateien werden entpackt ...'));
{$else}
p3:=new(pstatictext,init(r,'Extracting files ...'));
{$endif}
p2^.insert(p3);
desktop^.insert(p2);
swapvectors;
exec(startpath+'\'+'UNZIP.EXE','-qq -o '+startpath+'\BASE');
swapvectors;
if doserror<>0 then
begin
desktop^.delete(p2);
dispose(p2,done);
{$ifdef german}
messagebox('Fehler beim Entpacken',nil,mferror+mfokbutton);
{$else}
messagebox('Error when extracting',nil,mferror+mfokbutton);
{$endif}
continue;
end;
if (installdata.bsys and $1)<>0 then
begin
do_install('BASEDOS');
if (installdata.samples and $1)<>0 then
do_install('DEMODOS');
if (installdata.samples and $2)<>0 then
do_install('FV');
if (installdata.quellen and $1)<>0 then
do_install('SRCRTLDO');
end;
if (installdata.quellen and $2)<>0 then
do_install('SRCCOMP');
if (installdata.bsys and $2)<>0 then
begin
if (installdata.samples and $1)<>0 then
do_install('DEMOOS2');
if (installdata.quellen and $1)<>0 then
do_install('SRCRTLOS');
insertdisk2:
{$ifdef german}
if messagebox('Legen Sie Diskette 2 ein',nil,
mfconfirmation+mfokbutton+mfcancelbutton)=mfcancelbutton then
break;
{$else}
if messagebox('Insert disk 2',nil,
mfconfirmation+mfokbutton+mfcancelbutton)=mfcancelbutton then
break;
{$endif}
assign(f,startpath+'\'+'DISK2');
reset(f);
if ioresult<>0 then
goto insertdisk2;
close(f);
do_install('BASEOS2');
end;
desktop^.delete(p2);
dispose(p2,done);
{$ifdef german}
messagebox('Installation erfolgreich abgeschlossen',nil,mfinformation+mfokbutton);
{$else}
messagebox('Installation successfull',nil,mfinformation+mfokbutton);
{$endif}
event.what:=evcommand;
event.command:=cmquit;
successfull:=true;
handleevent(event);
end;
break;
end;
end;
end;
procedure tapp.initmenubar;
var
r : trect;
begin
getextent(r);
r.b.y:=r.a.y+1;
{$ifdef german}
menubar:=new(pmenubar,init(r,newmenu(
newsubmenu('~I~nstallation',hcnocontext,newmenu(
newitem('~S~tart','',kbnokey,cmstart,hcnocontext,
newline(
newitem('~B~eenden','Alt+X',kbaltx,cmquit,hcnocontext,
nil)))
),
nil))));
{$else}
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))));
{$endif}
end;
var
installapp : tapp;
oldexitproc : pointer;
procedure myexitproc;far;
begin
exitproc:=oldexitproc;
end;
var
b : byte;
begin
{ getdir(0,startpath); }
startpath:=paramstr(0);
for b:=length(startpath) downto 1 do
if startpath[b]='\' then
begin
startpath[0]:=chr(b-1);
break;
end;
oldexitproc:=exitproc;
exitproc:=@myexitproc;
successfull:=false;
installapp.init;
installapp.run;
installapp.done;
if successfull then
begin
{$ifdef german}
writeln('Das Installationsprogramm hat eine Datei SET_PP.BAT erzeugt,');
writeln('die die für den Betrieb des Compilers notwendigen Umgebungs-');
writeln('variablen setzt und daher vor Aufruf des Compilers aufgerufen werden');
writeln('muß. Binden Sie am besten einen Aufruf der Form CALL SET_PP in');
writeln('Ihre AUTOEXEC.BAT-Datei ein.');
writeln('Außerdem müssen Sie Ihre PATH-Anweisung in der AUTOEXEC.BAT-Datei');
writeln('um das Verzeichnis ',binpath,' erweitern');
writeln;
writeln('Als nächstes sollten Sie nun die Dokumentation im Unterverzeichnis');
writeln('DOC, die als DVI-Dateien (von LaTeX erzeugt) lesen bzw ausdrucken lassen');
writeln('und im Benutzerhandbuch das Kapitel Erste Schritte lesen');
writeln;
writeln('Um die OS/2-Unterstützung nutzen zu können, lesen Sie bitte');
writeln('das Kapitel OS/2 im Benutzerhandbuch (DOC\PPUSER.DVI)');
writeln;
writeln('Die Demoprogramme können mit PPC386 [Datei] übersetzt');
writeln('und mit GO32 [Datei] gestartet werden');
{$else}
writeln('Insert a call to the file SET_PP.BAT in the AUTOEXEC.BAT');
writeln('to set the environement variables');
writeln;
writeln('Extend your PATH variable with');
writeln(binpath);
writeln;
writeln('Compile files with PPC386 -a [file]');
writeln('Execute them with GO32 [file]');
{$endif}
end;
end.