' **********************************************************************
'
'                      AUTHORIZE Version 3.5
'
'              added features: lock terminal option
'                              individual datebook
'
'
'              programmed by Stony in November 1990
'                  this program is Public Domain
'
'                          GfA-Basic 3.5
'
' the program handles the authorized users of the system, and enables an
' already logged-in user to change his own password or enter dates which
' show up during the boot-process. The superuser, usually the owner of
' the system, may delete or add users (max.10) to the authorization-list
'
' **********************************************************************
'
' Decide wheater the program is run as accessory or as normal program:
'
$m64000                                     !use this also as compiler...
'                                           !...memory option!!!
GRAPHMODE 1
drive$=CHR$(GEMDOS(25)+65)+":"              !calculate active Drive
'
ap_id&=APPL_INIT()
IF ap_id&=0                                 !run as normal program
  @main
  RESERVE
  END
ENDIF
me_id&=MENU_REGISTER(ap_id&,"  Authorize ")
DO                                          !run as accessory
  ~EVNT_MESAG(0)
  IF MENU(1)=40
    @main
    CLEAR
  ENDIF
LOOP
'
' **********************************************************************
'
> PROCEDURE main
  '
  LOCAL j%
  '
  @data_init
  IF EXIST(params_f$)                      !is there a PARAMS on media?
    DEFMOUSE 2                             !Mousecursor as Bee
    OPEN "I",#1,super_f$                   !open superuser datas
    INPUT #1,code_key%                     !read the keynumber for coding
    '
    j%=1
    REPEAT
      INPUT #1,super$(j%)                  !read the superuser datas
      INC j%
    UNTIL j%>3
    '
    CLOSE #1
    DEFMOUSE 0                             !Mousecursor as Arrow
    number%=1                              !only one user (superuser) yet
    '
    j%=1
    REPEAT
      code$(1,j%)=super$(j%)               !prepare for decoding
      INC j%
    UNTIL j%>3
    '
    @decode                                !decode the superuser datas
    '
    j%=1
    REPEAT
      super$(j%)=user$(1,j%)               !uncoded superuser datas
      INC j%
    UNTIL j%>3
    '
    @load                                  !load dates out of PARAMS...
    @decode                                !...and decode them
    '
    IF user$(z%,1)=super$(1) AND user$(z%,3)=super$(3)
      super!=TRUE
    ENDIF
    '
  ELSE
    @message                               !message to inform about superuser
    @build_super                           !no PARAMS: first user=superuser
    IF maske$(1)="" OR maske$(2)="" OR maske$(3)=""
      GOTO main_end
    ENDIF
  ENDIF
  '
  @build_menu                              !show initial menu screen...
  '
main_end:
RETURN
'
' **********************************************************************
'
> PROCEDURE eingabe(start%,end%)
  '
  LOCAL ret%,n%
  n%=start%
  '
  REPEAT
    GOSUB mask_input(*string$,maske_et$(n%),maske_ex%(n%),maske_y%(n%),maske_l%(n%))
    maske$(n%)=string$
    maske_et$(n%)=string$
    '
    IF ret%=1 OR ret%=2 OR ret%=3    !EOL, RETURN or Downarrow
      INC n%                         !next line
    ELSE
      '
      IF ret%=5                      !Clr/Home selected
        n%=start%                    !to first line
      ELSE
        '
        IF ret%=4                    !Uparrow
          DEC n%                     !to the line before
          IF n%<start%               !if first line...
            n%=start%                !...then stay there
          ENDIF
        ELSE
          '
        ENDIF
        '
      ENDIF
      '
    ENDIF
  UNTIL n%=end%+1                    !until last line is done
  '
RETURN
'
' **********************************************************************
'
> PROCEDURE mask_input(ptr%,x$,sp%,ze%,laenge%)
  '
  LOCAL y%,t%
  DEFTEXT 1,0,0,6                    !small text
  '
mask_start:
  IF ret%=5                          !Clr/Home
    y%=1
  ELSE
    y%=LEN(x$)+1                     !Cursorposition depends on default
  ENDIF
  ret%=0
  IF y%>laenge%                      !if max. number of characters reached
    y%=laenge%
  ENDIF
  TEXT sp%,ze%,x$+" "                !show default
  SPRITE cur$,(sp%+y%*8)-2,ze%       !show cursor
  '
  DO                                 !loop for Char-input
    IF ret%=6                        !Escape ==> delete line, beginning of line
      x$=""                          !delete former string
      SPRITE cur$                    !switch off cursor
      TEXT sp%,ze%,SPACE$(laenge%)   !delete old text
      GOTO mask_start                !new input
    ELSE
      t%=INP(2)                      !get Char from keyboard
    ENDIF
    '
    IF t%>=187                       !Insert, Clr/Home and arrowkeys
      GOSUB no_ascii_taste(t%)
    ELSE
      '
      IF t%=225 OR t%=226 OR t%=27 OR t%=8 OR t%=127 OR t%=13 OR t%=9
        GOSUB no_character(t%)
      ELSE
        '
        IF insert!=TRUE AND y%<laenge% AND LEN(x$)<laenge%
          x$=LEFT$(x$,y%-1)+CHR$(t%)+MID$(x$,y%)
        ELSE
          x$=LEFT$(x$,y%-1)+CHR$(t%)+MID$(x$,y%+1)
        ENDIF
        '
        INC y%                       !Cursor one position ahead
        '
        IF y%=laenge%+1 AND ret%<6   !EOL reached
          ret%=1
          SOUND 1,15,#284            !Warningtone
          WAVE 1,1,1,15535,0
        ENDIF
        '
      ENDIF
      '
    ENDIF
    '
    SPRITE cur$                      !activate Cursor
    TEXT sp%,ze%,x$+" "              !show default
    SPRITE cur$,(sp%+y%*8)-2,ze%     !show cursor at last character
    *ptr%=x$                         !assign pointer for last string
    EXIT IF ret%>0 AND ret%<6        !ESC not selected
    '
  LOOP
  '
