'  | 
'- * - --------------------------------- + 
'  |           DiskBase V1.0a
'          Giftware s. GIFTWARE !
'    Programmiert von Volker Stepprath 
'      Copyright © 1994 by Testaware 
'     Zeitraum: 22.05.94 bis 09.07.94    | 
'  + --------------------------------- - * - 
'                                        | 

Set Buffer 200

Break Off 
Request Off 
Set Input 10,-1
Fix(2)

Dim XMSK$(15),XGNR$(99),XOPT$(14),XB$(6)
Global XMSK$(),XGNR$(),XOPT$(),XB$()
Global XGNR,XEBENE,XOPTION,XMUSIK,XSCHALTER
Global XDATUM$,XEIN$,XB$,XCODE$,XE,XWB,XX,XY,XDA,XGP#
Global XTPROGRAMME,XTDISKETTEN,XTPREIS#,XTANGEBOT#

Unpack 16 To 0
Erase All 
Hide 
Colour Back Colour(0)
For I=1 To 7 : Colour I,Colour(0) : Next 
Colour 17,$FFF : Colour 18,$F11 : Colour 19,$0

_INDEXCHECK
_KEY[17]
_AUS[""]
_INSTALLDB
_MAINLOOP

'***  Hauptfunktionsschleife  ***
'--------------------------------
Procedure _MAINLOOP
   
   Amos To Front : Wait 80

   Show : Fade 3,,$0,$57,$FFF,$F00,$BD,$CAF,$FF0 : Wait 50

   If Not Exist(":Index/DiskBase.dat") Then _GIFTWARE

   Do 
      XE=False
      N=Scancode
      Clear Key 
      Wait 10
      Repeat 
         N$=Inkey$
         N=Scancode
         If N<>False
            _KEY[N] : X=XX : Y=XY
            If X<>0 and Y<>0 : Goto A : End If 
         End If 
         Multi Wait 
      Until Mouse Key<>0
      X=X Screen(X Mouse) : Y=Y Screen(Y Mouse)

      A:
      If Y>170 and Y<183

         If X>533 and X<584 : Rem *** - 123
            
            Add X,-532 : XEBENE=X/17 : _MENU
            
         Else If X>7 and X<523 : Rem *** - Optionen 
            
            Add X,-7 : XOPTION=(X/103)+1 : 
            _G[8+(XOPTION-1)*103,170,7+XOPTION*103,182,1]
            
            If XEBENE=0
               On XOPTION Proc _ANZEIGEN,_SYSDISKFREE,_SORTIEREN,_AUSDRUCKEN,_INFORMATION
            Else If XEBENE=1
               On XOPTION Proc _EINTRAGEN,_AUSTRAGEN,_UEBERTRAGEN,_LOESCHEN,_EDITOR
            Else If XEBENE=2
               On XOPTION Proc _DISKCOPY,_TASTATUR,_VIRUSTEST,_SYSRESET,_ENDE
            End If 
            
            Wait 10 : _G[8+(XOPTION-1)*103,170,7+XOPTION*103,182,0]
            
         Else If X>594 and X<613 : Rem *** - E
            
            _MASKENEDITOR
            
         Else If X>612 and X<631 : Rem *** - M
            
            _MUSIK
            
         End If 
         
      End If 
      
      If Y>147 and Y<163
         If X<280
            For I=0 To 98 : If XGNR$(I+1)="" : Exit : End If : Next 
            
            _SCHALTER[X]
            
            If XSCHALTER=2 or XSCHALTER=5
               Add XGNR,-1,0 To I
               Ink 0 : Bar 188,38 To 628,53
               _BT[396-(Len(XGNR$(XGNR))*16)/2,39,XGNR$(XGNR),0]
            End If 
            If XSCHALTER=4 or XSCHALTER=6
               Add XGNR,1,0 To I
               Ink 0 : Bar 188,38 To 628,53
               _BT[396-(Len(XGNR$(XGNR))*16)/2,39,XGNR$(XGNR),0]
            End If 
         Else 
            If X>518 and X<623 : Rem *** - Bestellinfo
               _G[519,149,622,161,1]
               _BESTELLINFO
               Wait 50 : _G[519,149,622,161,0]
            End If 
         End If 
      End If 

      _SYSDISKFREE

   Loop 

End Proc
'--------------------------------

'*** Optionen der Menüebene 1 ***
'--------------------------------
Procedure _ANZEIGEN

   On Error Proc _ERROR

   XDAT$="Index/"+Str$(XGNR)-" "

   If Not Exist(XDAT$) Then _AUS["Es stehen keine Eintragungen zur Verfügung !"] : Pop Proc

   Trap Open In 1,XDAT$
   N$=Space$(42) : N=Varptr(N$)
   Trap Sload 1 To N,42
   XPROGRAMME=Val(Peek$(N,10))
   XDISK=Val(Peek$(N+10,10))
   XPREIS#=Val(Peek$(N+20,10))
   XANGEBOT#=Val(Peek$(N+30,10))

   XPMAX=XPROGRAMME-1
   Dim XP$(XPMAX)

   For I=0 To XPMAX
      Trap Line Input #1,XP$(I)
   Next 
   Trap Close 1

   If XPROGRAMME=False Then _AUS["Es stehen keine Eintragungen zur Verfügung !"] : Pop Proc

   Gosub E

   Do 
      _ZEIGE[XP$(P),Str$(P+1)-" "]
      Do 

         Exit If Mouse Key
         N$=Inkey$
         N=Scancode
         
         If N
            If N=95
               _EIN["Bitte Bestellnummer eingeben:",""] : _AUS[""]
               If XEIN$<>""
                  XEIN$=Upper$(XEIN$)
                  If Asc(Right$(XEIN$,1))<65 : XEIN$=XEIN$+Chr$(65+XGNR) : End If 
                  For I=0 To XPMAX
                     N$=Flip$(XP$(I))
                     N$=Flip$(Left$(N$,Instr(N$,"|")-1))
                     If N$=XEIN$
                        P=I : Ink 1,0 : Goto D
                     End If 
                  Next 
                  _AUS["Unter dieser Bestellnummer ist kein Eintrag vorhanden !"]
               End If 
               Ink 1,0 : Goto A
            Else 
               _KEY[N] : X=XX : Y=XY : Goto A
            End If 
         End If 

         Multi Wait 

      Loop 

      X=X Screen(X Mouse) : Y=Y Screen(Y Mouse)

   A: If Y>147 and Y<163

         If X<280
            _SCHALTER[X]
            If XSCHALTER=1
               _FREIZEILE : Exit 
            Else If XSCHALTER=2
               _G[65,148,89,162,1]
               Repeat 
                  Repeat 
                     Add P,-1,0 To XPMAX
                     _ZEIGE[XP$(P),Str$(P+1)-" "]
                     N$=Inkey$
                     N=Scancode
                     If N<>0
                        _KEY[N] : X=XX : Y=XY : Goto B
                     End If 
                  Until Mouse Key<>0
                  X=X Screen(X Mouse) : Y=Y Screen(Y Mouse)
                  B: If Y>147 and Y<163 : _SCHALTER[X] : End If 
               Until XSCHALTER=3
               _G[65,148,89,162,0]
            Else If XSCHALTER=4
               _G[153,148,177,162,1]
               Repeat 
                  Repeat 
                     Add P,1,0 To XPMAX
                     _ZEIGE[XP$(P),Str$(P+1)-" "]
                     N$=Inkey$
                     N=Scancode
                     If N<>0
                        _KEY[N] : X=XX : Y=XY : Goto C
                     End If 
                  Until Mouse Key<>0
                  X=X Screen(X Mouse) : Y=Y Screen(Y Mouse)
                  C: If Y>147 and Y<163 : _SCHALTER[X] : End If 
               Until XSCHALTER=3
               _G[153,148,177,162,0]
            Else If XSCHALTER=5
               Add P,-1,0 To XPMAX
            Else If XSCHALTER=6
               Add P,1,0 To XPMAX
            End If 
         End If 
      End If 

      If Y>147 and Y<162
         If X>294 and X<399 : Rem *** - Bestellen
            _G[295,149,398,161,1]
            XB$=XB$+String$(" ",7-Len(XB$(6)))+XB$(6)+"   "
            A$=Left$(XB$(0),40)
            XB$=XB$+A$+String$(" ",43-Len(A$))+"   "
            XB$=XB$+String$(" ",2-Len(XB$(3)))+XB$(3)+"   "
            XB$=XB$+String$(" ",10-Len(XB$(5)))+XB$(5)
            XB$=XB$+Chr$(10)
            XDA=XDA+Val(XB$(3))
            XGP#=XGP#+Val(XB$(5))
            Wait 15 : _G[295,149,398,161,0]
         End If 
         If X>406 and X<511 : Rem *** - Stornieren 
            _G[407,149,510,161,1]
            N$=String$(" ",7-Len(XB$(6)))+XB$(6)+"   "
            A$=Left$(XB$(0),40)
            N$=N$+A$+String$(" ",43-Len(A$))+"   "
            N$=N$+String$(" ",2-Len(XB$(3)))+XB$(3)+"   "
            N$=N$+String$(" ",10-Len(XB$(5)))+XB$(5)
            N$=N$+Chr$(10)
            F=Hunt(Varptr(XB$) To Varptr(XB$)+Len(XB$),N$)
            If F
               Poke$ F,String$(Chr$(0),72)
               XB$=XB$-String$(Chr$(0),72)
               XDA=XDA-Val(XB$(3))
               XGP#=XGP#-Val(XB$(5))
            End If 
            Wait 15 : _G[407,149,510,161,0]
         End If 
         If X>518 and X<623 : Rem *** - Bestellinfo
            _G[519,149,622,161,1]
            _BESTELLINFO
            Wait 50 : _G[519,149,622,161,0]
         End If 
      End If 

      If Y>170 and Y<183

         If X>533 and X<584 : Rem *** - 123

            Add X,-532 : XEBENE=X/17 : _MENU

         Else If X>7 and X<523 : Rem *** - Optionen 

            Add X,-7 : XOPTION=(X/103)+1 : 
            _G[8+(XOPTION-1)*103,170,7+XOPTION*103,182,1]

            If XEBENE=0

               '*** SUCHEN ***
               '--------------
               If XOPTION=2
                  _EIN["Bitte zu suchendes Programm eingeben:",""] : _AUS[""]
                  If XEIN$<>""
                     A$=Upper$(XEIN$) : N=False
                     For I=0 To XPMAX
                        B$=Upper$(Left$(XP$(I),Instr(XP$(I),"|")-1))
                        If A$=B$ : P=I : N=True : Exit : End If 
                     Next 
                     If N=False
                        _AUS["Programm nicht eingetragen... suche nach vergleichbarem !"] : Wait 100
                        For I=0 To XPMAX
                           B$=Left$(Upper$(Left$(XP$(I),Instr(XP$(I),"|")-1)),Len(A$))
                           If Instr(B$,A$) : P=I : N=True : Exit : End If 
                        Next 
                     End If 
                     If N=False : _AUS["Programm nicht gefunden !"] : Else _AUS[""] : End If 
                  End If 

               Else If XOPTION=3
                  '*** SORTIEREN *** 
                  '----------------- 
                  Sort XP$(0) : _ZEIGE[XP$(0),"1"] : P=0

               Else If XOPTION=4 : _AUSDRUCKEN
               Else If XOPTION=5 : _INFORMATION
               End If 

            Else If XEBENE=1
               On XOPTION Proc _EINTRAGEN,_AUSTRAGEN,_UEBERTRAGEN,_LOESCHEN,_EDITOR
            Else If XEBENE=2
               On XOPTION Proc _DISKCOPY,_TASTATUR,_VIRUSTEST,_SYSRESET,_ENDE
            End If 

            _SYSDISKFREE

            Wait 10 : _G[8+(XOPTION-1)*103,170,7+XOPTION*103,182,0]

         Else If X>594 and X<613 : Rem *** - E

            _MASKENEDITOR

         Else If X>612 and X<631 : Rem *** - M

            _MUSIK

         End If 

      End If 

      If XEBENE=0 Then _G[8,170,110,182,1]

      D: Gosub E : N=Scancode : Clear Key 
   Loop 

   _G[8,170,110,182,0]
   Pop Proc

