Metropoli BBS
VIEWER: install.pas MODE: TEXT (CP437)
{$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.
[ RETURN TO DIRECTORY ]