RETURN
'
' **********************************************************************
'
> PROCEDURE no_character(taste%)
  '
  LOCAL z%
  IF taste%=8 AND y%>1                !Backspace
    DEC y%
    x$=LEFT$(x$,y%-1)+MID$(x$,y%+1)
  ENDIF
  IF taste%=13                        !Return
    ret%=2
  ENDIF
  IF taste%=127 AND y%>0              !Delete
    x$=LEFT$(x$,y%-1)+MID$(x$,y%+1)
  ENDIF
  IF taste%=27                        !Escape
    ret%=6
    y%=1
  ENDIF
  IF taste%=9                         !Tab
    z%=INSTR(y%,x$," ")
    y%=z%+1
  ENDIF
RETURN
'
' **********************************************************************
'
> PROCEDURE no_ascii_taste(scan%)
  '
  IF scan%=210                        !Insert
    IF insert!=FALSE
      insert!=TRUE
    ELSE
      insert!=FALSE
    ENDIF
  ENDIF
  IF scan%=199                        !Clr/Home
    ret%=5
  ENDIF
  IF scan%=203 AND y%>1               !Leftarrow
    DEC y%
  ENDIF
  IF scan%=205 AND y%<laenge% AND y%<LEN(x$)  !Rightarrow
    INC y%
  ENDIF
  IF scan%=208                        !Downarrow
    ret%=3
  ENDIF
  IF scan%=200                        !Uparrow
    ret%=4
  ENDIF
  IF scan%=226                        !Help
    ' not used
  ENDIF
  IF scan%=225                        !Undo
    ' not used
  ENDIF
RETURN
'
' **********************************************************************
'
> PROCEDURE boxup(b%,h%,n%,v!,bild%)
  '
  LOCAL b$,x1%,x2%,y1%,y2%,i%
  '
  SPRITE cur$
  DEFFILL 1,0
  IF b%>=640                           ! > screenwidth
    b%=638
  ENDIF
  IF h%>=420                           ! > screenhight
    h%=418
  ENDIF
  '
  x1%=INT((640-b%)/2)
  x2%=INT((640+b%)/2)
  y1%=INT((420-h%)/2)
  y2%=INT((420+h%)/2)
  '
  IF v!=TRUE                            ! Growbox
    i%=1
    REPEAT
      GET INT(x1%*i%/n%),INT(y1%*i%/n%),INT(x2%*i%/n%),INT(y2%*i%/n%),b$
      BOX INT(x1%*i%/n%),INT(y1%*i%/n%),INT(x2%*i%/n%),INT(y2%*i%/n%)
      PAUSE 1
      PUT INT(x1%*i%/n%),INT(y1%*i%/n%),b$
      INC i%
    UNTIL i%>n%
  ENDIF
  '
  GET x1%,y1%,x2%,y2%,b$
  PBOX x1%,y1%,x2%,y2%
  PBOX x1%+2,y1%+2,x2%-2,y2%-2
  '
  *bild%=b$                            ! Pointer to saved part of screen
  '
RETURN
'
' **********************************************************************
'
> PROCEDURE boxdown(b%,h%,n%,v!,b$)
  '
  LOCAL x1%,x2%,y1%,y2%,i%
  '
  SPRITE cur$
  DEFFILL 1,0
  IF b%>=640                            ! > screenwidth
    b%=638
  ENDIF
  IF h%>=420                            ! > screenhight
    h%=418
  ENDIF
  '
  x1%=INT((640-b%)/2)
  x2%=INT((640+b%)/2)
  y1%=INT((420-h%)/2)
  y2%=INT((420+h%)/2)
  PUT x1%,y1%,b$
  '
  IF v!=TRUE                            ! Shrinkbox
    i%=n%-1
    REPEAT
      GET INT(x1%*i%/n%),INT(y1%*i%/n%),INT(x2%*i%/n%),INT(y2%*i%/n%),b$
      BOX INT(x1%*i%/n%),INT(y1%*i%/n%),INT(x2%*i%/n%),INT(y2%*i%/n%)
      PAUSE 1
      PUT INT(x1%*i%/n%),INT(y1%*i%/n%),b$
      DEC i%
    UNTIL i%<1
  ENDIF
  '
