Program Ein_Freund;

{ Version 1.01 (04.0891):

  - ein schreibgeschütztes oder fehlendes S: - Verzeichnis konnte
    zum Absturz führen - beseitigt. (Schäm...)

}


{ Fischers Freund stammt von:

         Henrich Deppenmeier
         Turnerstr. 50
         4800 Bielefeld 1
         Germoney

  und wurde im Mai 1991 in Kick-Pascal 2.0 geschrieben.

  Es funktioniert sowohl mit den original Aquarium - Dateien als auch
  mit den durch 'Schrumpf_daten' generierten Dateien.

  Source und Programm sind 'FDS', d.h. frei kopierbare Software MIT
  COPYRIGHT des Autors.

  Dieses Programm darf beliebig genutzt und verteilt werden, aber es ist
  verboten, damit Gewinn zu erzielen.

  Diese Programm darf auf keinen Fall auf PD-Disketten vertrieben werden,
  die teurer als 4,- DM sind.

  Der Source darf verändert werden, um das Programm eigenen Wünschen
  anzupassen, es wäre jedoch nett, wenn ein Hinweis auf den ursprünglichen
  Autor (nämlich mich...:-) ) drinbleibt.

}

uses execio;

{$incl 'req.lib','intuition.lib','devices/inputevent.h','graphics.lib',
       'exec/memory.h','libraries/diskfont.h','libraries/dos.h','devices/parallel.h'}


const winwidth=620;
      winheight=190;

Type Imagedata1=Array[1..13] of LONG;

     Indx = Record
               Class:Long;                 { Flags for Source,games,etc.}
               DiskNum:word;
               Offset:Long;                { for Datafile...}
               Desclength:word;            { length including those 56 '0's ..}
               rfu : word;                 { and some more wasted Bytes..}
             end;

     Progname=String[20];
     state=string[27];

     Description = Array [1..3000] of Char;

     Directoryname = String[DSize];
     Filename      = String[Fchars];
     Pathname      = String[162];

     errormessage=string[255];


Var NewWin  : NewWindow;
    MyWin  : ^Window;
    nw1x,nw1y,nw2x,nw2y:integer;
    Msg        : ^Intuimessage;
    g          : ^Gadget;
    Gad        : array[1..4] of GadgetBlock;
    StringGad  : Array [1..3] of StringBlock;
    StringgadText:array[1..3] of progname;
    Undotext   : Array[1..3] of Progname;
    Zeichen    : Long;
    Button     : Array [1..6] of TwoImageGadget;
    image1,
    image2,
    image3,
    image4     : ^Imagedata1;
    ende:boolean;
    success:boolean;
    choice:integer;
    configured:boolean;

    Datafilename:String;
    DAtafile:Long;

    Indexfile:String;
    Namefile:String;

    i,j:integer;
    l:long;
    c:char;

    Name:^progname;
    Namearea:long;
    Nameareasize:Long;

    Indexptr:^Indx;
    Indexarea:Long;
    Indexareasize:Long;

    Index:indx;

    NumRecords:integer;
    NumDisks:integer;

    Act_Record:integer;

    newpos,oldpos:Long;
    numlines,shownlines:integer;
    nextline:str;

    Desc:^Description;

    Dirn:Directoryname;
    Filen:pathname;

    errormsg:Errormessage;

    fnt:  p_Textfont;
    Txat: Textattr;

    IntLib_version:word;



Procedure exitserver;

{ Cleans up if there was an (accidental or normal) exit }

begin
  if datafile<>0 then dosclose(datafile);
  if desc<>nil then freemem(long(desc),sizeof(Description));
  if indexarea<>0 then FreeMem(indexarea,indexareasize);
  if namearea<>0 then FreeMem(namearea,Nameareasize);
  if image1<>nil then Freemem(Long(Image1),sizeof(ImageData1));
  if image2<>nil then Freemem(Long(Image2),sizeof(ImageData1));
  if image3<>nil then Freemem(Long(Image3),sizeof(ImageData1));
  if image4<>nil then Freemem(Long(Image4),sizeof(ImageData1));
  if fnt<>nil then closefont(fnt);
  if mywin<>nil then closewindow(MyWin);
  if reqbase<>nil then closelibrary(reqbase);
  if diskfontbase<>nil then closelibrary(diskfontbase);
  if gfxbase<>nil then closelibrary(gfxbase);
  if intbase<>nil then closelibrary(intbase);
end;



Procedure Print (x,y:integer;Text:str);

{ Prints at (pixel)position x,y }

Var Itext:Intuitext;
    win:p_window;

  begin
    win:=MyWin;
    Itext:=IntuiText(1,0,1,0,0,NIL,Text,NIL);
    PrintIText(Win^.RPort,^Itext,x,y);
  end;



Procedure Printat(x,y:integer;Text:str);

{ Prints at (char)position x,y , Topaz 80 is
  recommended }

Var Itext:Intuitext;
    win:p_window;

  begin
    win:=MyWin;
    x:=2+x*8; y:=12+y*9;
    Itext:=IntuiText(1,0,1,0,0,NIL,Text,NIL);
    PrintIText(Win^.RPort,^Itext,x,y);
  end;



Function TRequest(Titel,question,pos,middle,neg:str):long;

{ Requester with 1-3 Buttons from req.library }

Var Textreq : TRStructure;

  begin
    With Textreq do
      begin
        Text           := question;
        Controls       := nil;
        Window         := NIL;
        MiddleText     := middle;
        PositiveText   := pos;
        NegativeText   := neg;
        Title          := Titel;
        Keymask        := $FFFF;
        textcolor      := 1;
        detailcolor    := 2;
        blockcolor     := 1;
        versionnumber  := 0;
        rfu1           := 0;
        rfu2           := 0;
      end;
    TRequest:=Textrequest(^Textreq);
  end;



Procedure FileReq (Window : p_Window; Windowtitel : Str; Var Dir:Directoryname;
                   Var Filename: Pathname);