E: N$=Str$(XPROGRAMME)-" " : _ST[144,131,String$(" ",6-Len(N$))+N$,0,0]
   N$=Str$(XDISK)-" " : _ST[567,118,String$(" ",7-Len(N$))+N$,0,0]
   N$=Str$(XPREIS#)-" " : _ST[335,131,String$(" ",9-Len(N$))+N$,0,0]
   N$=Str$(XANGEBOT#)-" " : _ST[551,131,String$(" ",9-Len(N$))+N$,0,0]
   Return 

End Proc
Procedure _SORTIEREN

   _CODE : If XE Then Pop Proc

   On Error Proc _ERROR

   XDAT$="Index/"+Str$(XGNR)-" "

   If Not Exist(XDAT$) Then _AUS["Es stehen keine Eintragungen zur Verfügung !"] : Pop Proc

   Open In 1,XDAT$
   If XE Then Pop Proc
   N$=Space$(42) : N=Varptr(N$)
   Trap Sload 1 To N,42
   XPROGRAMME=Val(Peek$(N,10))

   XPMAX=XPROGRAMME-1
   Dim XP$(XPMAX)

   For I=0 To XPMAX
      Trap Line Input #1,XP$(I)
   Next 
   Close 1

   Sort XP$(0)

   Open Out 1,XDAT$
   If XE Then Pop Proc
   Trap Ssave 1,N To N+42
   For I=0 To XPMAX
      Trap Print #1,XP$(I)+Chr$(10);
   Next 
   Close 1

   _AUS["Datei "+XGNR$(XGNR)+" wurde alphabetisch sortiert !"]

End Proc
Procedure _AUSDRUCKEN
   
   On Error Proc _ERROR

   If XB$="" Then _AUS["Keine Bestelleinträge vorhanden !"] : Pop Proc

   _EIN["Aktuelle Bestellung auf den Drucker Ausgeben (J/N) ?:","J"]
   If Upper$(XEIN$)<>"J" Then _AUS[""] : Pop Proc

   Trap Printer Open 
   If Errtrap Then _AUS["Konnte leider das Printer Device nicht öffnen !"] : Pop Proc

   N$="BstlNr:   Programmname:"+Space$(29)+"Disks:"+Space$(7)+"Preis:" : Gosub B
   N$=String$("-",71) : Gosub B
   N$=Left$(XB$,Len(XB$)-1) : Gosub B
   N$=String$("-",71) : Gosub B

   A=Varptr(XB$) : L=A+Len(XB$)
   Repeat 
      F=Hunt(A To L,Chr$(10))
      If F : Inc XPA : A=F+1 : End If 
   Until F=False
   N0$=Str$(XPA)-" " : N0$=N0$+String$(" ",10-Len(N0$))
   N1$=Str$(XDA)-" " : N1$=N1$+String$(" ",10-Len(N1$))
   N2$=Str$(XGP#)-" " : N2$=String$(" ",10-Len(N2$))+N2$
   N$="Programmanzahl: "+N0$+"Diskanzahl: "+N1$+"Gesamtpreis: "+N2$ : Gosub B

   Printer Close 
   _AUS[""]
   Pop Proc

B: N$=N$+Chr$(27)+"E"
   Printer Send N$
   While Printer Check=False : Wend 
   Return 

End Proc
Procedure _INFORMATION

   On Error Proc _ERROR

   Screen Open 1,640,160,8,Hires
   If XE Then Pop Proc
   Screen Hide 1
   Screen Display 1,,85,,149
   Flash Off 
   Curs Off 
   Cls 0
   Get Palette 0

   _G[0,0,638,148,0] : _G[7,3,632,145,1] : _G[8,4,631,144,0]

   D$=String$(".",Len(XMSK$(1)))+":"

   _ST[194,15,"Allgemeine Bestandsinformationen",1,1]

   N$=Str$(XTPROGRAMME)-" " : N$=String$(" ",12-Len(N$))+N$
   _ST[110,40,"Programmanzahl.................."+D$+N$,0,1]

   N$=Str$(XTDISKETTEN)-" " : N$=String$(" ",12-Len(N$))+N$
   _ST[110,50,"Diskettenbestand................"+D$+N$,0,1]

   N$=Str$(XTPREIS#)-" " : N$=String$(" ",12-Len(N$))+N$
   _ST[110,60,"Wert der "+XMSK$(1)+"sammlung...............:"+N$,0,1]

   N$=Str$(XTANGEBOT#)-" " : N$=String$(" ",12-Len(N$))+N$
   _ST[110,70,"Angebot der "+XMSK$(1)+"sammlung...."+D$+N$,0,1]

   _ST[110,80,"Datum der letzten Aktualisierung"+D$+"  "+XDATUM$,0,1]

   N$=Space$(232)
   Areg(0)=Varptr(N$)
   Dreg(0)=232
   _LVOGETPREFS=Intcall(-132)
   N$=Peek$(_LVOGETPREFS+128,10,Chr$(0))
   _ST[110,102,"Eingestellter Druckertreiber............:  "+String$(" ",10-Len(N$))+N$,1,1]

   N$=Str$(Free)-" " : N$=String$(" ",12-Len(N$))+N$
   _ST[110,117,"Verfuegbarer Buffer............."+D$+N$,1,1]

   Screen Show 1 : _WAIT : Screen Close 1

End Proc
'--------------------------------

'*** Optionen der Menüebene 2 ***
'--------------------------------
Procedure _EINTRAGEN

   On Error Proc _ERROR

   _CODE : If XE Then Pop Proc

   XDAT$=":Index/"+Str$(XGNR)-" "
   If Exist(XDAT$)
      Open Random 1,XDAT$
      Field 1,10 As XPROGRAMME$,10 As XDISK$,10 As XPREIS$,10 As XANGEBOT$
      If XE : Pop Proc : End If 
      Get 1,1
      Close 1
      XPROGRAMME=Val(XPROGRAMME$)
      XDISK=Val(XDISK$)
      XPREIS#=Val(XPREIS$)
      XANGEBOT#=Val(XANGEBOT$)
   Else 
      Open Out 1,XDAT$
      If XE : Pop Proc : End If 
      Trap Print #1,Space$(40)
      Close 1
   End If 

   Append 1,XDAT$
   If XE Then Pop Proc

   Do 

      D$=""
      _EIN[XMSK$(1)+":",""] : X=195 : Y=68 : L=53 : Gosub B
      _EIN[XMSK$(2)+":",""] : X=195 : Y=81 : L=53 : Gosub B
      _EIN[XMSK$(3)+":",""] : X=195 : Y=94 : L=53 : Gosub B
      _EIN[XMSK$(4)+":",""] : X=195 : Y=107 : L=2 : Gosub B : N0=Val(N$)
      _EIN[XMSK$(5)+":",""] : X=356 : Y=107 : L=10 : Gosub B : N1#=Val(N$)
      _EIN[XMSK$(6)+":",""] : X=540 : Y=107 : L=10 : Gosub B : N2#=Val(N$)

      N$=Str$(XPROGRAMME+1)+Chr$(65+XGNR)
      D$=D$+(N$-" ")

      _AUS["Schreibe Programmdaten auf Diskette !"]
      Print #1,D$+Chr$(10);

      Wait 70 : _FREIZEILE : XOK=True

      Exit If XE

      Inc XTPROGRAMME
      Inc XPROGRAMME
      Add XDISK,N0 : Add XTDISKETTEN,N0
      XPREIS#=XPREIS#+N1# : XTPREIS#=XTPREIS#+N1#
      XANGEBOT#=XANGEBOT#+N2# : XTANGEBOT#=XTANGEBOT#+N2#

   Loop 

A: _FREIZEILE
   Trap Close 1

   If XOK
      Open Random 1,XDAT$
      Field 1,10 As XPROGRAMME$,10 As XDISK$,10 As XPREIS$,10 As XANGEBOT$
      If XE : Pop Proc : End If 
      XPROGRAMME$=Str$(XPROGRAMME)-" "
      XDISK$=Str$(XDISK)-" "
      XPREIS$=Str$(XPREIS#)-" "
      XANGEBOT$=Str$(XANGEBOT#)-" "
      Put 1,1
      Close 1

      _UPDATEDBINFO

   End If 

   _AUS[""]

   Pop Proc

B: If L=10 Then N#=Val(XEIN$) : XEIN$=Str$(N#)-" " : Rem *** Wenn Preisangaben
   N$=XEIN$ : N$=N$-"," : N$=N$-"|" : N$=Left$(N$,L)
   If N$="" Then Pop : Goto A
   Ink 1,0 : If Y>106 Then Text X,Y,String$(" ",L-Len(N$))+N$ Else Text X,Y,N$
   D$=D$+N$+"|"
   Return 

End Proc
Procedure _AUSTRAGEN
   
   _CODE : If XE Then Pop Proc
   
   On Error Proc _ERROR
   
   XDAT$="Index/"+Str$(XGNR)-" "
   
   If Not Exist(XDAT$) Then _AUS["Es stehen keine Eintragungen zur Verfügung !"] : Pop Proc
   
   Open In 1,XDAT$
   If XE Then Pop Proc
   N$=Space$(42) : N=Varptr(N$)
   Sload 1 To N,42
   XPROGRAMME=Val(Peek$(N,10))
   XDISK=Val(Peek$(N+10,10))
   XPREIS#=Val(Peek$(N+20,10))
   XANGEBOT#=Val(Peek$(N+30,10))
   
   XD=XDISK
   XP#=XPREIS#
   XA#=XANGEBOT#
   XPMAX=XPROGRAMME-1
   Dim XP$(XPMAX)
   
   For I=0 To XPMAX
      Trap Line Input #1,XP$(I)
   Next 
   Close 1
   
   Gosub A
   
   Do 
      
      _EIN["Bitte "+XMSK$(8)+" angeben (1-"+Str$(XPMAX+1)-" "+"):",""]
      N=Val(XEIN$)-1
      Exit If N<0
      
      If N<=XPMAX and XPROGRAMME>0
         If XP$(N)<>""
            Ink 1,0 : _ZEIGE[XP$(N),Str$(N+1)-" "]
            _EIN["Eintrag wirklich löschen (J/N) ?:","J"]
            If Upper$(XEIN$)="J"
               _AUS["Eintrag gelöscht !"]
               XP$(N)=""
               Dec XPROGRAMME
               Add XD,-Val(XB$(3))
               XP#=XP#-Val(XB$(4))
               XA#=XA#-Val(XB$(5))

               XLN=False : XBN=False : N=False
               For I=0 To XPMAX
                  If XP$(I)<>""
                     N$=Flip$(XP$(I))
                     N$=Flip$(Left$(N$,Instr(N$,"|")-1))
                     If Val(N$)>Val(XB$(6))
                        XLN=I : N=True
                     End If 
                  End If 
               Next 

               If N=True
                  N$=Flip$(XP$(XLN))
                  N$=Flip$(Left$(N$,Instr(N$,"|")-1))
                  XP$(XLN)=XP$(XLN)-N$+XB$(6)
               End If 
               
               Wait 50 : _FREIZEILE : Gosub A

            End If 
         End If 
      End If 
      
   Loop 
   
   _FREIZEILE : _AUS[""]
   
   Open Out 1,XDAT$
   If XE : Pop Proc : End If 
   Trap Print #1,Space$(40)
   For I=0 To XPMAX
      If XP$(I)<>"" Then Trap Print #1,XP$(I)+Chr$(10);
   Next 
   Close 1

   Add XTPROGRAMME,XPROGRAMME-(XPMAX+1)
   Add XTDISKETTEN,XD-XDISK
   XTPREIS#=XTPREIS#-XPREIS#+XP#
   XTANGEBOT#=XTANGEBOT#-XANGEBOT#+XA#
   
   Open Random 1,XDAT$
   Field 1,10 As XP$,10 As XD$,10 As XS$,10 As XA$
   If XE : Pop Proc : End If 
   XP$=Str$(XPROGRAMME)-" "
   XD$=Str$(XD)-" "
   XS$=Str$(XP#)-" "
   XA$=Str$(XA#)-" "
   Put 1,1
   Close 1

   If XPROGRAMME=0 Then Trap Kill XDAT$
   
   _UPDATEDBINFO

   Pop Proc
   
A: N$=Str$(Abs(XPROGRAMME))-" " : _ST[144,131,String$(" ",6-Len(N$))+N$,0,0]
   N$=Str$(Abs(XD))-" " : _ST[567,118,String$(" ",7-Len(N$))+N$,0,0]
   N$=Str$(Abs(XP#))-" " : _ST[335,131,String$(" ",9-Len(N$))+N$,0,0]
   N$=Str$(Abs(XA#))-" " : _ST[551,131,String$(" ",9-Len(N$))+N$,0,0]
   Return 
   
End Proc
Procedure _UEBERTRAGEN
   
   _CODE : If XE Then Pop Proc

   On Error Proc _ERROR
   
   XDATA$=":Index/"+Str$(XGNR)-" "
   
   If Not Exist(XDATA$) Then _AUS["Es stehen keine Eintragungen zur Verfügung !"] : Pop Proc
   
   Trap Open In 1,XDATA$
   N$=Space$(42) : N=Varptr(N$)
   Trap Sload 1 To N,42
   XPA=Val(Peek$(N,10))
   XDA=Val(Peek$(N+10,10))
   XPA#=Val(Peek$(N+20,10))
   XAA#=Val(Peek$(N+30,10))
   
   XPMAXA=XPA-1
   Dim XPA$(XPMAXA)
   
   For I=0 To XPMAXA
      Trap Line Input #1,XPA$(I)
   Next 
   Trap Close 1
   
   _AUS["Bitte "+XMSK$(0)+" für Übertrag wählen (Return wenn fertig) !"]
   
   Do 
      XE=False
      N=Scancode
      Clear Key 
      Wait 10
      Repeat 
         N$=Inkey$
         N=Scancode
         If N<>False
            _KEY[N] : X=XX : Y=XY
            Exit If X<>0 and Y<>0
         End If 
         Multi Wait 
      Until Mouse Key<>0
      X=X Screen(X Mouse) : Y=Y Screen(Y Mouse)
      
      A: If Y>147 and Y<163 and X<280
         For I=0 To 98 : If XGNR$(I+1)="" : Exit : End If : Next 
         
         _SCHALTER[X]
         
         If XSCHALTER=2 or XSCHALTER=5
            Add XGNR,-1,0 To I
            Ink 0 : Bar 188,38 To 628,53
            _BT[396-(Len(XGNR$(XGNR))*16)/2,39,XGNR$(XGNR),0]
         End If 
         If XSCHALTER=4 or XSCHALTER=6
            Add XGNR,1,0 To I
            Ink 0 : Bar 188,38 To 628,53
            _BT[396-(Len(XGNR$(XGNR))*16)/2,39,XGNR$(XGNR),0]
         End If 
         
         If XSCHALTER=1
            XDATB$=":Index/"+Str$(XGNR)-" "
            If XDATA$=XDATB$
               _AUS["Gleiches "+XMSK$(0)+" gewählt... Prozess abgebrochen !"]
               Pop Proc
            End If 

            If Exist(XDATB$)
               Trap Open In 1,XDATB$
               N$=Space$(42) : N=Varptr(N$)
               Trap Sload 1 To N,42
               XPB=Val(Peek$(N,10))
               XDB=Val(Peek$(N+10,10))
               XPB#=Val(Peek$(N+20,10))
               XAB#=Val(Peek$(N+30,10))
               Close 1
               N=True
            Else 
               N=False
            End If 
            
            Append 1,XDATB$
            If N=False : Rem --* Falls neues Genre anlegen !
               Print #1,Space$(40)
               If XE : Trap Close 1 : Pop Proc : End If 
            End If 
            
            Do 
               _EIN["Bitte "+XMSK$(8)+" angeben (1-"+Str$(XPMAXA+1)-" "+"):",""]
               N=Val(XEIN$)-1
               Exit If N<0,2
               
               If N<=XPMAXA
                  If XPA$(N)<>""
                     Ink 1,0 : _ZEIGE[XPA$(N),Str$(N+1)-" "]
                     _EIN["Eintrag wirklich übertragen (J/N) ?:","J"]
                     If Upper$(XEIN$)="J"
                        Inc XPB : Dec XPA
                        Add XDB,Val(XB$(3)) : Add XDA,-Val(XB$(3))
                        XPB#=XPB#+Val(XB$(4)) : XPA#=XPA#-Val(XB$(4))
                        XAB#=XAB#+Val(XB$(5)) : XAA#=XAA#-Val(XB$(5))

                        XLN=False : XBN=False : A=False
                        For I=0 To XPMAXA
                           If XPA$(I)<>""
                              N$=Flip$(XPA$(I))
                              N$=Flip$(Left$(N$,Instr(N$,"|")-1))
                              If Val(N$)>Val(XB$(6))
                                 XLN=I : A=True
                              End If 
                           End If 
                        Next 
                        If A=True
                           N$=Flip$(XPA$(XLN))
                           N$=Flip$(Left$(N$,Instr(N$,"|")-1))
                           XPA$(XLN)=XPA$(XLN)-N$+XB$(6)
                        End If 

                        N$=Flip$(XPA$(N))
                        N$=Flip$(Left$(N$,Instr(N$,"|")-1))
                        XPA$(N)=XPA$(N)-N$+Str$(XPB)-" "+Chr$(65+XGNR)
                        
                        Trap Print #1,XPA$(N)+Chr$(10);
                        XPA$(N)=""
                        Wait 50 : _FREIZEILE
                        
                     End If 
                  End If 
               End If 
            Loop 
            
         End If 
         
      End If 
      
   Loop 
   
   Close 1
   
   If XPA>0
      Open Out 1,XDATA$
      Trap Print #1,Space$(40)
      For I=0 To XPMAXA
         If XPA$(I)<>"" : Trap Print #1,XPA$(I)+Chr$(10); : End If 
      Next I
      Close 1
   
      Open Random 1,XDATA$
      Field 1,10 As XG$,10 As XD$,10 As XP$,10 As XA$
      If XE : Pop Proc : End If 
      XG$=Str$(XPA)-" "
      XD$=Str$(XDA)-" "
      XP$=Str$(XPA#)-" "
      XA$=Str$(XAA#)-" "
      Put 1,1
      Close 1
   Else 
      Trap Kill XDATA$
   End If 
   
   Open Random 1,XDATB$
   Field 1,10 As XG$,10 As XD$,10 As XP$,10 As XA$
   If XE : Pop Proc : End If 
   XG$=Str$(XPB)-" "
   XD$=Str$(XDB)-" "
   XP$=Str$(XPB#)-" "
   XA$=Str$(XAB#)-" "
   Put 1,1
   Close 1

   _FREIZEILE
   _AUS[""]

End Proc
Procedure _LOESCHEN

   _CODE : If XE Then Pop Proc

   On Error Proc _ERROR

   XDAT$=":Index/"+Str$(XGNR)-" "

   If Not Exist(XDAT$) Then _AUS["Es stehen keine Eintragungen zur Verfügung !"] : Pop Proc

   _EIN["Eintragungen der Datei "+XGNR$(XGNR)+" wirklich löschen (J/N) ?:","J"]
   If Upper$(XEIN$)<>"J" Then _AUS[""] : Pop Proc

   Trap Open In 1,XDAT$
   N$=Space$(40) : N=Varptr(N$)
   Trap Sload 1 To N,40
   XPROGRAMME=Val(Peek$(N,10))
   XDISK=Val(Peek$(N+10,10))
   XPREIS#=Val(Peek$(N+20,10))
   XANGEBOT#=Val(Peek$(N+30,10))
   Trap Close 1

   Kill XDAT$ : If XE Then Pop Proc

   Add XTPROGRAMME,-XPROGRAMME
   Add XTDISKETTEN,-XDISK
   XTPREIS#=XTPREIS#-XPREIS#
   XTANGEBOT#=XTANGEBOT#-XANGEBOT#

   _UPDATEDBINFO

   _AUS["Daten der Datei "+XGNR$(XGNR)+" vollständig gelöscht !"]

End Proc
Procedure _EDITOR

   _CODE : If XE Then Pop Proc

   On Error Proc _ERROR

   XDAT$="Index/"+Str$(XGNR)-" "

   If Not Exist(XDAT$) Then _AUS["Es stehen keine Eintragungen zur Verfügung !"] : Pop Proc

   Open In 1,XDAT$
   If XE Then Pop Proc
   N$=Space$(42) : N=Varptr(N$)
   Sload 1 To N,42
   XPROGRAMME=Val(Peek$(N,10))
   XDISK=Val(Peek$(N+10,10))
   XPREIS#=Val(Peek$(N+20,10))
   XANGEBOT#=Val(Peek$(N+30,10))

   XD=XDISK
   XP#=XPREIS#
   XA#=XANGEBOT#
   XPMAX=XPROGRAMME-1
   Dim XP$(XPMAX)

   For I=0 To XPMAX
      Trap Line Input #1,XP$(I)
   Next 
   Close 1

   N$=Str$(XPROGRAMME)-" " : _ST[144,131,String$(" ",6-Len(N$))+N$,0,0]
   N$=Str$(XD)-" " : _ST[567,118,String$(" ",7-Len(N$))+N$,0,0]
   N$=Str$(XP#)-" " : _ST[335,131,String$(" ",9-Len(N$))+N$,0,0]
   N$=Str$(XA#)-" " : _ST[551,131,String$(" ",9-Len(N$))+N$,0,0]

   Do 

      _EIN["Bitte "+XMSK$(8)+" angeben (1-"+Str$(XPMAX+1)-" "+"):",""]
      N=Val(XEIN$)-1
      Exit If N<0

      If N<=XPMAX
         Ink 1,0 : _ZEIGE[XP$(N),Str$(N+1)-" "]

         D$=""
         _EIN[XMSK$(1)+":",XB$(0)] : X=195 : Y=68 : L=53 : P=0 : Gosub B
         _EIN[XMSK$(2)+":",XB$(1)] : X=195 : Y=81 : L=53 : P=1 : Gosub B
         _EIN[XMSK$(3)+":",XB$(2)] : X=195 : Y=94 : L=53 : P=2 : Gosub B
         _EIN[XMSK$(4)+":",XB$(3)] : X=195 : Y=107 : L=2 : P=3 : Gosub B : N0=Abs(Val(N$))
         _EIN[XMSK$(5)+":",XB$(4)] : X=356 : Y=107 : L=10 : P=4 : Gosub B : N1#=Abs(Val(N$))
         _EIN[XMSK$(6)+":",XB$(5)] : X=540 : Y=107 : L=10 : P=5 : Gosub B : N2#=Abs(Val(N$))
         D$=D$+XB$(6) : Rem *** BestellNr. 
         XP$(N)=D$

         Add XD,-Val(XB$(3))+N0
         XP#=XP#-Val(XB$(4))+N1#
         XA#=XA#-Val(XB$(5))+N2#

         N$=Str$(XD)-" " : _ST[567,118,String$(" ",7-Len(N$))+N$,0,0]
         N$=Str$(XP#)-" " : _ST[335,131,String$(" ",9-Len(N$))+N$,0,0]
         N$=Str$(XA#)-" " : _ST[551,131,String$(" ",9-Len(N$))+N$,0,0]

      End If 
   Loop 

   _FREIZEILE

   If XOK
      Open Out 1,XDAT$
      If XE : Pop Proc : End If 
      Trap Print #1,Space$(40)
      For I=0 To XPMAX
         Trap Print #1,XP$(I)+Chr$(10);
      Next 
      Close 1

      Add XTDISKETTEN,XD-XDISK
      XTPREIS#=XTPREIS#-XPREIS#+XP#
      XTANGEBOT#=XTANGEBOT#-XANGEBOT#+XA#

      Open Random 1,XDAT$
      Field 1,10 As XP$,10 As XD$,10 As XS$,10 As XA$
      If XE : Pop Proc : End If 
      XP$=Str$(XPROGRAMME)-" "
      XD$=Str$(XD)-" "
      XS$=Str$(XP#)-" "
      XA$=Str$(XA#)-" "
      Put 1,1
      Close 1

      _UPDATEDBINFO

   End If 

   _AUS[""]

   Pop Proc

B: If L=10 Then N#=Abs(Val(XEIN$)) : XEIN$=Str$(N#)-" "
   N$=XEIN$ : N$=Left$(N$,L) : D$=D$+N$+"|"

   If N$<>XB$(P) Then XOK=True

   If Y<107 Then N$=N$+String$(" ",L-Len(N$)) Else N$=String$(" ",L-Len(N$))+N$
   Ink 1,0 : Text X,Y,N$
   Return 

End Proc
'--------------------------------

'*** Optionen der Menüebene 3 ***
'--------------------------------
Procedure _DISKCOPY

   If Drive("DF1:")=False Then _AUS["Benötige das externe Laufwerk DF1: !"] : Pop Proc

   _EIN["Soll wirklich die Diskette von DF0: nach DF1: kopiert werden (J/N) ?:","J"]
   If Upper$(XEIN$)<>"J" Then _AUS[""] : Pop Proc

   Dev Open 0,"trackdisk.device",58,0,0
   Dev Open 1,"trackdisk.device",58,1,0

   Dev Do 0,14 : If Leek(Dev Base(0)+32)<>0 Then _AUS["Keine Disk in DF0: !"] : Goto A

   Dev Do 1,14 : If Leek(Dev Base(1)+32)<>0 Then _AUS["Keine Disk in DF1: !"] : Goto A
   Dev Do 1,15 : If Leek(Dev Base(1)+32)<>0 Then _AUS["Disk in DF1: ist schreibgeschützt !"] : Goto A

   Loke Dev Base(0)+44,0 : Dev Do 0,10
   Loke Dev Base(1)+44,0 : Dev Do 1,10

   Reserve As Chip Work 7,5632

   Loke Dev Base(0)+36,5632
   Loke Dev Base(0)+40,Start(7)

   Loke Dev Base(1)+36,5632
   Loke Dev Base(1)+40,Start(7)

   For I=0 To 159
      _AUS["Kopiere Track #"+Str$(I)-" "+"..."]
      Loke Dev Base(0)+44,I*5632 : Trap Dev Do 0,2
      Loke Dev Base(1)+44,I*5632 : Trap Dev Do 1,11
      If Asc(Inkey$)=27 Then Goto A
   Next 

A: Loke Dev Base(0)+36,0 : Trap Dev Do 0,9
   Loke Dev Base(0)+44,0 : Dev Do 0,10

   Loke Dev Base(1)+36,0 : Trap Dev Do 1,9
   Loke Dev Base(1)+44,0 : Dev Do 1,10

   Dev Close 
   Erase 7

   If I<>False Then _AUS[XOPT$(10)+" beendet... bitte die Disketten entfernen !"]

End Proc
Procedure _TASTATUR

   On Error Proc _ERROR

   Screen Open 1,640,160,8,Hires
   If XE Then Pop Proc
   Screen Hide 1
   Screen Display 1,,85,,149
   Flash Off 
   Curs Off 
   Cls 0
   Get Palette 0

   _G[0,0,638,148,0] : _G[7,3,632,145,1] : _G[8,4,631,144,0]

   _ST[256,15,"Tastaturbelegung",1,1]

   For I=0 To 7
      Read N$ : _ST[320-Len(N$)*4,40+I*11,N$,0,1]
   Next 

   Screen Show 1 : _WAIT : Screen Close 1

   Data "B.....Bestellen     S.....Stornieren     I.....Bestellinfo"
   Data "X....Komplette Bestellung stornieren     M....Musik an/aus"
   Data "W....Workbench auf/zu     E...Maskeneditor    G...Giftware"
   Data "1,2,3...Menueebene installieren     Esc...DiskBase beenden"
   Data "F1-F5.....Option aufrufen     Return......Datei schliessen"
   Data "Cursertasten...Pfeilschalter   Space...Stop    P...Drucker"
   Data "C...Codewort eingeben   R...Grundeinstellungen   D...Datum"
   Data "Help......Bestellnummer    AMIGA+A......DiskBase/Workbench"
End Proc
Procedure _VIRUSTEST
   For I=0 To 4
      Read N$,N
      _AUS["Teste... "+N$] : Wait 20
      N=Leek(N+Leek(4)) : If N Then Exit 
   Next 
   If N
      _AUS["Achtung... "+N$+" ist abnormal ("+Hex$(N,8)+") !"]
   Else 
      _AUS["Kein Virus im System entdeckt !"]
   End If 
   Data "ColdCapture",$2A
   Data "CoolCapture",$2E
   Data "WarmCapture",$32
   Data "KickMemPtr",$222
   Data "KickTagPtr",$226
End Proc
Procedure _SYSRESET
   _EIN["Soll das System wirklich gesäubert und neu gebootet werden (J/N) ?:","J"]
   If Upper$(XEIN$)<>"J" Then _AUS[""] : Pop Proc
   For I=1 To 88
      Read N
      N$=N$+Chr$(N)
   Next 
   Call Varptr(N$)
   Data 51,252,64,0,0,223,240,154,44,121,0,0,0,4,34,60,170,170
   Data 187,187,45,65,0,36,45,65,0,38,45,65,0,62,45,65,0,78
   Data 45,65,0,82,45,65,2,42,12,110,0,36,0,20,109,4,78,238
   Data 253,42,75,250,0,8,78,174,255,226,0,0,32,124,1,0,0,0
   Data 145,232,255,236,32,104,0,4,85,136,78,112,78,208,0,0
End Proc
Procedure _ENDE
   _EIN["DiskBase V1.0a wirklich beenden (J/N) ?:","J"]
   If Upper$(XEIN$)<>"J" Then _AUS[""] : Pop Proc
   N=Colour(0)
   Fade 3,N,N,N,N,N,N,N,N
   Hide 
   If XMUSIK
      For I=63 To 0 Step -1
         Mvolume I : Wait Vbl 
      Next 
      Music Off 
   End If 
   Request On 
   Erase 3
   Wait 100
   End 
End Proc
'--------------------------------

'*** Unterfunktionen (Tasten) ***
'--------------------------------
Procedure _BESTELLINFO

   On Error Proc _ERROR

   If XB$="" Then _AUS["Keine Bestelleinträge vorhanden !"] : Pop Proc

   Screen Open 1,640,160,8,Hires
   If XE Then Pop Proc
   Screen Hide 1
   Screen Display 1,,85,,149
   Flash Off 
   Curs Off 
   Cls 0
   Get Palette 0

   _G[0,0,638,148,0] : _G[7,3,632,145,1] : _G[8,4,631,144,0]
   _ST[35,10,"BstlNr:   Programmname:"+Space$(29)+"Disks:"+Space$(7)+"Preis:",1,1]
   _ST[35,19,String$("-",71),1,1]
   Screen Show 1

   A=Varptr(XB$) : L=A+Len(XB$)
   Repeat 
      F=Hunt(A To L,Chr$(10))
      If F Then _ST[35,Y*9+30,Peek$(A,71),0,1] : Inc Y : Inc XPA : A=F+1
      If Y=10
         _ST[35,120,String$("-",71),1,1]
         _ST[228,129,"Bitte Taste druecken...",1,1]
         _WAIT : Ink 0 : Bar 10,30 To 630,139 : Y=0
      End If 
   Until F=False
   _ST[35,Y*9+30,String$("-",71),1,1]
   N0$=Str$(XPA)-" " : N0$=N0$+String$(" ",10-Len(N0$))
   N1$=Str$(XDA)-" " : N1$=N1$+String$(" ",10-Len(N1$))
   N2$=Str$(XGP#)-" " : N2$=String$(" ",10-Len(N2$))+N2$
   _ST[35,Y*9+39,"Programmanzahl: "+N0$+"Diskanzahl: "+N1$+"Gesamtpreis: "+N2$,1,1]

   _WAIT

   Screen Close 1

End Proc
Procedure _GIFTWARE

   On Error Proc _ERROR

   Screen Open 1,640,160,8,Hires
   If XE Then Pop Proc
   Screen Hide 1
   Screen Display 1,,85,,149
   Flash Off 
   Curs Off 
   Cls 0
   Get Palette 0

   _G[0,0,638,148,0] : _G[7,3,632,145,1] : _G[8,4,631,144,0]

   For I=1 To 14
      Read N$,M,S
      _ST[320-((Len(N$)*8)/2),I*9+3,N$,M,S]
   Next I

   Screen Show 1 : _WAIT : Screen Close 1

   Data "DiskBase V1.0a wurde mit AMOSPro & APCmp von F. Lionet geschrieben !",0,1
   Data "AMOSPro und APCmp ist kopiergeschuetzt durch Europress Software Ltd.",0,1
   Data "",0,1
   Data "Giftwarebedingungen fuer den Benutzer von DiskBase !",1,1
   Data "Benutzer sollten mir als Anerkennung fuer dieses Programm, ein kleines",0,1
   Data "Geschenk zusenden. Was fuer ein Geschenk liegt bei dem Benutzer.",0,1
   Data "Zum Beispiel wuerde eine einfache Postkarte mit Gruessen ausreichen !",0,1
   Data "Also bitte schreibt oder sendet an:",0,1
   Data "",0,1
   Data "Testaware       ",0,1
   Data "Volker Stepprath",0,1
   Data "Tegeler Str. 7  ",0,1
   Data "40789 Monheim   ",0,1
   Data Space$(28)+"Deutschland"+Space$(23)+"...Danke !",0,1

End Proc
Procedure _MASKENEDITOR

   _CODE : If XE Then Pop Proc

   On Error Proc _ERROR

   _G[595,170,612,182,1]

   Do 
      _AUS["Textschalter selektieren für Änderung (Esc = Ende / S = Speichern ) !"]

      Repeat 
         N$=Inkey$
         N=Scancode

         Exit If Asc(N$)=27,2

         If N=33 : Rem *** - Savemask 
            Open Out 1,":Index/DiskBase.msk"
            If XE : Goto C : End If 
            For I=0 To 15
               Print #1,XMSK$(I)+Chr$(10);
               If XE : Goto C : End If 
            Next 
            For I=0 To 14
               Print #1,XOPT$(I)+Chr$(10);
               If XE : Goto C : End If 
            Next 
            For I=0 To 99
               Print #1,XGNR$(I)+Chr$(10);
               If XE : Goto C : End If 
               Exit If XGNR$(I)=""
            Next 
         C: Close 1
            If XE=False : _AUS["Makeneinstellungen wurden gespeichert !"] : End If 

         End If 

         If N
            _KEY[N] : X=XX : Y=XY
            If X<>0 and Y<>0 : Goto B : End If 
         End If 

         Multi Wait 
      Until Mouse Key<>0
      X=X Screen(X Mouse) : Y=Y Screen(Y Mouse)
B:
      If Y>170 and Y<183

         If X>533 and X<585 : Rem *** - 123
            Add X,-532 : XEBENE=X/17
         Else If X>7 and X<523 : Rem *** - Optionen 
            Add X,-7 : XOPTION=(X/103)+1 : 
            _G[8+(XOPTION-1)*103,170,7+XOPTION*103,182,1]
            _EIN["Enter new gadgetname:",XOPT$(XEBENE*5+XOPTION-1)]
            If XEIN$<>"" : XOPT$(XEBENE*5+XOPTION-1)=Left$(XEIN$,11) : End If 
         Else If X>612 and X<631 : Rem *** - M
            _MUSIK
         End If 
         _MENU

      Else 

         If X>196 and X<266 and Y>147 and Y<163

            For I=0 To 99 : If XGNR$(I)="" : Exit : End If : Next 

            If X>196 and X<222 : Rem *** - <
               _G[197,148,221,162,1]
               Add XGNR,-1,0 To I
               Ink 0 : Bar 188,38 To 628,53
               _BT[408-(Len(XGNR$(XGNR))*16)/2,39,XGNR$(XGNR),0]
               Wait 10 : _G[197,148,221,162,0]

            Else If X>240 and X<266 : Rem *** - >

               _G[241,148,265,162,1]
               Add XGNR,1,0 To I
               Ink 0 : Bar 188,38 To 628,53
               _BT[408-(Len(XGNR$(XGNR))*16)/2,39,XGNR$(XGNR),0]
               Wait 10 : _G[241,148,265,162,0]

            End If 

         Else 

            N=False
            Restore 
            Repeat 
               Inc N
               Read XA,YA,XB,YB
               If X>XA and X<XB and Y>YA and Y<YB : Gosub A : Exit : End If 
            Until XA<0

         End If 

      End If 

   Loop 

   _AUS["Maskeneditor beendet !"]

   _G[595,170,612,182,0]

   Clear Key 
   Pop Proc

A: _G[XA,YA,XB,YB,1]
   Dec N
   If N<16
      _EIN["Neue Schalterbezeichnung eingeben:",XMSK$(N)]
      If XEIN$<>"" : XMSK$(N)=XEIN$ : End If 
   End If 
   If N=16
      _EIN["Neue Schalterbezeichnung eingeben:",XGNR$(XGNR)]
      If XEIN$<>"" : XGNR$(XGNR)=Left$(XEIN$,25) : End If 
   End If 
   Ink 0 : Bar XA,YA To XB,YB
   _G[XA,YA,XB,YB,0]
   _MASK
   Return 

   Data 8,36,185,54
   Data 8,59,185,71
   Data 8,72,185,84
   Data 8,85,185,97
   Data 8,98,185,110
   Data 221,98,344,110
   Data 448,98,527,110

   Data 8,115,127,127
   Data 208,115,350,127
   Data 423,115,558,127
   Data 8,128,135,140
   Data 208,128,326,140
   Data 423,128,542,140

   Data 295,149,398,161
   Data 407,149,510,161
   Data 519,149,622,161

   Data 186,36,630,54

   Data -1,-1,-1,-1

End Proc
Procedure _MUSIK

   If Not Exist(":Index/Musik.abk") Then _AUS["AMOS Music Bank :Index/Musik.abk nicht verfügbar !"] : Pop Proc

   On Error Proc _ERROR

   Add XMUSIK,1,0 To 1

   If XMUSIK=1
      If Length(3)=False
         Load ":Index/Musik.abk",3
      End If 
      If XE=False : Music 1 : Led Off Else XMUSIK=False : End If 
   Else 
      Music Off 
   End If 

   _G[613,170,630,182,XMUSIK]

End Proc
'--------------------------------

Procedure _AUS[N$]
   Screen 0 : Ink 2 : Bar 10,188 To 628,195
   Ink 7,2 : Text 320-(Text Length(N$)/2),194,N$
End Proc
Procedure _BT[X,Y,T$,S]

   A$="ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789/-&"

   T$=Upper$(T$)

   L=Len(T$)

   For I=1 To L
      N$=Mid$(T$,I,1)
      N=Instr(A$,N$)
      If N Then Dec N : Screen Copy 0,N*16,229,N*16+15,243 To S,X+(I-1)*17,Y
   Next 

End Proc
Procedure _CODE

   If XCODE$="" Then Pop Proc

   _EIN["Bitte Codewort eingeben:",""]
   If XEIN$<>XCODE$
      _AUS["Schreibzugriff nur mit richtigem Codewort erlaubt !"]
      XE=True
   End If 

End Proc
Procedure _EIN[N$,A$]
   _AUS[""]
   XEIN$=A$
   Text 15,194,N$+" "+A$ : Ink ,7 : Text 23+Len(N$+A$)*8,194," "
   Repeat 
      Repeat : N=Asc(Inkey$) : Multi Wait : Until N
      If N>31 and N<123 and Len(XEIN$+N$)<73 Then XEIN$=XEIN$+Chr$(N)
      If N=8 and Len(XEIN$)>0 Then XEIN$=Left$(XEIN$,Len(XEIN$)-1)
      Ink ,2 : Text 23+Len(N$)*8,194,XEIN$+"  "
      Ink ,7 : Text 23+Len(N$+XEIN$)*8,194," "
   Until N=13
   Ink ,2 : Text 23+Len(N$)*8,194,XEIN$+" "
   N=Scancode
End Proc
Procedure _ERROR

   XE=Errn

   If XE=24
      N$="Nicht genügend Systemspeicher verfügbar !"
   Else If XE=84
      N$="Diskette ist schreibgeschützt !"
   Else If XE=86
      N$="Diskette nicht verfügbar !"
   Else If XE=88
      N$="Diskette ist voll !"
   Else If XE=93
      N$="Diskette nicht eingelegt !"
   Else If XE=94
      N$="I/O Fehler aufgetreten !"
   End If 

   If N$="" Then N$="AMOSPro Fehler #"+Str$(XE)-" "+" ist aufgetreten !"

   _AUS[N$]

   Resume Next 

End Proc
Procedure _FREIZEILE
   Ink 0
   Bar 194,62 To 626,70
   Bar 194,74 To 626,83
   Bar 194,87 To 626,95
   Bar 194,99 To 218,108
   Bar 350,99 To 444,108
   Bar 534,99 To 626,108

   Bar 132,118 To 196,126
   Bar 356,118 To 412,126
   Bar 562,118 To 628,126
   Bar 140,131 To 194,139
   Bar 330,131 To 412,139
   Bar 546,131 To 628,139
End Proc
Procedure _G[X,Y,XX,YY,S]
   If S=0 Then I=5 : I2=2 Else I=2 : I2=5

   Ink I : Draw X,Y To XX-2,Y : Draw X,Y To X,YY : Draw X+1,Y To X+1,YY-1
   Ink I2 : Draw X+2,YY To XX,YY : Draw XX-1,Y+1 To XX-1,YY : Draw XX,Y To XX,YY

   If S
      Ink 0 : Draw X+2,Y+1 To X+6,Y+1
   Else 
      Ink 3 : Draw X+2,Y+1 To X+4,Y+1 : Plot X+4,Y+1,5
   End If 

   Ink 1,0

End Proc
Procedure _INDEXCHECK
   If Not Exist(":Index")
      Trap Mkdir ":Index"
      If Errtrap
         Ink 0 : Bar 0,0 To 640,200
         A$="Kann das Verzeichnis "+Dir$+"Index/ nicht auffinden !"
         B$="Bitte Schreibschutz entfernen und nochmals DiskBase V1.0a starten..."
         _ST[320-Len(A$)*4,90,A$,2,0]
         _ST[320-Len(B$)*4,110,B$,2,0]
         Amos To Front 
         Wait 50 : Fade 3,,$0,$57,$FFF,$F00,$BD,$CAF,$FF0 : _WAIT
         Fade 3,,$8A,,,,,,$8A : Wait 100
         End 
      End If 
   End If 
End Proc
Procedure _INSTALLDB

   XGNR=0
   XEBENE=0
   XOPTION=1

   N$=":Index/DiskBase.dat"
   If Exist(N$)
      Trap Open In 1,N$
      Trap Input #1,XTPROGRAMME
      Trap Input #1,XTDISKETTEN
      Trap Input #1,XTPREIS#
      Trap Input #1,XTANGEBOT#
      Trap Line Input #1,XDATUM$
      Trap Line Input #1,XCODE$
      Trap Close 1
   End If 
   If XDATUM$="" Then XDATUM$="09.07.1994"

   N$=":Index/DiskBase.msk"
   If Exist(N$)
      Trap Open In 1,N$
      For I=0 To 15
         Trap Line Input #1,XMSK$(I)
         If Errtrap : Close 1 : Goto A : End If 
      Next 
      For I=0 To 14
         Trap Line Input #1,XOPT$(I)
         If Errtrap : Close 1 : Goto B : End If 
      Next 
      For I=0 To 99
         Trap Line Input #1,XGNR$(I)
         If Errtrap : Close 1 : Goto C : End If 
         Exit If XGNR$(I)=""
      Next 
      Close 1
   Else 
      A: Restore D : For I=0 To 15 : Read XMSK$(I) : Next 
      B: Restore G : For I=0 To 14 : Read XOPT$(I) : Next 
      C: Restore I : For I=0 To 99 : Read XGNR$(I) : Exit If XGNR$(I)="" : Next 
   End If 

   Restore H
   Read X,Y,M,N$ : _ST[X,Y,N$,M,0]
   Read X,Y,M,N$ : _ST[X,Y,N$,M,0]

   _MASK

D: Data "Genre","Programm","Hersteller/Vertrieb","Information"
   Data "Diskettenanzahl","Einkaufspreis","Angebot","Bestellnummer"
   Data "Laufnummer","Diskettenanzahl","Programmanzahl","Gesamtpreis"
   Data "Gesamtangebot","Bestellen","Stornieren","Bestellinfo"

G: Data "ANZEIGEN","SUCHEN","SORTIEREN","AUSDRUCKEN","INFORMATION"
   Data "EINTRAGEN","AUSTRAGEN","UEBERTRAGEN","LOESCHEN","EDITOR"
   Data "DISKCOPY","TASTATUR","VIRUSTEST","SYS RESET","ENDE"

H: Data 14,7,0,"® by Volker Stepprath"
   Data 14,17,0,"© 1994  by  Testaware"

I: Data "ACTION","GESCHIKLICHKEIT","STRATEGIE & HANDEL","ADVENTURE","SPORT"
   Data "SIMULATION","GRAFIK & VIDEO","MUSIK","DATENVERWALTUNG","ANWENDER"
   Data "PUBLIC DOMAIN","DIVERSES",""

End Proc
Procedure _KEY[N]
   
   XX=False : XY=False

   '_AUS[Str$(N)] : Rem - Ausgabe des Scancodes         
   
   If N>0 and N<4 : XX=534+(N-1)*17 : XY=171 : Rem - 123

   Else If N=17 : Rem - W
      If XWB=False
         XWB=Intcall(-78)
         If XWB=False
            _AUS["Workbench nicht zu schließen, evtl. CLI bzw. Shell Task aktiv !?"]
         Else 
            _AUS["Workbench geschlossen !"] : XWB=True
         End If 
      Else 
         XWB=Intcall(-210)
         If XWB=False
            _AUS["Workbench aus Speichermangel nicht zu öffnen !"]
         Else 
            _AUS["Workbench geöffnet !"] : XWB=False
         End If 
      End If 
      _SYSDISKFREE

   Else If N=18 : XX=595 : XY=171 : Rem - E

   Else If N=19 : Rem - R
      If XMUSIK=1 : _MUSIK : End If 
      Erase 3
      _INSTALLDB
      _AUS["Grundeinstellung installiert !"]

   Else If N=23 : XX=519 : XY=148 : Rem - I

   Else If N=25 : Rem - P
      _EIN["Diskette in DF0: einlegen zum Installieren des Prefs-Druckertreiber:",""]
      If Exist("DF0:Devs/System-Configuration")
         On Error Proc _ERROR
         Reserve As Work 7,232
         Bload "DF0:Devs/System-Configuration",Start(7)
         If XE : Erase 7 : Pop Proc : End If 
         P$=Peek$(Start(7)+128,30,Chr$(0))
         N$="DF0:Devs/printers/"+P$
         If Exist(N$)
            Open In 2,N$
            N=Lof(2)
            Reserve As Work 7,N
            Sload 2 To Start(7),N
            Close 2
            If XE : Erase 7 : Pop Proc : End If 
            _EIN["DiskBase Diskette in DF0: einlegen (Schreibschutz entfernen):",""]
            Bsave N$,Start(7) To Start(7)+N
            If XE : Erase 7 : Pop Proc : End If 
            N=Start(7)
            Bload "DF0:Devs/System-Configuration",N
            If XE : Erase 7 : Pop Proc : End If 
            Poke$ N+128,P$+Chr$(0)
            Bsave "DF0:Devs/System-Configuration",N To N+232
            If XE=False
               Areg(0)=N
               Dreg(0)=232
               _LVOGETPREFS=Intcall(-132)
               N=_LVOGETPREFS
               N$=Peek$(N+128,30,Chr$(0))
               Poke$ N+128,P$+Chr$(0)
               Areg(0)=N
               Dreg(0)=232
               Dreg(1)=True
               _LVOSETPREFS=Intcall(-324)
               _AUS["Alter Druckertreiber "+N$+" durch "+P$+" ersetzt !"]
            End If 
         Else 
            _AUS[N$+" nicht verfügbar !"]
         End If 
      Else 
         _AUS["DF0:Devs/System-Configuration nicht verfügbar !"]
      End If 

   Else If N=33 : XX=407 : XY=148 : Rem - S

   Else If N=34 : Rem - D
      _CODE : If XE : Pop Proc : End If 
      _EIN["Bitte aktuelles Datum setzen:",XDATUM$]
      If Len(XEIN$)=10
         If XDATUM$<>XEIN$
            XDATUM$=XEIN$
            _UPDATEDBINFO
         End If 
         _AUS[""]
      Else 
         _AUS["Bitte folgende Schreibweise benutzen: TT.MM.JJJJ !"]
      End If 

   Else If N=36 : Rem - G
      _GIFTWARE

   Else If N=50 : Rem - X
      _EIN["Wirklich den kompletten Bestellauftrag stornieren (J/N) ?:","J"]
      _AUS[""]
      If Upper$(XEIN$)="J"
         XB$="" : XDA=0 : XGP#=0 : _AUS["Kompletter Bestellauftrag storniert !"]
      End If 

   Else If N=51 : Rem - C
      If XCODE$=""
         _EIN["Bitte neues Codewort eingeben:",""] : _AUS[""]
      Else 
         _EIN["Bitte aktuelles Codewort für Test eingeben:",""]
         If XEIN$=XCODE$
            _EIN["Bitte neues Codewort eingeben:",XCODE$]
         Else 
            XEIN$=XCODE$ : _AUS["Falsches Codewort !"]
         End If 
      End If 
      If XEIN$<>XCODE$ : XCODE$=XEIN$ : _UPDATEDBINFO : End If 

   Else If N=53 : XX=295 : XY=148 : Rem - B

   Else If N=55 : XX=613 : XY=171 : Rem - M

   Else If N=64 : XX=109 : XY=148 : Rem - Space/Stop 

   Else If N=68 : XX=13 : XY=148 : Rem - Return/Close 

   Else If N=69 : Edit : Rem - Esc/Ende 

   Else If N=76 : XX=65 : XY=148 : Rem <<-

   Else If N=77 : XX=153 : XY=148 : Rem ->>

   Else If N=78 : XX=241 : XY=148 : Rem <- 

   Else If N=79 : XX=197 : XY=148 : Rem -> 

   Else If N>79 and N<85 : Add N,-80 : XX=N*103+8 : XY=171 : Rem - F1..F5 

   Else If Scanshift=2 and N=93 : _AUS["Das Codewort heißt: "+XCODE$] : Rem - *

   End If 

   If XX+XY<>False Then X Mouse=X Hard(XX+8) : Y Mouse=Y Hard(XY+3)

   Ink 1,0
   Clear Key 
   N=Scancode

End Proc
Procedure _MASK

   Ink 0 : Bar 192,39 To 626,53
   N$=Left$(XGNR$(XGNR),25) : _BT[396-(Len(N$)*16)/2,39,N$,0]

   Restore F
   For I=0 To 15
      Read X,Y,M,L : N$=Left$(XMSK$(I),L) : _ST[X-(Len(N$)*8)/2,Y,N$,M,0]
   Next 

   _MENU
   _SYSDISKFREE

F: Data 97,42,0,20,97,62,0,20,97,75,0,20,97,88,0,20
   Data 97,101,0,20,283,101,0,14,488,101,0,8,68,118,1,13
   Data 280,118,1,16,492,118,1,15,73,131,1,14,268,131,1,13
   Data 484,131,1,13,347,152,2,11,459,152,2,11,571,152,2,11

End Proc
Procedure _MENU

   For I=0 To 2 : _G[532+I*18,170,549+I*18,182,0] : Next 
   _G[532+XEBENE*18,170,549+XEBENE*18,182,1]

   For I=0 To 4
      Ink 0 : Bar I*104+12,172 To I*104+104,181
      _G[8+I*103,170,7+(I+1)*103,182,0]
      N$=XOPT$(XEBENE*5+I)
      _ST[I*103+60-((Len(N$)*8)/2),173,N$,0,0]
   Next 

End Proc
Procedure _SCHALTER[X]
   
   XSCHALTER=False
   
   If X>12 and X<37 Then N=13 : XSCHALTER=1 : Rem - Return 
   If X>64 and X<89 Then N=65 : XSCHALTER=2 : Rem - << 
   If X>108 and X<133 Then N=109 : XSCHALTER=3 : Rem - *    
   If X>152 and X<177 Then N=153 : XSCHALTER=4 : Rem - >> 
   If X>196 and X<222 Then N=197 : XSCHALTER=5 : Rem - <
   If X>240 and X<266 Then N=241 : XSCHALTER=6 : Rem - >  
   
   If N Then _G[N,148,N+24,162,1] : Wait 10 : _G[N,148,N+24,162,0]
   
End Proc
Procedure _ST[X,Y,T$,M,S]

   A$="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789.!?:,-+*#&%$©®/= "

   L=Len(T$)

   For I=1 To L
      N$=Mid$(T$,I,1)
      N=Instr(A$,N$)
      If N Then Dec N : Screen Copy 0,N*8,202+M*9,N*8+8,211+M*9 To S,X+(I-1)*8,Y
   Next 

End Proc
Procedure _SYSDISKFREE

   If Exist(":")=False Then Pop Proc

   N=Dfree
   _ST[460,7,"Disk Free: "+String$("0",9-Len(Str$(N)-" "))+Str$(N)-" ",0,0]

   N=Chip Free+Fast Free
   _ST[460,17,"Avail Mem: "+String$("0",9-Len(Str$(N)-" "))+Str$(N)-" ",0,0]

End Proc
Procedure _UPDATEDBINFO

   On Error Proc _ERROR
   
   Open Out 1,":Index/DiskBase.dat"
   If XE Then Pop Proc
   Trap Print #1,Abs(XTPROGRAMME);Chr$(10);
   Trap Print #1,Abs(XTDISKETTEN);Chr$(10);
   Trap Print #1,Abs(XTPREIS#);Chr$(10);
   Trap Print #1,Abs(XTANGEBOT#);Chr$(10);
   Trap Print #1,XDATUM$+Chr$(10);
   Trap Print #1,XCODE$+Chr$(10);
   Trap Close 1
   
End Proc
Procedure _WAIT
   Wait 50
   Clear Key 
   Do 
      Exit If Asc(Inkey$)
      Exit If Mouse Key
      Multi Wait 
   Loop 
End Proc
Procedure _ZEIGE[N$,P$]

   XB$(0)=Left$(N$,Instr(N$,"|")-1) : N=Len(XB$(0))+1 : N$=Right$(N$,Len(N$)-N)
   XB$(1)=Left$(N$,Instr(N$,"|")-1) : N=Len(XB$(1))+1 : N$=Right$(N$,Len(N$)-N)
   XB$(2)=Left$(N$,Instr(N$,"|")-1) : N=Len(XB$(2))+1 : N$=Right$(N$,Len(N$)-N)
   XB$(3)=Left$(N$,Instr(N$,"|")-1) : N=Len(XB$(3))+1 : N$=Right$(N$,Len(N$)-N)
   XB$(4)=Left$(N$,Instr(N$,"|")-1) : N=Len(XB$(4))+1 : N$=Right$(N$,Len(N$)-N)
   XB$(5)=Left$(N$,Instr(N$,"|")-1) : N=Len(XB$(5))+1 : N$=Right$(N$,Len(N$)-N)
   XB$(6)=N$

   Text 195,68,XB$(0)+String$(" ",53-Len(XB$(0)))
   Text 195,81,XB$(1)+String$(" ",53-Len(XB$(1)))
   Text 195,94,XB$(2)+String$(" ",53-Len(XB$(2)))
   Text 195,107,String$(" ",2-Len(XB$(3)))+XB$(3)
   Text 356,107,String$(" ",10-Len(XB$(4)))+XB$(4)
   Text 540,107,String$(" ",10-Len(XB$(5)))+XB$(5)

   Text 135,124,String$(" ",7-Len(XB$(6)))+XB$(6)
   Text 358,124,String$(" ",6-Len(P$))+P$

End Proc