RETURN
'
' **********************************************************************
'
> PROCEDURE button(z%,s!)
  '
  LOCAL h%,b%,n%,lenght%,links%,x%,y%,t$
  '
  x%=button_x%(z%)                      ! Button X-Coordinate
  y%=button_y%(z%)                      ! Button Y-Coordinate
  t$=button_t$(z%)                      ! Button Text
  h%=20                                 ! Hight of Button in Pixel
  b%=60                                 ! Width of Button in Pixel
  n%=2                                  ! Distance to Border in Pixel
  '
  IF LEN(t$)>8                          ! if more than 8 characters...
    t$=LEFT$(t$,8)                      ! ...shorten to 8
  ENDIF
  '
  IF s!=FALSE
    ' Button not selected, use normal display
    GRAPHMODE 1                         ! Replace
    DEFFILL 0,1                         ! white, filled
  ELSE
    ' Button was selected, use inverted display
    GRAPHMODE 2                         ! Transparent
    DEFFILL 1,1                         ! black, filled
  ENDIF
  '
  BOX x%,y%,x%+b%,y%+h%                 ! outer border of button
  PBOX x%+n%,y%+n%,x%+b%-n%,y%+h%-n%    ! content of button
  BOX x%+n%,y%+n%,x%+b%-n%,y%+h%-n%     ! inner border of button
  '
  GRAPHMODE 3                           ! XOR for text
  DEFTEXT ,1,,4                         ! normal text mode
  lenght%=LEN(t$)                       ! get lenght of text
  lenght%=lenght%*6                     ! calculate in pixels
  links%=(b%-lenght%)/2                 ! distance from left
  TEXT x%+links%,y%+12,t$               ! write text
  '
  GRAPHMODE 1                           ! normal replace mode
  '
RETURN
'
' **********************************************************************
'
> PROCEDURE encode
  '
  ' Encodes the personal datas (name, chr. name, password) of all
  ' registered users
  '
  ' Variables: I% = Counter for the amount of users registered
  '            J% = Counter for the three variables assigned to
  '                 each user (name, chr.name, password)
  '            A$ = string variable which contains coded
  '                 name, chr.name and password
  '            Z% = Counter for the lenght of the personal datas
  '            A% = coded ASCII (character out of the personal datas)
  '            Chance1, Chance2 = buffer variable for coding
  '            Number% = number of registered users
  '            User$   = uncoded userdatas
  '            Code$   = coded userdatas
  '            Code_key% = certain number which is the base of coding
  '
  LOCAL i%,j%,z%,a%,a$,chance1,chance2
  DIM a$(number%,3)
  i%=1
  REPEAT
    j%=1
    REPEAT
      a$(i%,j%)=""
      z%=1
      REPEAT
        chance1=1+z%*code_key%/157
        chance2=INT(0.456*z%*11.23+FRAC(chance1)*10000/157)
        a%=ASC(MID$(user$(i%,j%),z%,1))+chance2
        IF a%>159
          a%=a%-94
        ENDIF
        a$(i%,j%)=a$(i%,j%)+CHR$(a%)
        INC z%
      UNTIL z%>LEN(user$(i%,j%))
      code$(i%,j%)=a$(i%,j%)
      INC j%
    UNTIL j%>3
    INC i%
  UNTIL i%>number%
  ERASE a$()
RETURN
'
' **********************************************************************
'
> PROCEDURE decode
  '
  ' Decodes the personal datas (name, chr. name, password) of all
  ' registered users
  '
  ' Variables: I% = Counter for the amount of users registered
  '            J% = Counter for the three variables assigned to
  '                 each user (name, chr.name, password)
  '            A$ = string variable which contains coded
  '                 name, chr.name and password
  '            Z% = Counter for the lenght of the personal datas
  '            A% = coded ASCII (character out of the personal datas)
  '            Chance1, Chance2 = buffer variable for coding
  '            Number% = number of registered users
  '            User$   = uncoded userdatas
  '            Code$   = coded userdatas
  '            Code_key% = basenumber for coding
  '
  LOCAL i%,j%,z%,a%,a$,chance1,chance2
  DIM a$(number%,3)
  i%=1
  REPEAT
    j%=1
    REPEAT
      a$(i%,j%)=""
      z%=1
      REPEAT
        chance1=1+z%*code_key%/157
        chance2=INT(0.456*z%*11.23+FRAC(chance1)*10000/157)
        a%=ASC(MID$(code$(i%,j%),z%))-chance2
        IF a%<32
          a%=a%+94
        ENDIF
        a$(i%,j%)=a$(i%,j%)+CHR$(a%)
        INC z%
      UNTIL z%>LEN(code$(i%,j%))
      user$(i%,j%)=a$(i%,j%)
      INC j%
    UNTIL j%>3
    INC i%
  UNTIL i%>number%
  ERASE a$()
RETURN
'
' **********************************************************************
'
> PROCEDURE write
  '
  ' Writes the modified PARAMS-file onto currently active drive
  ' and places it into the AUTO-folder of that disk. AUTO-folder
  ' must be on the disk!
  '
  ' Variables: Success$ = Message who last successfully logged in
  '                       and at what time
  '            Reject$  = String containing the messages who tried
  '                       to log in without permission and at what
  '                       time
  '            Number%  = Amount of registered users
  '            Code_key%= Basenumber of coding
  '            I%, J%   = Counters
  '
  LOCAL i%,j%
  DEFMOUSE 2
  OPEN "O",#1,params_f$
  WRITE #1,code_key%,number%,success$,reject$
  WRITE #1,z%
  i%=1
  REPEAT
    j%=1
    REPEAT
      WRITE #1,code$(i%,j%)
      INC j%
    UNTIL j%>3
    INC i%
  UNTIL i%>number%
  CLOSE #1
  DEFMOUSE 0