{ The glourious Filerequester of the req.library }

  Var Freq        : ^FileRequester;
      Path        : Pathname;
      returnvalue : long;

  Label EndFileReq;

  begin
      Freq:=Ptr(allocmem(sizeof(Filerequester),Memf_Public));
      if Freq=Nil then
        begin
         errormsg:='No Memory for Filerequester !'+chr(10);
         returnvalue:=trequest('Sorry:',errormsg,nil,nil,nil);
         goto endfilereq
        end;

      FReq^:=Filerequester(
            0,                { VersionNumber     }
            Windowtitel,      { Title             }
            ^Dir,             { Dir               }
            ^Filename,        { File              }
            ^Path,            { PathName          }
            Window,           { Window            }
            0,                { MaxExtendedSelect }
            12,               { numlines          }
            35,               { numcolumns        }
            10,               { devcolumns        }
            FRQLoading,       { Flags             }
            3,                { dirnamescolor     }
            1,                { filenamescolor    }
            3,                { devicenamescolor  }
            3,                { fontnamescolor    }
            1,                { fontsizescolor    }
            2,                { detailcolor       }
            1,                { blockcolor        }
            1,                { gadgettextcolor   }
            1,                { textmessagecolor  }
            1,                { stringnamecolor   }
            1,                { stringgadgetcolor }
            1,                { boxbordercolor    }
            1,                { gadgetboxcolor    }
            chr(0),           { RFU_Stuff         }
            datestamp(0,0,0), { DirDateStamp      }
            0,                { WindowLeftEdge    }
            0,                { WindowTopEdge     }
            0,                { FontYSize         }
            0,                { FontStyle         }
            nil,              { ExtendedSelect    }
            '',               { Hide              }
            '',               { Show              }
            0,                { FileBufferPos     }
            0,                { FileDispPos       }
            0,                { DirBufferPos      }
            0,                { DirDispPos        }
            0,                { HideBufferPos     }
            0,                { HideDispPos       }
            0,                { ShowBufferPos     }
            0,                { ShowDispPos       }
            nil,              { Memory            }
            nil,              { Memory2           }
            nil,              { Lock              }
            '',               { PrivateDirBuffer  }
            nil,              { FileInfoBlock     }
            0,                { NumEntries        }
            0,                { NumHiddenEntries  }
            0,                { filestartnumber   }
            0                 { devicestartnumber }
            );

    returnvalue:=fileRequest(Freq);
    IF returnvalue<>0 then
      Filename:=Path
    else
      Filename:='';
    freemem(long(Freq),Sizeof(FileRequester));
    EndFileReq:
  end;



Procedure endit(endmsg:Errormessage);

{ gives the final message }

var result:long;

begin
  result:=Trequest('Fehler:',endmsg,nil,nil,nil);
  halt(10);
end;



Procedure Initgadget(num:word; Var Gad:GadgetBlock);

{ initialises boolean req.library-Gadgets }

var i:integer;

 begin
   Gad.gadget:=gadget(nil,0,0,0,0,0,0,0,nil,nil,nil,0,nil,num,0);
   Gad.border:=Border(0,0,0,0,0,0,nil,nil);
   For i:=0 to numpairs do Gad.pairs[i]:=0;
   Gad.text:=intuitext(0,0,0,0,0,^txat,'',nil);
 end;



Procedure InitStringGadget(num:word; Var SGad:StringBlock);

{ initialises string Gadgets of the req.library }

var i:integer;

 begin
   SGad.gadget:=gadget(nil,0,0,0,0,0,0,0,nil,nil,nil,0,nil,num,0);
   SGad.info:=stringinfo(nil,nil,0,0,0,0,0,0,0,0,nil,0,nil);
   SGad.border:=Border(0,0,0,0,0,0,nil,nil);
   For i:=0 to numpairs do SGad.pairs[i]:=0;
 end;



Procedure Initbutton(num:word;var BGad:TwoimageGadget);

{ yes - initialises the TwoImageGadgets of the req.library }

 begin
   BGad.gadget:=gadget(nil,0,0,0,0,0,0,0,nil,nil,nil,0,nil,num,0);
   BGad.image1:=image(0,0,0,0,0,nil,0,0,nil);
   BGad.image2:=image(0,0,0,0,0,nil,0,0,nil);
   if odd(num) then
     Makebutton(^BGad,image3,image4,32,13,1)
   else
     Makebutton(^BGad,image1,image2,32,13,1);
   BGad.image1.planeonoff:=0;
   BGad.image2.planeonoff:=0;
   BGad.image1.planepick:=1;
   BGad.image2.planepick:=1;
 end;



Procedure initbuttondata;

begin
  image1^:=imagedata1(%00000000000000000000000111000000,
                      %00000000000000000000000111100000,
                      %00000000000000000000000110110000,
                      %01111111111111111111111110011000,
                      %00110000000000000000000000001100,
                      %00011000000000000000000000000110,
                      %00001100000000000000000000000011,
                      %00011000000000000000000000000110,
                      %00110000000000000000000000001100,
                      %01111111111111111111111110011000,
                      %00000000000000000000000110110000,
                      %00000000000000000000000111100000,
                      %00000000000000000000000111000000);

  image2^:=imagedata1(%00000000000000000000000111000000,
                      %00000000000000000000000111100000,
                      %00000000000000000000000111110000,
                      %01111111111111111111111111111000,
                      %00111111111111111111111111111100,
                      %00011111111111111111111111111110,
                      %00001111111111111111111111111111,
                      %00011111111111111111111111111110,
                      %00111111111111111111111111111100,
                      %01111111111111111111111111111000,
                      %00000000000000000000000111110000,
                      %00000000000000000000000111100000,
                      %00000000000000000000000111000000);

  image3^:=imagedata1(%00000011100000000000000000000000,
                      %00000111100000000000000000000000,
                      %00001101100000000000000000000000,
                      %00011001111111111111111111111110,
                      %00110000000000000000000000001100,
                      %01100000000000000000000000011000,
                      %11000000000000000000000000110000,
                      %01100000000000000000000000011000,
                      %00110000000000000000000000001100,
                      %00011001111111111111111111111110,
                      %00001101100000000000000000000000,
                      %00000111100000000000000000000000,
                      %00000011100000000000000000000000);

  image4^:=imagedata1(%00000011100000000000000000000000,
                      %00000111100000000000000000000000,
                      %00001111100000000000000000000000,
                      %00011111111111111111111111111110,
                      %00111111111111111111111111111100,
                      %01111111111111111111111111111000,
                      %11111111111111111111111111110000,
                      %01111111111111111111111111111000,
                      %00111111111111111111111111111100,
                      %00011111111111111111111111111110,
                      %00001111100000000000000000000000,
                      %00000111100000000000000000000000,
                      %00000011100000000000000000000000);
 end;



Procedure linkbutton( Var BGad:TwoImageGadget; Var W:P_Window;
                      xpos,ypos:long);