RETURN
'
' **********************************************************************
'
> PROCEDURE load
  '
  ' Loads the modified PARAMS-file from currently active drive
  '
  ' Variables: Success$ = Message who last successfully logged in
  '                       and at what time
  '            Reject$  = String containing the messages who tried
  '                       to log in without permission and at what
  '                       time
  '            Number%  = Amount of registered users
  '            Code_key%= Basenumber of coding
  '            I%, J%   = Counters
  '
  LOCAL i%,j%
  DEFMOUSE 2
  OPEN "I",#1,params_f$
  INPUT #1,code_key%,number%,success$,reject$
  INPUT #1,z%
  i%=1
  REPEAT
    j%=1
    REPEAT
      INPUT #1,code$(i%,j%)
      INC j%
    UNTIL j%>3
    INC i%
  UNTIL i%>number%
  CLOSE #1
  DEFMOUSE 0
RETURN
'
' **********************************************************************
'
> PROCEDURE del_user
  '
  LOCAL x%,y%,k%,i%,j%,dummy%,n%,f_name$,u_name$
  '
  screen$=""
  @boxup(350,200,15,FALSE,*screen$)
  DEFTEXT ,1,,6
  TEXT 155,130,"To delete a user from the PARAMS datafile:"
  DEFTEXT 1,0,0,6
  i%=1
  '
  REPEAT
    TEXT maske_x%(i%),maske_y%(i%),maske_t$(i%)
    maske_et$(i%)=""
    INC i%
  UNTIL i%>2
  '
  @button(1,FALSE)
  HIDEM
  @eingabe(1,2)
  SHOWM
  u_name$=UPPER$(maske$(1))
  f_name$=UPPER$(maske$(2))
  '
  DO
    MOUSE x%,y%,k%
    KEYTEST n%
    EXIT IF n%<>0 OR (k%=1 AND x%>290 AND x%<350 AND y%>280 AND y%<300)
  LOOP
  '
  IF u_name$=super$(1) AND f_name$=super$(3)
    ALERT 1,"|You can't delete yourself",1,"  OK  ",dummy%
  ELSE
    FOR i%=1 TO number%
      IF u_name$=user$(i%,1) AND f_name$=user$(i%,3)
        FOR j%=i% TO number%-1
          FOR k%=1 TO 3
            user$(i%,k%)=user$(j%+1,k%)
          NEXT k%
        NEXT j%
        DEC number%
      ENDIF
    NEXT i%
  ENDIF
  @button(1,TRUE)
  PAUSE 10
  @boxdown(350,200,15,FALSE,screen$)
  '
RETURN
'
' **********************************************************************
'
> PROCEDURE message
  '
  ' the program was never run before, so the owner of the system registers
  ' as the superuser. To inform him about that this message is displayed.
  '
  LOCAL x%,y%,k%,n%
  screen$=""
  @boxup(300,200,15,FALSE,*screen$)                 !Build up screen
  '
  DEFTEXT ,1,,13
  TEXT 288,130,"WARNING!"
  DEFTEXT 1,0,0,6
  TEXT 195,150,"You are the first user of this"
  TEXT 195,165,"system and therefor considered"
  TEXT 195,180,"  as the owner and superuser! "
  TEXT 195,205,"Your Username, First Name and "
  TEXT 195,220,"Password will be stored to re-"
  TEXT 195,235,"coqnize that you are the only "
  TEXT 195,250,"one permitted to change PARAMS"
  TEXT 195,265,"for adding and deleting users."
  @button(1,FALSE)
  DO
    MOUSE x%,y%,k%
    KEYTEST n%
    EXIT IF n%<>0 OR (k%=1 AND x%>290 AND x%<350 AND y%>280 AND y%<300)
  LOOP
  @button(1,TRUE)
  PAUSE 10
  @boxdown(300,200,15,FALSE,screen$)
RETURN
'
' **********************************************************************
'
> PROCEDURE data_init
  '
  LOCAL i%,res%,dummy%
  '
  ' get screen resolution
  ' res%=0: low  resolution (320*200 pixel)
  ' res%=1: mid  resolution (640*200 pixel)
  ' res%=2: high resolution (640*400 pixel)
  ' res%=3: reserved
  '
  res%=XBIOS(4)                        !actual screen resolution
  IF res%<>2                           !No Go for color modes
    ALERT 1,"|This Program is for a|monochrom monitor only",1," Quit ",dummy%
    END
  ENDIF
  '
  ' Spritedefinitions for cursor:
  '
  cur$=MKI$(15)+MKI$(12)+MKI$(1)+MKI$(0)+MKI$(1)+MKI$(0)+MKI$(0)+MKI$(0)+MKI$(0)+MKI$(0)
  cur$=cur$+MKI$(0)+MKI$(0)+MKI$(0)+MKI$(0)+MKI$(0)+MKI$(0)+MKI$(0)+MKI$(0)+MKI$(0)+MKI$(0)+MKI$(0)
  cur$=cur$+MKI$(0)+MKI$(0)+MKI$(0)+MKI$(0)+MKI$(0)+MKI$(0)+MKI$(0)+MKI$(0)+MKI$(0)+MKI$(0)+MKI$(0)+MKI$(0)+MKI$(0)+MKI$(0)+MKI$(0)+MKI$(63)
  '
  ' Button dates:
  '
  RESTORE buttons
  DIM button_x%(11),button_y%(11),button_t$(11)
  '
  i%=1
  REPEAT
    READ button_t$(i%)
    READ button_x%(i%)
    READ button_y%(i%)
    INC i%
  UNTIL i%>11
  '
buttons:
  ' Text, X-Position, Y-Position
  '
  DATA OK,290,280
  DATA Sho User,200,150
  DATA Del User,200,190
  DATA Add User,200,230
  DATA Change P,200,270
  DATA Datebook,380,150
  DATA Logfile,380,190
  DATA Del Log,380,230
  DATA Quit,380,270
  DATA Cancel,446,170
  DATA Correct,533,170
  '
  ' Mask dates:
  '
  RESTORE eingabemaske
  DIM maske$(9),maske_t$(9),maske_et$(9),maske_x%(9),maske_ex%(9),maske_y%(9),maske_l%(9)
  '
  i%=1
  REPEAT
    READ maske_t$(i%)
    READ maske_et$(i%)
    READ maske_x%(i%)
    READ maske_ex%(i%)
    READ maske_y%(i%)
    READ maske_l%(i%)
    INC i%
  UNTIL i%>9
  '
eingabemaske:
  ' Text, Default, X-Position, X-Position Input, Y-Position, max. lenght of input string
  '
  ' Window dates:
  DATA Username     :,"",155,285,190,20
  DATA First Name   :,"",155,285,210,20
  DATA Password     :,"",155,285,230,20
  DATA Date :,"",153,207,227,2
  DATA "-","",234,249,227,3
  DATA "-","",281,301,227,4
  DATA Text :,"",153,207,245,34
  DATA Old Password :,"",155,285,210,20
  DATA New Password :,"",155,285,230,20
  '
  super_f$=drive$+"\AUTO\SUPER"            !location of superuser-datas
  params_f$=drive$+"\AUTO\PARAMS"          !location of user-datas
  logfile_f$=drive$+"\AUTO\LOGFILE"        !location of system logfile
  '
  super!=FALSE                             !True when superuser
  max%=14                                  !maximum of 14 users allowed
  number%=0                                !counter for users
  DIM super$(3),user$(max%,3),code$(max%,3)!reserve memory locations
  '
RETURN
'
' **********************************************************************
'
> PROCEDURE build_super
  '
  ' the program was never run before, the system is about to be installed.
  ' So the first user is the owner and superuser who is allowed to make
  ' modifications in the PARAMS file.
  '
  LOCAL flag!,j%,dummy%
  super!=TRUE
  @add_user
  IF maske$(1)="" OR maske$(2)="" OR maske$(3)=""
    ALERT 1,"|No modification made|to user database|",1,"  OK  ",dummy%
    GOTO build_end
  ENDIF
  code_key%=VAL(TIME$)*131
  @encode
  OPEN "O",#1,super_f$
  WRITE #1,code_key%
  j%=1
  REPEAT
    WRITE #1,code$(number%,j%)
    INC j%
  UNTIL j%>3
  CLOSE #1
  '
build_end:
RETURN
'
' **********************************************************************
'
> PROCEDURE add_user
  '
  ' this procedure takes the Username, First Name and Password of a new
  ' user.
  '
  LOCAL x%,y%,k%,dummy%,j%,n%
  screen$=""
  INC number%
  IF number%>max%
    ALERT 1,"|Maximum number of users|      exceeded",1," EXIT ",dummy%
    DEC number%
  ELSE
    @boxup(350,200,15,FALSE,*screen$)
    DEFTEXT ,1,,6
    TEXT 155,130,"To add a new user to the PARAMS datafile:"
    DEFTEXT 1,0,0,6
    j%=1
    REPEAT
      TEXT maske_x%(j%),maske_y%(j%),maske_t$(j%)
      maske_et$(j%)=""
      INC j%
    UNTIL j%>3
    @button(1,FALSE)
    HIDEM
    @eingabe(1,3)
    SHOWM
    DO
      MOUSE x%,y%,k%
      KEYTEST n%
      EXIT IF n%<>0 OR (k%=1 AND x%>290 AND x%<350 AND y%>280 AND y%<300)
    LOOP
    @button(1,TRUE)
    PAUSE 10
    user$(number%,1)=UPPER$(maske$(1))    !Last name
    user$(number%,3)=UPPER$(maske$(2))    !First Name
    user$(number%,2)=UPPER$(maske$(3))    !Password
    i%=1
  ENDIF
  @boxdown(350,200,15,FALSE,screen$)
  '