{ links Buttons into existing Window - Structure }

 begin
   BGad.gadget.leftedge:=xpos;
   BGad.gadget.topedge:=ypos;
   Addgadget(W,^BGad.gadget,Nil);
   Refreshgadgets(W^.Firstgadget,W,nil);
 end;



procedure getinfo(Number:long);

{ gets Index and Name for The Record with # number }

begin
  Indexptr:=ptr(Indexarea+long((Number-1))*14);
  Name:=ptr(Namearea+long((Number-1))*20);
  index:=indexptr^;
end;



procedure Getdesc(Number:Long);

{ Gets Text for Record # Number }

var Len:long;
    i:integer;

begin
  getinfo(number);
  newpos:=index.offset;
  oldpos:=DosSeek(Datafile,Newpos-oldpos,Offset_current);
  Len:=DosRead(Datafile,Desc,index.desclength);
  if Len <> index.desclength then
    begin
      errormsg:='Fileende erreicht!'+chr(10);
      endit(errormsg);
    end;
  oldpos:=newpos+index.desclength;
  numlines:=0;
  for i:=1 to index.desclength do
    begin
      if desc^[i]=chr(0) then
        begin
          desc^[i]:=chr(0);
          inc(numlines);
        end;
    end;
  desc^[i]:=chr(0);
  desc^[i+1]:=chr(0);
  inc(numlines);
  shownlines:=0;
  nextline:=ptr(desc);
end;



procedure fill(var s:progname);

{ fills up Names with blanks }

var i:integer;

begin
  for I:=strlen(s) to 19 do
   s:=s+' ';
end;



procedure status(s:state);

{ prints the Status s }

begin
  for I:=strlen(s) to 27 do
    s:=s+' ';
  print(400,25,s);
end;


Procedure screenoutput;

{ Prints the description to Screen }

const scr_lines =7;
      start_line =11;

var t:string;
    lines:integer;

begin
  lines:=0;
  setapen(mywin^.rport,0);
  rectfill(mywin^.rport,4,12+start_line*9,winwidth-5,winheight-3);
  if nextline<>'' then
    begin
      while (nextline<>'') and (lines<scr_lines) do
        begin
          t:=nextline;
          nextline:=ptr(long(nextline)+strlen(t)+1);
          inc (shownlines);
          inc(lines);
          printat(1,start_line+lines,t);
        end;
    end
  else
    begin
      nextline:=desc;
      screenoutput;
    end;
end;



Procedure RecOut(Number:long);

{ Prints Disknumber and Progname, calls Screenout for rest}

var s:progname;
    i:integer;

begin
  getdesc(number);
  s:=intstr(index.disknum);
  s:=s+'   ';
  print(400,50,s);
  s:=name^;
  fill(s);
  print(400,75,s);
  screenoutput;
end;



function Getmessage:boolean;

{ Checks if someone hit  the stop-Gadget }


begin
  Getmessage:=false;
  repeat
    Msg:=p_intuimessage(Get_Msg(MyWin^.userport));
    if msg<>NIL then
      begin
        Case MSG^.Class of
          Gadgetup:
             begin
               g:= Msg^.iaddress;
               if g^.gadgetid = 11 then
                 Getmessage:=true
             end;
          vanillakey:
             begin
               case msg^.code of
                 ord('s'),ord('S'),ord(']'):
                   getmessage:=true;
                 otherwise begin
                           end;
               end;
             end;
          _CloseWindow:
            Getmessage:=true;
          otherwise begin
                    end;
        end;
        Reply_Msg(Msg);
      end
  until msg=nil
end;



Function Finddisk(Disk:integer):Long;

{ Find Fishdisk # Disk, return Record # of first
  program on this Disk}


var upper,lower,test:integer;
    found:boolean;
    dummy:long;

begin
  if disk=1 then
    finddisk:=1
  else
    begin
      status('Suche nach Disk..');
      found:=false;
      lower:=1;
      upper:=numrecords;
      if Disk > Numdisks then Disk:=1;
      if Disk < 1 then Disk:=numdisks;
      While not found do
        begin
          test:=Lower+(upper-lower) div 2;
          if upper-lower=1 then
            begin
              errormsg:='Disk No. '+intstr(disk)+' kann nicht gefunden werden !'+chr(10);
              dummy:=trequest('Achtung:',errormsg,'O.K.',nil,nil);
              found:=true;
            end;
          getinfo(test);
          if index.Disknum < Disk then
            lower:=test
          else if index.Disknum > Disk then
            Upper:=test
          else if index.disknum = Disk then
            found:=true
          else if index.disknum<>disk then
            begin
              errormsg:='Disk Nummer. '+intstr(disk)+' ist nicht'+chr(10)+
                        'im Datenfile !'+chr(10);
              dummy:=trequest('Achtung:',errormsg,'O.K.',nil,nil);
              found:=true;
            end;
        end;
      found:=false;
      if index.disknum=disk then
        begin
          while not found do
            begin
              dec (test);
              getinfo(test);
              if index.disknum = disk-1 then
                found:=true;
            end;
          inc(test);
          finddisk:=test;
          status('Disk gefunden !');
        end
      else
        begin
          finddisk:=test;
          status('Disk NICHT gefunden !');
        end;
    end;
end;



Function FindProg(wanted:progname;var start:integer;Direction:integer):Boolean;

{ Find a specified Program }

var Found,stop:boolean;
    i:integer;
    len:integer;
    position:integer;
    Uname:progname;

begin
  found:=false;
  stop:=false;
  len:=strlen(wanted);
  for i:=1 to len do
    wanted[i]:=upcase(wanted[i]);
  repeat
      getinfo(start);
      len:=strlen(name^);
      for i:=1 to len do
        uname[i]:=upcase(name^[i]);
      position:=pos(wanted,uname);
      if position <> 0 then
        found:=true
      else
        begin
          if direction > 0 then
            inc (start)
          else
            dec(start);
          if start>numrecords then
            begin
              start:=numrecords;
              stop:=true;
            end;
          if start<1 then
            begin
              start:=1;
              stop:=true;
            end;
        end;
  until (found or stop);
  findProg:=found;
  if not found then
    displaybeep(nil);
end;



Function FindText(wanted:progname;var start:integer;Direction:integer):Boolean;

{ Find a specified Text }

var Found,stop:boolean;
    i,len,position,disk:integer;
    Uname,s:progname;
    line:Str;
    t:string;

begin
  found:=false;
  stop:=false;
  len:=strlen(wanted);
  for i:=1 to len do
    wanted[i]:=upcase(wanted[i]);
  repeat
    getdesc(start);
    line:=desc;
    len:=strlen(name^);
    for i:=1 to len do
      uname[i]:=upcase(name^[i]);
    position:=pos(wanted,uname);
    if position <> 0 then
      found:=true
    else
      begin
        while (not found) and (line<>'') do
          begin
            t:=line;
            len:=strlen(t);
            line:=ptr(long(line)+len+1);
            for i:=1 to len do
               t[i]:=upcase(t[i]);
            position:=pos(wanted,t);
            if position <> 0 then
              found:=true
          end;
        if not found then
          begin
            if direction > 0 then
              inc (start)
            else
              dec(start);
            if start>numrecords then
              begin
                start:=numrecords;
                stop:=true;
              end;
            if start<1 then
              begin
                start:=1;
                stop:=true;
              end;
            if index.disknum <> disk then
              begin
                disk:=index.disknum;
                status('Textsuche läuft..');
                s:=intstr(disk)+'   ';
                print(400,50,s);
                stop:=Getmessage;
              end;
          end;
      end;
  until (found or stop);
  findtext:=found;
  if not found then
    displaybeep(nil);
end;



Function Checkprinter:Boolean;

{ Checks Kitchen for Water Level and Humidity - so what ? }

var state,ret:integer;
    myParPort: ^MsgPort;
    MyParReq: ^IoExtPar;
    success:long;
    ok:boolean;
    i:integer;

Label cleanup2,cleanup1,endcheckprinter;

begin
  checkprinter:=true;
  Myparport:=CreatePort('Printer_State',0);
  if Myparport=NIl then
    begin
      errormsg:=('Kann MsgPort nicht öffnen !')+chr(10);
      success:=Trequest('Fehler:',errormsg,nil,nil,nil);
      goto endcheckprinter;
    end;

  Myparreq:=CreateExtIO(myparport,sizeof(ioextpar));
  if myparreq=nil then
    begin
      errormsg:=('Kann keinen Request durchführen')+chr(10);
      success:=Trequest('Fehler:',errormsg,nil,nil,nil);
      goto cleanup1;
    end;

  myparreq^.io_parflags:=0;

  success:=Opendevice(Parallelname,0,myparreq,0);
  if success <>0 then
    begin
      errormsg:=('Kann Printer.device nicht öffnen !')+chr(10);
      success:=Trequest('Fehler:',Errormsg,nil,nil,nil);
      goto cleanup2;
    end;

   ok:=true;
   Myparreq^.IOPar.io_Message.mn_ReplyPort  := myparport;
   myparreq^.IOPar.io_Command               := PDCMD_QUERY;
   myparreq^.io_ParFlags                    := 0;

   ret:=DoIO(myparreq);
   state := myparreq^.io_Status;

   errormsg:='Anscheinend gibt es Schwierigkeiten'+chr(10)+
             'mit dem Drucker:'+chr(10)+chr(10);

   if (state and IOPTF_PSEL)>0 then
     begin
       errormsg:=errormsg+'Drucker OFFLINE ?'+chr(10);
       ok:=false
     end;

   if (state and IOPTF_PAPEROUT )>0 then
     begin
       errormsg:=errormsg+('Kein Papier ?' )+chr(10);
       ok:=false
     end;

   if ( state and IOPTF_PBUSY ) > 0 then
     begin
       errormsg:=errormsg+'Drucker BUSY ?'+chr(10);
     end;

   if not ok then
     begin
       success:=trequest('Achtung:',errormsg,' Abbrechen ',nil,' Drucken ');
       if success<>0 then checkprinter:=false
     end;

   CloseDevice(myparreq);
 cleanup2:
   deleteextio(Myparreq);
 cleanup1:
   Deleteport(myparport);
 Endcheckprinter:
 { Never trust Listings. Look at the RKM first }
end;



Procedure Export(number:integer);

{ Prints Disknum, progname, Description to either File or PRT: }

var f:text;
    line:str;
    t:string;
    len:integer;
    ok:boolean;
    dummy:long;

begin
  getinfo(number);
  getdesc(number);
  Dirn:='';
  Filen:='prt:';
  Filereq(Mywin,'Ausgabe nach:',dirn,filen);
  if filen<>'' then
    begin
      len:=strlen(filen);
      for i:=1 to len do
        filen[i]:=upcase(filen[i]);
      if filen='PRT:' then
        oK:=checkprinter
      else
        ok:=true;
      if ok then
        begin
          rewrite(f,filen);
          if IOresult<>0 then
            begin
              errormsg:='Datei nicht zu öffnen :'+chr(10)+filen+chr(10);
              dummy:=trequest('Fehler:',errormsg,nil,nil,nil);
            end
          else
            begin
              t:=name^;
              writeln(f,'Name      : ',t);
              writeln(f,'Fish Disk : ',index.Disknum);
              writeln(f,'');
              line:=desc;
              while line<>'' do
                begin
                  t:=line;
                  len:=strlen(t);
                  writeln(f,line);
                  line:=ptr(long(line)+len+1);
                end;
              writeln(f,'');
              writeln(f,'');
              close(f);
            end;
        end;
    end;
end;



Function getlength(Fname:filename):Long;

{ Returns Length of File 'Filename' }

var inf: p_FileInfoBlock;
    MyLock: BPTR;
    st:integer;

begin
   getlength:=-1;
   inf:=ptr(AllocMem(sizeOf(FileInfoBlock),Memf_public));
   if inf=Nil then
     begin
       errormsg:='Kein Speicher für Fileinfoblock !'+chr(10);
       endit(errormsg);
     end;
   MyLock:=Lock(FName,-2);
   If MyLock=0 Then
     begin
       errormsg:=Fname+' konnte nicht gefunden werden.'+chr(10)+chr(10)+
                 'Das riecht nach einem Konfigurationsfehler :'+chr(10)+
                 'S:FischersFreund.Config löschen und dann nochmal starten.'+chr(10);
       endit(errormsg);
     end
   Else
     begin
       st:=Examine(MyLock,inf);
       if st <>0 then
         begin
           If inf^.fib_DirEntryType>0 Then
             begin
               errormsg:='Keine Datei : '+Fname+chr(10);
               endit(errormsg);
             end
           Else
             getlength:=inf^.fib_Size;
         end
       else
         begin
           errormsg:='Kann Datei nicht untersuchen : '+Fname+chr(10);
           endit(errormsg);
         end;
       Unlock(Mylock);
     end;
   FreeMem(Long(inf),SizeOf(FileInfoBlock));
end;



Function existsfile (Fname:Filename):boolean;

{ checks if file exists }

var inf: p_FileInfoBlock;
    MyLock: BPTR;
    st:integer;

begin
  inf:=ptr(AllocMem(sizeOf(FileInfoBlock),Memf_public));
  if inf=Nil then
    begin
      errormsg:='Kein Speicher für Fileinfoblock !'+chr(10);
      endit(errormsg);
    end;
  MyLock:=Lock(FName,-2);
  If MyLock=0 Then
    existsfile:=false
  Else
    begin
      st:=Examine(MyLock,inf);
      if st <>0 then
        begin
          If inf^.fib_DirEntryType>0 Then
            existsfile:=false
          Else
            existsfile:=true;
        end
      else
        existsfile:=false;
      Unlock(Mylock);
    end;
  FreeMem(Long(inf),SizeOf(FileInfoBlock));
end;



procedure openfiles;

{ Loads Namefile and Indexfile to Memory, allocates Memory for
  Description and opens the Datafile }

var Fhandle:long;
    dx,dy:integer;

begin
  print(50,14,'Geh zu Fish - Disk:');
  print(50,39,'Programmsuche:');
  print(50,64,'Textsuche:');
  print(300,25,'Status   :  ');
  print(300,50,'FishDisk :  ');
  Print(300,75,'Programm :  ');

  Status('Öffne Namensdatei..');

  nameareasize:=getlength(namefile);
  namearea:=AllocMem(Nameareasize,Memf_public);
  if namearea=0 then
    begin
      errormsg:='Kein Speicher für Datei : '+namefile+chr(10);
      endit(errormsg);
    end;
  Fhandle:=Open(Namefile,Mode_Oldfile);
  if Fhandle=0 then
    begin
      errormsg:='Kann Datei nicht öffnen : '+namefile+chr(10);
      endit(errormsg);
    end;
  l:=Dosread(Fhandle,ptr(namearea),nameareasize);
  Dosclose(Fhandle);

  NumRecords:=nameareasize Div 20;

  Status('Öffne Indexdatei..');

  indexareasize:=getlength(Indexfile);
  indexarea:=AllocMem(indexareasize,Memf_public);
  if indexarea=0 then
    begin
      errormsg:='Kein Speicher für Datei : '+indexfile+chr(10);
      endit(errormsg);
    end;
  Fhandle:=Open(Indexfile,Mode_Oldfile);
  if Fhandle=0 then
    begin
      errormsg:='Kann Datei nicht öffnen : '+indexfile+chr(10);
      endit(errormsg);
    end;
  l:=Dosread(Fhandle,ptr(indexarea),indexareasize);
  Dosclose(Fhandle);

  desc:=ptr(allocmem(sizeof(Description),memf_public));
  if desc=nil then
    begin
      errormsg:='Kein Speicher !'+chr(10);
      endit(errormsg);
    end;

  Status('Öffne Datenfile..');

  DAtafile:=Open(Datafilename,Mode_Oldfile);
  if Datafile=0 then
    begin
      errormsg:='Kann Datei nicht öffnen : '+datafilename+chr(10);
      endit(errormsg);
    end;
  newpos:=Dosseek(Datafile,0,Offset_current);
  oldpos:=newpos;
  getinfo (numrecords);
  Numdisks:=index.Disknum;
  getinfo(act_record);
  recout(act_record);
  status('Abfahrt !');
end;


Procedure DoIcon(Var x,y:integer;);

Type Imagedata=Array [1..102] of word;

VAR MyWindow            : p_window ;
    Mynewwindow         : newwindow;
    MyImage             : Image;
    Myimagedata         : ^imagedata;
    MyGadget            : Gadget;
    IntuiMsg            : p_IntuiMessage ;
    Message             : IntuiMessage;
    FirstClick,
    EndFlag             : BOOLEAN;
    LastSecond,
    LastMicro,
    Second,
    Micro               : Long;


begin

    MyImagedata:=ptr(allocmem(sizeof(imagedata),memf_chip));
    if myimagedata=nil then
      Endit('Kein Speicher für Image');

  if IntLib_version<=34 then
    Myimagedata^:=imagedata(
       $ffff, $ffff, $8000, $8000, $0000, $0000, $8000, $0000,
       $0000, $8000, $0018, $0000, $8003, $e030, $0000, $800f,
       $c060, $0000, $80ff, $c1e0, $0000, $83cf, $ffe0, $0000,
       $878f, $ffe0, $0000, $9fff, $ffe0, $0000, $87fe, $fff0,
       $0000, $80f1, $e018, $0000, $801f, $8004, $0000, $8000,
       $0000, $0000, $8000, $0000, $0000, $8000, $0000, $0000,
       $0000, $0000, $0000,
       $0000, $0000, $4000, $0000, $0000, $4000, $0000, $001c,
       $4000, $0003, $f07c, $4000, $000f, $f0f8, $4000, $01ff,
       $e3f0, $4000, $07ff, $fff0, $4000, $0fbf, $fff0, $4000,
       $3fff, $fff0, $4000, $3fff, $fff8, $4000, $3fff, $fffc,
       $4000, $07ff, $fffe, $4000, $00ff, $f03e, $4000, $001f,
       $c00e, $4000, $0000, $0000, $4000, $7fff, $ffff, $c000,
       $0000, $0000, $0000)
  else
    Myimagedata^:=imagedata(
        $0000, $0000, $4000, $0000, $0000, $4008, $0000, $001c,
        $4006, $0003, $f07c, $4001, $000f, $f0f8, $4000, $01ff,
        $e3f0, $4000, $07ff, $fff0, $4000, $0fbf, $fff0, $4000,
        $3fff, $fff0, $4000, $3fff, $fff8, $4000, $3fff, $fffc,
        $4000, $07ff, $fffe, $4000, $00ff, $f03e, $4000, $001f,
        $c00e, $4000, $0000, $0000, $4000, $7fff, $ffff, $c000,
        $0000, $0000, $0000,
        $ffff, $ffff, $8000, $8000, $0000, $0000, $8000, $0000,
        $0000, $8000, $0018, $0000, $8003, $e030, $0000, $800f,
        $c060, $0000, $80ff, $c1e0, $0000, $83cf, $ffe0, $0000,
        $878f, $ffe0, $0000, $9fff, $ffe0, $0000, $87fe, $fff0,
        $0000, $80f1, $e018, $0000, $801f, $8004, $0000, $8000,
        $0000, $0000, $8000, $0000, $0000, $8000, $0000, $0000,
        $0000, $0000, $0000);

   MyImage:=Image(0,0,35,17,2,myimagedata,3,3,nil);
   Mygadget:=Gadget(Nil,0,0,0,0,
                    gadghimage+gRelWidth+gRelHeight,
                    gadgImmediate,Wdragging,
                    nil,nil,nil,0,nil,0,0);

  Mynewwindow:=newwindow(x,y,Myimage.width,myimage.height,0,1,
                         gadgetdown,
                         nocarerefresh+borderless+backdrop,
                         ^mygadget,nil,
                         nil,
                         nil,nil,
                         myimage.width,myimage.height,myimage.width,myimage.height,
                         WBenchScreen);

  MyWindow:=OpenWindow(^MyNewWindow);
  if mywindow=nil then
    begin
      freemem(long(Myimagedata),Sizeof(ImageData));
      endit('Unable to Iconify !');
    end;
  Windowtofront(mywindow);

  DrawImage(MyWindow^.rPort,^MyImage,0,0);

  EndFlag:=FALSE;
  FirstClick:=TRUE;
  REPEAT
      Intuimsg:=Wait_Port(MyWindow^.userPort);
      IntuiMsg:= p_intuimessage(Get_Msg(MyWindow^.userPort));
      WHILE IntuiMsg <> NIL DO
       begin
         Second:=IntuiMsg^.seconds;
         Micro :=IntuiMsg^.micros;
         Reply_Msg(IntuiMsg) ;
         IF NOT FirstClick THEN
           begin
             EndFlag:=DoubleClick(LastSecond,LastMicro,Second,Micro);
             if not endflag then
               firstclick:=true
           end
         ELSE
            FirstClick:=FALSE;
         IntuiMsg := p_intuimessage(Get_Msg(MyWindow^.userPort)) ;
         LastSecond:=Second;
         LastMicro:=Micro;
      END;
   UNTIL EndFlag;
   x:=MyWindow^.leftedge;
   y:=MyWindow^.topedge;
   CloseWindow(MyWindow);
   freemem(long(Myimagedata),Sizeof(ImageData));
END;





procedure openmythings;

{ opens window, sets up Gadgets & Window - Font,
  does the configuration if necessary }

var f:text;
    s:string;
    res:Integer;
    nofont:boolean;
    dirn2:Directoryname;
    dummy:long;


Label reopen;

begin
  Image1:=Ptr(allocmem(sizeof(Imagedata1),Memf_chip));
  Image2:=Ptr(allocmem(sizeof(Imagedata1),Memf_Chip));
  Image3:=Ptr(allocmem(sizeof(Imagedata1),Memf_Chip));
  Image4:=Ptr(allocmem(sizeof(Imagedata1),Memf_Chip));
  if (image1=nil) or (image2=nil) or (image3=nil) or (image4=nil) then
    begin
      errormsg:='Kein Speicher für Images'+chr(10);
      endit(errormsg);
    end;
  Initbuttondata;

  if not configured then
    begin
      reset(f,'S:FischersFreund.config');
      if IOresult=0 then
        begin
          configured:=true;
          readln(f,s);
          indexfile:=s;
          readln(f,s);
          namefile:=s;
          readln(f,s);
          datafilename:=s;
          readln(f,s);
          val(s,nw1x,res);
          readln(f,s);
          val(s,nw1y,res);
          readln(f,s);
          val(s,nw2x,res);
          readln(f,s);
          val(s,nw2y,res);
          close(f);
        end
      else
        configured:=false;
    end;


  NewWin:=newwindow(nw1x,nw1y,winwidth,winheight,0,1,
                 _CloseWindow+Gadgetup+vanillakey,
                 WindowClose+WindowDrag+Activate+WindowDEpth,
                 nil,nil,
                 "Des Fischers Freund © by Henrich Deppenmeier 5'91",
                 Nil,nil,
                 50,50,640,256,WBenchScreen);

  if diskfontbase<>nil then
    begin
      txat := TextAttr('topaz.font', 8, 0, 0);
      fnt := OpenFont(^txat);
      if fnt=nil then
        fnt:=Opendiskfont(^txat);
    end;

 { Buttons }
  for i:=1 to 6 do
   InitButton(i,Button[i]);

 { Stringgadget }

  LinkStringGadget(^StringGad[1],^StringgadText[1],^UndoText[1],^NewWin,150,20,50,25);
  LinkStringGadget(^StringGad[2],^StringgadText[2],^UndoText[2],^NewWin,150,20,50,50);
  LinkStringGadget(^StringGad[3],^StringgadText[3],^UndoText[3],^NewWin,150,20,50,75);

 { Gadgets }

  Linkgadget(^Gad[1],' ICON ',^NewWin,12,95);
  Linkgadget(^Gad[2],' STOP ',^NewWin,72,95);
  Linkgadget(^Gad[3],' EXPO ',^NewWin,132,95);
  Linkgadget(^Gad[4],' MEHR ',^NewWin,192,95);

reopen:

  MyWin:=Openwindow(^NewWin);
   if MyWin=Nil then
     begin
       errormsg:=('Kann Fenster nicht öffnen !')+chr(10);
       endit(errormsg);
     end;

  if diskfontbase<>nil then
    begin
      if fnt<>nil then
        nofont:=Setfont(mywin^.rport,fnt);
      if (fnt=nil) then
        begin
          errormsg:='Kann Topaz/80 nicht setzen'+chr(10);
          l:=trequest('Achtung:',errormsg,nil,nil,nil);
        end;
    end;

  LinkButton(Button[1],MyWin,10,23);
  LinkButton(Button[2],MyWin,208,23);
  LinkButton(Button[3],MyWin,10,48);
  LinkButton(Button[4],MyWin,208,48);
  LinkButton(Button[5],MyWin,10,73);
  LinkButton(Button[6],MyWin,208,73);

  reset(f,'S:FischersFreund.Config');
  if ioresult=0 then
    begin
      dummy:=filesize(f);
      close(f);
    end
  else
    dummy:=0;


  if (not configured) or (dummy < 24) then
    begin
      errormsg:='Die Datei S:FischersFreund.Config existiert noch'+chr(10)+
                'nicht oder ist leer.'+chr(10)+
                'Also mußt Du jetzt das Programm konfigurieren.'+chr(10);
      dummy:=Trequest('Willkommen bei Fischers Freund:',errormsg,'O.K.',nil,nil);
      errormsg:='Jetzt zeig mir mal den (absoluten) Pfad zu den '+chr(10)+
                'Aquarium-Dateien. Diese sollten sich in einem'+chr(10)+
                'Unterdirectory namens DATA befinden.'+chr(10);
      dummy:=Trequest('Erstens:',errormsg,'Jojo..',nil,nil);
      rewrite(f,'S:FischersFreund.config');
      if ioresult <>0 then
        begin
          errormsg:="Fehler beim Anlegen der Konfigurationsdatei"+chr(10)+
                    "S:FischersFreund.config - Exit"+chr(10);
          endit(errormsg);
        end;
      repeat
        Dirn:='Ram:';    { Filename should contain an absolute  Path}
        Filen:='INDEX';
        Filereq(mywin,'Select IndexFile',dirn,filen);
        if filen='' then
          begin
            close(f);
            dummy:=deletefile('S:FischersFreund.Config');
            endit('Konfiguration abgebrochen - Tschüssi !');
          end;
        if not existsfile(filen) then
          begin
            errormsg:='Die Datei '+filen+' existiert leider nicht !'+chr(10);
            l:=trequest('Fehler:',errormsg,nil,nil,nil);
          end;
      until existsfile(filen);
      indexfile:=filen;
      dirn2:=dirn;
      writeln(f,indexfile);
      if dirn2[strlen(dirn2)]<>':' then
        filen:=dirn2+'/'
      else
        filen:=dirn2;
      filen:=filen+'NAMES';
      if existsfile(filen) then
        begin
          writeln(f,filen);
          namefile:=filen;
        end
      else
        begin
          Dirn:=dirn2;
          Filen:='NAMES';
          Filereq(mywin,'Wo ist das File mit den Namen ?',dirn,filen);
          if filen='' then
            begin
              close(f);
              dummy:=deletefile('S:FischersFreund.config');
              endit('Konfiguration abgebrochen - Schönen Abend noch !');
            end;
          namefile:=filen;
          writeln(f,namefile);
        end;
      if dirn2[strlen(dirn2)]<>':' then
        filen:=dirn2+'/'
      else
        filen:=dirn2;
      filen:=filen+'DATA';
      if existsfile(filen) then
        begin
          writeln(f,filen);
          datafilename:=filen;
        end
      else
        begin
          Dirn:=dirn2;
          Filen:='DATA';
          Filereq(mywin,'Wo ist das File mit den Daten ?',dirn,filen);
          if filen='' then
            begin
              close(f);
              dummy:=deletefile('S:FischersFreund.config');
              endit('Konfiguration abgebrochen - Ab dafür !');
            end;
          Datafilename:=filen;
          writeln(f,datafilename);
        end;
      errormsg:='Jetzt kannst Du die Position für das normale'+chr(10)+
                'Window und das Icon festlegen.'+chr(10);
      dummy:=Trequest('Zweitens:',errormsg,'Und los..',nil,nil);
      errormsg:='Jetzt schieb mal das Haupt - Window rum, bis'+chr(10)+
                'Dir die Position gefällt, und dann drück hier'+chr(10)+
                'ZOSCH.'+chr(10);
      dummy:=Trequest('Windowposition festlegen:',errormsg,'ZOSCH',nil,nil);
      with mywin^ do
        begin
          nw1x:=leftedge;
          nw1y:=topedge;
        end;
      writeln(f,nw1x);
      writeln(f,nw1y);
      closewindow(mywin);
      errormsg:='Jetzt kannst Du noch eine Position für das Icon'+chr(10)+
                'festlegen (das gleich oben links in der Ecke'+chr(10)+
                'erscheinen sollte), indem du es zur richtigen'+chr(10)+
                'Stelle bewegst und es dann durch Doppelklick'+chr(10)+
                'aktivierst.'+chr(10);
      dummy:=Trequest('Iconposition festlegen:',errormsg,'O.K.',nil,nil);
      DoIcon(nw2x,nw2y);
      writeln(f,nw2x);
      writeln(f,nw2y);
      close (f);
      configured:=true;
      goto reopen
    end;
  Openfiles;
end;



procedure iconify;

{ Closes main Window and frees all used Memory, opens a
  new little window }

var  dummy  : long;

begin
  if datafile<>0 then dosclose(datafile);
  datafile:=0;
  if desc<>nil then freemem(long(desc),sizeof(Description));
  desc:=nil;
  if indexarea<>0 then FreeMem(indexarea,indexareasize);
  indexarea:=0;
  if namearea<>0 then FreeMem(namearea,Nameareasize);
  namearea:=0;
  nw1x:=mywin^.leftedge;
  nw1y:=mywin^.topedge;
  closewindow(mywin);
  mywin:=nil;
  if image1<>nil then Freemem(Long(Image1),sizeof(ImageData1));
  image1:=nil;
  if image2<>nil then Freemem(Long(Image2),sizeof(ImageData1));
  image2:=nil;
  if image3<>nil then Freemem(Long(Image3),sizeof(ImageData1));
  image3:=nil;
  if image4<>nil then Freemem(Long(Image4),sizeof(ImageData1));
  image4:=nil;
  if fnt<>nil then closefont(fnt);
  fnt:=nil;
  DoIcon(nw2x,nw2y);
  openmythings;
end;



procedure init;

{ Says 'Hello' to everybody and plays a nice
  little song.... :-) }

var f:text;
    i:integer;
    IntLib:p_library;

begin
  nw1x:=0;
  nw1y:=0;
  nw2x:=0;
  nw2y:=0;
  image1:=nil;
  image2:=nil;
  image3:=nil;
  image4:=nil;
  datafile:=0;
  desc:=nil;
  indexarea:=0;
  namearea:=0;
  mywin:=nil;
  intbase:=nil;
  gfxbase:=nil;
  reqbase:=nil;
  diskfontbase:=nil;
  fnt:=nil;

  addexitserver(exitserver);

  Intbase:=OpenLibrary('intuition.library',0);
  if intbase=nil then
    begin
      rewrite (f,'Con:0/0/400/50/Fehler:');
      writeln(f,'Kann ohne intuition.library nix reißen!');
      delay(100);
      close (f);
      halt(10)
    end;

  gfxbase:=OpenLibrary('graphics.library',0);
  if gfxbase=nil then
    begin
      rewrite (f,'Con:0/0/400/50/Fehler:');
      writeln(f,'Nix geht ohne gfx.library !');
      delay(100);
      close (f);
      halt(10)
    end;

  diskfontbase:=Openlibrary('diskfont.library',0);
  if diskfontbase=nil then
    begin
      rewrite (f,'Con:0/0/400/50/Fehler:');
      writeln(f,'Ich kann ohne diskfont.library keine Schrift setzen !');
      delay(100);
      close (f);
    end;

  reqbase:=Openlibrary('req.library',0);
  if reqbase=nil then
    begin
      rewrite (f,'Con:0/0/400/50/Fehler:');
      writeln(f,'Nix geht ohne req.library !');
      delay(100);
      close (f);
      halt(10)
    end;

  { Get Exec-Version in Order to determine if 'ActivateGadget' may be called }
  IntLib:=p_library(intbase);
  IntLib_Version:=IntLib^.lib_version;

  Act_Record:=1;
  for i:=1 to 3 do
    begin
      InitStringGadget(i+6,StringGad[i]);
      StringGadText[i]:='';
      UndoText[i]:='';
    end;
  for i:=1 to 4 do
    InitGadget(i+9,Gad[i]);
end;



begin
  init;
  openmythings;
  ende:=false;
  Status('Jetzt geht die P*st ab !');
  repeat
    Msg:=Wait_Port(MyWin^.userPort);
    Msg:=p_intuimessage(Get_Msg(MyWin^.userport));
    Case MSG^.Class of
      Gadgetup:
        begin
          g:= Msg^.iaddress;
          choice:=g^.gadgetid;
          reply_msg(msg);
        end;
      vanillakey:
        begin
          case msg^.code of
            ord('7'):choice:=1;
            ord('8'):choice:=14
            ord('9'):choice:=2;
            ord('4'):choice:=3;
            ord('5'):choice:=15
            ord('6'):choice:=4;
            ord('1'):choice:=5;
            ord('2'):choice:=16
            ord('3'):choice:=6;
            ord('i'),ord('I'),ord('['):choice:=10;
            ord('e'),ord('E'),ord('*'):choice:=12;
            ord('m'),ord('M'),ord('+'),ord('-'):choice:=13;
            ord('q'),ord('Q'),ord('/'):choice:=17;
            otherwise begin
                        choice:=0;
                      end;
          end;
          reply_msg(msg);
          repeat
            msg:=get_msg(mywin^.userport);
            if msg<>nil then
              reply_msg(msg);
          until msg=nil;
        end;
      _CloseWindow:
        begin
          choice:=17;
          reply_msg(msg);
        end;
    end;
    Case Choice of
      1: begin
           status('Vorhergehende Disk..');
           i:=index.disknum-1;
           if i<1 then
           begin
             i:=numdisks;
             displaybeep(nil);
           end;
           act_record:=finddisk(i);
           status('Fertig !');
           recout(act_record);
         end;
      2: begin
           Status('Nächste Disk..');
           i:=index.disknum+1;
           if i>numdisks then
             begin
               i:=1;
               displaybeep(nil);
             end;
           act_record:=finddisk(i);
           status('Fertig !');
           recout(act_record);
         end;
      3: begin
           if stringgadtext[2]='' then
             begin
               dec(act_record);
               if act_record<1 then
                 begin
                   act_record:=numrecords;
                   displaybeep(nil);
                 end;
               recout(act_record);
               status('Fertig !');
             end
           else
             begin
               if act_record>1 then
                 begin
                   dec (act_record);
                   status('Programsuche läuft..');
                   success:=findprog(stringgadtext[2],act_record,-1);
                   if success then
                     status('Programm gefunden!')
                   else
                     status('Programn NICHT gefunden !');
                 end
               else
                 displaybeep(nil);
               recout(act_record);
             end;
         end;
      4: begin
           if stringgadtext[2]='' then
             begin
               inc(act_record);
               if act_record>numrecords then
                 begin
                   act_record:=1;
                   displaybeep(nil);
                 end;
               recout(act_record);
               status('Fertig !');
             end
           else
             begin
               if act_record<numrecords then
                 begin
                   inc(act_record);
                   status('Programmsuche läuft..');
                   success:=findprog(stringgadtext[2],act_record,1);
                   if success then
                     status('Programm gefunden !')
                   else
                     status('Programm NICHT gefunden !');
                 end
               else
                 displaybeep(nil);
               recout(act_record);
             end;
         end;
      5: begin
           if (act_record>1) and (stringgadtext[3]<>'') then
             begin
               dec(act_record);
               success:=findtext(stringgadtext[3],act_record,-1);
               if success then
                 status('Text gefunden !')
               else
                 status('Text NICHT gefunden !');
               recout(act_record);
             end;
           if (act_record=1) and (stringgadtext[3]<>'') then
             displaybeep(nil);
         end;
      6: begin
           if (act_record < numrecords) and (stringgadtext[3]<>'') then
             begin
               inc(act_record);
               success:=findtext(stringgadtext[3],act_record,1);
               if success then
                 status('Text gefunden !')
               else
                 status('Text NICHT gefunden !');
               recout(act_record);
             end;
           if (act_record=numrecords) and (stringgadtext[3]<>'') then
              displaybeep(nil);
         end;
      7: begin
           val (stringgadtext[1],i,j);
           if j=0 then
             begin
               if (i>=1)and (i<=numdisks) then
                 begin
                   act_record:=finddisk(i);
                   recout(act_record);
                 end
               else
                 begin
                   if i<>0 then
                     begin
                       errormsg:='Disk # '+intstr(i)+' konnte nicht gefunden werden:'+chr(10)+
                                 'Im Datenfile sind nur Disk 1 - '+intstr(numdisks)+chr(10);
                       l:=trequest('Fehler:',errormsg,nil,nil,nil);
                     end;
                 end
             end
           else
             begin
               errormsg:='Ungültige Disknummer : '+stringgadtext[1]+chr(10);
               l:=Trequest('Fehler',errormsg,nil,nil,nil);
             end;
         end;
      10: iconify;
      12: Export(Act_record);
      13: Screenoutput
      14,15,16:
          begin
            if IntLib_Version < 33 then
              begin
                errormsg:='Die Tasten 2,5 und 8 können nicht benutzt werden,'+chr(10)+
                          'da Du eine alte Kickstart ( < 1.2)hast : '+chr(10)+
                          'intuition.library Version : '+intstr(IntLib_Version)+chr(10);
                l:=Trequest('Pech:',errormsg,'O.K.',nil,nil);
              end
            else
              success:=activategadget(^stringgad[choice-13].gadget,mywin,nil);
          end;
      17: ende:=true;
      otherwise begin
                end;
  end;
  until ende;
end.