RETURN
'
' **********************************************************************
'
> PROCEDURE sho_user
  '
  ' displays all the registered users
  '
  '
  LOCAL n%,i%,lenght%,b%,h%,x1%,y1%,x2%,a%,c%,k%
  DIM account$(number%)
  lenght%=20
  i%=1
  REPEAT
    account$(i%)=user$(i%,1)+", "+user$(i%,3)
    IF (LEN(account$(i%))*8)>lenght% AND (LEN(account$(i%))*8)>(LEN(account$(i%-1))*8)
      lenght%=LEN(account$(i%))*8
    ENDIF
    INC i%
  UNTIL i%>number%
  QSORT account$()                              !sort alphabetically
  b%=lenght%+40                                 !calculate width of box
  h%=number%*10+40                              !calculate hight of box
  x1%=INT((630-b%)/2)                           !calculate hor. startpoint
  y1%=INT((415-h%)/2)                           !calculate vert. startpoint
  screen$=""
  @boxup(b%,h%,15,1,*screen$)                   !let box grow
  DEFTEXT 1,0,0,6                               !small letters
  i%=1
  REPEAT
    TEXT x1%+25,y1%+15+i%*10,account$(i%)       !display users
    INC i%
  UNTIL i%>number%
  DO                                            !waiting for mouseclick
    MOUSE a%,c%,k%
    KEYTEST n%
    EXIT IF k%=1 OR n%<>0
  LOOP
  DEFTEXT 1,0,0,13                              !normal letters again
  @boxdown(b%,h%,15,1,screen$)                  !let box shrink
  ERASE account$()                              !erase reserved variable space
RETURN
'
' **********************************************************************
'
> PROCEDURE build_menu
  '
  LOCAL j%,i%,x%,y%,k%,num%,n%,dummy%,pic$
  dates_f$=drive$+"\AUTO\"+"DATEBOOK."+STR$(z%)
  @lesen
  menu_screen$=""
  @boxup(300,200,15,TRUE,*menu_screen$)
  DEFMOUSE 0
  DEFTEXT ,1,,8
  TEXT 210,130,"AUTHORIZATION HANDLER"
  DEFTEXT 1,0,0,4
  TEXT 280,140,"GfA-Basic V3.5"
  TEXT 275,190,"     User:"
  TEXT 275,250,"  (c) 1990 by"
  TEXT 275,260,"     Bernd"
  TEXT 275,270,"  Falkenstein"
  DEFTEXT 1,5,0,4
  TEXT 313-LEN(user$(z%,3))*5/2,203,user$(z%,3)
  j%=2
  REPEAT
    @button(j%,FALSE)
    INC j%
  UNTIL j%>9
  DEFTEXT 1,0,0,6
  DO
    IF num%<>0
      @button(num%,FALSE)
    ENDIF
    num%=0
    SHOWM
    MOUSE x%,y%,k%
    '
    IF k%=3                          ! both mouse buttons enable selection
      FILESELECT drive$+"\*.*","",pic$   ! with a file select box
      IF RIGHT$(pic$)<>"\"           ! if not OK pressed without selection
        GOSUB lockterm(pic$)
      ENDIF
      k%=0
    ENDIF
    '
    IF k%=2                          ! right mouse button shows default picture
      pic$=drive$+"\AUTO\LOCK.PIC"
      GOSUB lockterm(pic$)
      k%=0
    ENDIF
    '
    IF k%=1
      i%=2
      REPEAT
        IF x%>=button_x%(i%) AND x%<=button_x%(i%)+60 AND y%>=button_y%(i%) AND y%<=button_y%(i%)+20
          num%=i%
          @button(num%,TRUE)
          PAUSE 10
        ENDIF
        INC i%
      UNTIL i%>9
    ENDIF
    SELECT num%
    CASE 2
      IF super!=FALSE
        ALERT 1,"|  no privilege for|attempted operation",1,"  OK  ",dummy%
      ELSE
        @sho_user
      ENDIF
    CASE 3
      IF super!=FALSE
        ALERT 1,"|  no privilege for|attempted operation",1,"  OK  ",dummy%
      ELSE
        @del_user
      ENDIF
    CASE 4
      IF super!=FALSE
        ALERT 1,"|  no privilege for|attempted operation!",1,"  OK  ",dummy%
      ELSE
        @add_user
      ENDIF
    CASE 5
      @change_pass
    CASE 6
      @datebook
    CASE 7
      IF super!=FALSE
        ALERT 1,"|  no privilege for|attempted operation!",1,"  OK  ",dummy%
      ELSE
        @logfile
      ENDIF
      '
    CASE 8
      IF super!=FALSE
        ALERT 1,"|  no privilege for|attempted operation!",1,"  OK  ",dummy%
      ELSE
        @button(8,TRUE)
        IF EXIST(logfile_f$)
          KILL logfile_f$
        ENDIF
        screen$=""
        @boxup(80,30,15,FALSE,*screen$)
        DEFTEXT 1,0,0,6
        TEXT 305,213,"DONE"
        SHOWM
        '
        DO
          KEYTEST n%
          MOUSE x%,y%,k%
          EXIT IF k%=1 OR n%<>0
        LOOP
        '
        @boxdown(80,30,15,FALSE,screen$)
        @button(8,FALSE)
      ENDIF
      '
    CASE 9
      @schluss
    ENDSELECT
    EXIT IF num%=9
  LOOP
  @boxdown(300,200,15,TRUE,menu_screen$)
  menu_screen$=""
  '
RETURN
'
' **********************************************************************
'
> PROCEDURE schluss
  '
  @encode
  @write
  @killtermin
  @schreiben
  '
RETURN
'
' **********************************************************************
'
> PROCEDURE schreiben
  '
  LOCAL i%
  DEFMOUSE 2
  OPEN "O",#1,dates_f$
  i%=1
  REPEAT
    PRINT #1,daten$(i%)
    INC i%
  UNTIL i%>anzahl%
  CLOSE #1
  DEFMOUSE 0
  '
RETURN
'
' **********************************************************************
'
> PROCEDURE lesen
  '
  LOCAL i%,a$
  i%=0
  IF EXIST(dates_f$)
    DEFMOUSE 2
    OPEN "I",#1,dates_f$
    REPEAT
      INC i%
      INPUT #1,a$
    UNTIL EOF(#1)
    CLOSE #1
    DIM daten$(i%+30)
    i%=0
    OPEN "I",#1,dates_f$
    REPEAT
      INC i%
      INPUT #1,daten$(i%)
    UNTIL EOF(#1)
    CLOSE #1
    DEFMOUSE 0
  ELSE
    DIM daten$(30)
  ENDIF
  anzahl%=i%
RETURN
'
' **********************************************************************
'
> PROCEDURE killtermin
  '
  LOCAL j%,i%
  DIM speicher$(anzahl%+1)
  i%=1
  j%=1
  '
  REPEAT
    '
    IF LEFT$(daten$(i%),2)="##"             !Every year
      speicher$(j%)=daten$(i%)
      INC j%
    ELSE
      '
      IF VAL(LEFT$(daten$(i%),2))>VAL(RIGHT$(DATE$,2))  !next year
        speicher$(j%)=daten$(i%)
        INC j%
      ELSE
        ' This year, but ahead of actual date:
        '
        IF VAL(MID$(daten$(i%),3,4))>=VAL(MID$(DATE$,4,2)+LEFT$(DATE$,2))
          speicher$(j%)=daten$(i%)
          INC j%
        ENDIF
        '
      ENDIF
      '
    ENDIF
    '
    INC i%
  UNTIL i%>anzahl%
  anzahl%=j%-1
  i%=1
  REPEAT
    daten$(i%)=speicher$(i%)
    INC i%
  UNTIL i%>anzahl%
  @sortiere(anzahl%)
  ERASE speicher$()
RETURN
'
' **********************************************************************
'
> PROCEDURE datebook
  '
  LOCAL datum$,year$,month$,n%,x%,y%,k%,w%,i%,dummy%
  screen$=""                            !clear memoryspace for screen
  @boxup(350,200,15,FALSE,*screen$)     !open window for inputs
  DEFTEXT ,1,,6
  TEXT 155,130,"    To enter dates for your datebook:"
  DEFTEXT 1,0,0,6
  TEXT 155,165,"    Use the date in following format:"
  TEXT 155,180,"       fixed dates  : 28-SEP-1990"
  TEXT 155,195,"       yearly events: 28-SEP-####"
  i%=4
  REPEAT
    TEXT maske_x%(i%),maske_y%(i%),maske_t$(i%)
    maske_et$(i%)=""
    INC i%
  UNTIL i%>7
  HIDEM
  @button(1,FALSE)
  @eingabe(4,7)
  SHOWM
  '
  DO
    MOUSE x%,y%,k%
    KEYTEST n%
    EXIT IF (k%=1 AND y%>280 AND y%<300 AND x%>290 AND x%<350) OR n%<>0
  LOOP
  '
  @button(1,TRUE)
  PAUSE 10
  month$=UPPER$(maske$(5))
  SELECT month$
  CASE "JAN"
    month$="01"
  CASE "FEB"
    month$="02"
  CASE "MAR"
    month$="03"
  CASE "APR"
    month$="04"
  CASE "MAY"
    month$="05"
  CASE "MAI"
    month$="05"
  CASE "JUN"
    month$="06"
  CASE "JUL"
    month$="07"
  CASE "AUG"
    month$="08"
  CASE "SEP"
    month$="09"
  CASE "OCT"
    month$="10"
  CASE "OKT"
    month$="10"
  CASE "NOV"
    month$="11"
  CASE "DEC"
    month$="12"
  CASE "DEZ"
    month$="12"
  ENDSELECT
  year$=maske$(6)
  IF year$="####"
    year$="##"
  ELSE
    IF VAL(year$)<VAL(RIGHT$(DATE$,4)) OR VAL(year$)>2050 OR VAL(year$)=0
      ALERT 1,"|This year is not relevant|   for your datebook!|   ==> not stored",1,"  OK  ",dummy%
      GOTO datebook_end
    ENDIF
    year$=RIGHT$(year$,2)
  ENDIF
  IF VAL(maske$(4))=0 OR VAL(month$)=0 OR VAL(month$)>12 OR VAL(maske$(4))>31
    ALERT 1,"|Wrong input for date!|    not stored",1,"  OK  ",dummy%
    GOTO datebook_end
  ENDIF
  datum$=year$+month$+maske$(4)
  INC anzahl%
  daten$(anzahl%)=datum$+" "+maske$(7)
datebook_end:
  @boxdown(350,200,15,FALSE,screen$)
  '
RETURN
'
' **********************************************************************
'
> PROCEDURE change_pass
  '
  LOCAL x%,y%,k%,n%,dummy%
  screen$=""
  @boxup(350,200,15,FALSE,*screen$)     !open window for inputs
  DEFTEXT ,1,,6
  TEXT 155,130,"To change your Password, "+LEFT$(user$(z%,3),15)+":"
  i%=8
  REPEAT
    TEXT maske_x%(i%),maske_y%(i%),maske_t$(i%)
    maske_et$(i%)=""
    INC i%
  UNTIL i%>9
  @button(1,FALSE)
  HIDEM
  @eingabe(8,9)
  SHOWM
  '
  DO
    MOUSE x%,y%,k%
    KEYTEST n%
    EXIT IF (k%=1 AND y%>280 AND y%<300 AND x%>290 AND x%<350) OR n%<>0
  LOOP
  '
  @button(1,TRUE)
  PAUSE 10
  IF UPPER$(maske$(8))=UPPER$(user$(z%,2))
    user$(z%,2)=UPPER$(maske$(9))
  ELSE
    ALERT 1,"|Authorization Failure!",1,"  OK  ",dummy%
  ENDIF
  @boxdown(350,200,15,FALSE,screen$)
RETURN
'
' **********************************************************************
'
> PROCEDURE logfile
  '
  LOCAL dummy%,zahl%,i%,j%,line$,x%,x%,k%,n%
  IF EXIST(logfile_f$)
    screen$=""
    DEFTEXT 1,0,0,4
    @boxup(420,200,15,FALSE,*screen$)
    DEFMOUSE 2
    OPEN "I",#1,logfile_f$
    INPUT #1,zahl%
    j%=1
  logstart:
    HIDEM
    i%=1
    REPEAT
      TEXT 135,107+i%*15,SPACE$(60)
      INC i%
    UNTIL i%>13
    i%=1
    REPEAT
      INPUT #1,line$
      INC j%
      TEXT 135,107+i%*15,LEFT$(line$,60)
      INC i%
    UNTIL i%>13 OR j%>zahl%
    SETMOUSE 600,360
    SHOWM
    DO
      MOUSE x%,y%,k%
      KEYTEST n%
      EXIT IF n%<>0 OR k%=1
    LOOP
    IF j%<=zahl%
      GOTO logstart
    ENDIF
    CLOSE #1
    DEFMOUSE 0
    @boxdown(420,200,15,FALSE,screen$)
  ELSE
    ALERT 1,"|No logfile on disk!",1,"  OK  ",dummy%
  ENDIF
  '
RETURN
'
' **********************************************************************
'
> PROCEDURE sortiere(lfd%)
  '
  ' Quicksort-Sorter-routine
  '
  LOCAL sp%,l%,r%,i%,j%,h$
  DIM s%(30,2)
  sp%=1
  s%(1,1)=1
  s%(1,2)=lfd%
  REPEAT
    l%=s%(sp%,1)
    r%=s%(sp%,2)
    DEC sp%
    REPEAT
      i%=l%
      j%=r%
      h$=MID$(daten$((l%+r%) DIV 2),3,4)
      REPEAT
        WHILE MID$(daten$(i%),3,4)<h$ AND (i%<r%)
          INC i%
        WEND
        WHILE MID$(daten$(j%),3,4)>h$ AND (j%>l%)
          DEC j%
        WEND
        IF i%<=j%
          SWAP daten$(i%),daten$(j%)
          LSET daten$(i%)=daten$(i%)
          INC i%
          DEC j%
        ENDIF
      UNTIL i%>j%
      IF (r%-i%)<=(j%-l%)
        IF i%>=r%
          r%=j%
        ELSE
          INC sp%
          s%(sp%,1)=i%
          s%(sp%,2)=r%
        ENDIF
        r%=j%
        GOTO point1
      ELSE
        IF l%<j%
          INC sp%
          s%(sp%,1)=l%
          s%(sp%,2)=j%
        ENDIF
        l%=i%
      ENDIF
    point1:
    UNTIL r%<=l%
  UNTIL sp%=0
  ERASE s%()
  '
RETURN
'
' *********************************************************************
'
> PROCEDURE lockterm(b$)
  '
  LOCAL x%,y%,k%,xpos%,ypos%,n|
  '
  ' read and show picture
  '
  screen$=""
  SGET screen$
  OPEN "I",#1,b$
  BGET #1,XBIOS(2),32000
  CLOSE #1
  '
  ' get mouse or keyboard state, get password
  '
  xpos%=MOUSEX
  ypos%=MOUSEY
  '
  DO
    MOUSE x%,y%,k%
    KEYTEST n|
    IF n|<>0 OR k%<>0 OR x%<>xpos% OR y%<>ypos%
      GOSUB get_pass
      xpos%=MOUSEX
      ypos%=MOUSEY
    ENDIF
    EXIT IF pass!=TRUE
  LOOP
  SPUT screen$
  '
RETURN
'
' **********************************************************************
'
> PROCEDURE get_pass
  '
  LOCAL t%,x|,pass$
  '
  screen1$=""
  @boxup(250,50,15,FALSE,*screen1$)
  DEFTEXT ,1,,6
  TEXT 210,213,"Please enter your password!"
  pass!=FALSE
  pass$=""
  t%=TIMER
  '
  REPEAT
    KEYTEST x|
    IF x|<>0
      pass$=pass$+CHR$(x|)
    ENDIF
  UNTIL x|=13 OR (TIMER-t%)/200>20     !RETURN or 20 sec timeout
  '
  IF TRIM$(UPPER$(LEFT$(pass$,LEN(pass$)-1)))=TRIM$(user$(z%,2))
    pass!=TRUE
  ENDIF
  '
  @boxdown(250,50,15,FALSE,screen1$)
  screen1$=""
  '
RETURN
'
' **********************************************************************