Setup:
  PALETTE 0,0,.1,.4
  PALETTE 2,0,1,0
  
Begin:
  CLS : LOCATE 1,1 : PRINT  "Select"
  LOCATE 1,25 : COLOR 3,0 : PRINT "Filename:"; : COLOR 1,0
  IF Altname$<>"" THEN PRINT Altname$ ELSE PRINT "(no file)"
  PRINT
  COLOR 0,3 : PRINT SPACE$(21)"AmigaBASIC DataBase"SPACE$(21)
  LOCATE 5,22 : COLOR 3,0
  PRINT "Please Choose:"
  LOCATE 7,22
  COLOR 0,1 :PRINT " 1 "; : COLOR 1,0 : PRINT " Create File"
  LOCATE 9,22
  COLOR 0,1 :PRINT " 2 "; : COLOR 1,0 : PRINT " Enter data"
  LOCATE 11,22
  COLOR 0,1 :PRINT " 3 "; : COLOR 1,0 : PRINT " Read file"
  LOCATE 13,22
  COLOR 0,1 :PRINT " 4 "; : COLOR 1,0 : PRINT " Search file"
  LOCATE 15,22
  COLOR 0,1 :PRINT " 5 "; : COLOR 1,0 : PRINT " End"
MenuSelect:
  LOCATE 18,1 : PRINT SPACE$(60)
  LOCATE 18,22 :  COLOR 3,0 : PRINT  "Enter number:";
  COLOR 1,0 :  LINE INPUT number$
  number$=LEFT$(number$,1)
  IF number$<"1" OR number$>"5" THEN MenuSelect
  IF number$="1" THEN CreateFile
  IF number$="2" THEN EnterData
  IF number$="3" THEN DataSearch=0 : GOTO ReadData
  IF number$="4" THEN DataSearch=1 : GOTO ReadData
  PRINT  "Program ended."
END

CreateFile:
  CLS : LOCATE 1,1 : COLOR 1,0 : PRINT  "Create File"
  LOCATE 1,25 : COLOR 3,0 : PRINT "Filename:";
  COLOR 1,0 : PRINT "(no file)" 
  COLOR 3,0 : LOCATE 3,1
  PRINT "Enter field name and field length."
  COLOR 1,0
  FOR x=0 TO 9
    Fieldname$="" : Length(x)=0
  NEXT x
  LOCATE 4,1 : PRINT "Name" : LOCATE 4,26 : PRINT "Length (<40)"
  FOR x=0 TO 9
    NoOfFields=x
    LOCATE x+6,1 : LINE INPUT Fieldname$(x)
    IF Fieldname$(x)="" THEN x=10 : NoOfFields=NoOfFields-1
    Fieldname$(x)=LEFT$(Fieldname$(x),25)
    LOCATE x+6,26 : PRINT SPACE$(40);
    LOCATE x+6,26 : LINE INPUT Length$
    IF Length$="" OR ABS(VAL(Length$))>40 THEN Length$="40"
    Length(x)=INT(ABS(VAL(Length$)))
    IF Length(x)=0 THEN Length(x)=40
  NEXT x

Corrections:
  GOSUB EntryOK
  IF Corr=0 THEN OpenFile
  IF Corr=1 THEN ErrorCorrection
GOTO Corrections

ErrorCorrection:
  FOR x=0 TO NoOfFields
    LOCATE x+6,1 : PRINT SPACE$(60)
    LOCATE x+6,25 : PRINT  Length(x)
    LOCATE x+6,1 : PRINT  Fieldname$(x)
  NEXT x
  FOR x=0 TO NoOfFields
    LOCATE x+6,1 : LINE INPUT Fieldname$
    IF Fieldname$<>"" THEN Fieldname$(x)=LEFT$(Fieldname$,25)
    LOCATE x+6,26 : LINE INPUT Length$
    IF ABS(VAL(Length$))>40 THEN Length$="40"
    IF Length$<>"" THEN Length(x)=INT(ABS(VAL(Length$)))
    IF Length(x)=0 THEN Length(x)=40
  NEXT x
  GOTO Corrections

OpenFile:
  LOCATE 19,1 : PRINT  SPACE$(60);
  LOCATE 19,1 : COLOR 3,0 : PRINT  "Enter Filename:";
  COLOR 1,0 : LINE INPUT Nam$
  RecordLength=0
  FOR x=0 TO NoOfFields
    RecordLength=RecordLength+Length(x)
  NEXT x
  IF Nam$="" OR RecordLength=0 THEN BEEP : GOTO Begin
  OPEN "R",#1,Nam$,RecordLength
    FIELD #1,Length(0) AS Dat$(0),Length(1) AS Dat$(1),Length(2) AS Dat$(2),Length(3) AS Dat$(3),Length(4) AS Dat$(4),Length(5) AS Dat$(5),Length(6) AS Dat$(6),Length(7) AS Dat$(7),Length(8) AS Dat$(8),Length(9) AS Dat$(9)
    FOR x=1 TO NoOfFields
      LSET Dat$(x)=" " 
    NEXT x
  CLOSE 1
  OPEN Nam$+".Flds" FOR OUTPUT AS 2
    PRINT #2,NoOfFields
    PRINT #2,RecordLength
    PRINT #2,0
    FOR x=0 TO NoOfFields
      WRITE #2,Fieldname$(x)
      PRINT #2,Length(x)
    NEXT x
  CLOSE 2
  Altname$=Nam$
GOTO Begin

EnterData:
  CLS : LOCATE 1,1 : PRINT "Enter data"

  IF Nam$="" THEN
    LOCATE 3,1 : COLOR 3,0 : PRINT "Enter Filename:"
    COLOR 1,0 : LINE INPUT Nam$
    IF Nam$="=" OR Nam$="*" THEN Nam$=Altname$
    IF Nam$="" THEN Begin
    Altname$=Nam$
  END IF
  GOSUB FieldFileExistYN
  IF FileExist=0 THEN
    COLOR 3,0 : PRINT 
    PRINT "Press any key."
    WHILE INKEY$="" : WEND : COLOR 1,0
    GOTO Begin
  END IF
  GOSUB ReadFileField
  RecordNumber=NoOfRecords+1
  
  OPEN "R",#1,Nam$,RecordLength  
      FIELD #1,Length(0) AS Dat$(0),Length(1) AS Dat$(1),Length(2) AS Dat$(2),Length(3) AS Dat$(3),Length(4) AS Dat$(4),Length(5) AS Dat$(5),Length(6) AS Dat$(6),Length(7) AS Dat$(7),Length(8) AS Dat$(8),Length(9) AS Dat$(9)

InputLoop:
      CLS : LOCATE 1,1 : COLOR 1,0 : PRINT "Enter new data"
      LOCATE 1,25 : COLOR 3,0 : PRINT "File:";
      COLOR 1,0 : PRINT  Nam$

      Inpt=0
      LOCATE 1,50 : PRINT "Record:";RecordNumber
      PRINT : COLOR 3,0
      PRINT  "Enter new data:" : COLOR 1,0
    FOR x=0 TO NoOfFields
      LOCATE 5+x,1 : COLOR 2,0 : PRINT Fieldname$(x)": "
    NEXT x : COLOR 1,0
    FOR x=0 TO NoOfFields
      LOCATE 5+x,LEN(Fieldname$(x))+3
      LINE INPUT Entry$
      IF Entry$<>"" THEN Inpt=1
      Entry$(x)=LEFT$(Entry$,Length(x))
      LSET Dat$(x) = Entry$(x)
    NEXT x
   Corrections2:
    GOSUB EntryOK
    IF Corr=0 THEN WriteRecord
    IF Corr=1 THEN EnterCorrection
  GOTO Corrections2

  EnterCorrection:
    CLS : LOCATE 1,1 : COLOR 1,0 : 
PRINT  "Add Data"
    LOCATE 1,25 : COLOR 3,0 : PRINT "File:";
    COLOR 1,0 : PRINT  Nam$

      LOCATE 1,50 : PRINT "Record:";RecordNumber
      PRINT : PRINT 
    FOR x=0 TO NoOfFields
      LOCATE 5+x,1 : COLOR 2,0 : PRINT Fieldname$(x)": ";
      COLOR 1,0 : PRINT Entry$(x)
  
    NEXT x
    FOR x=0 TO NoOfFields
      LOCATE 5+x,LEN(Fieldname$(x))+2
      LINE INPUT Entry$
      IF Entry$<>"" THEN
        Inpt=1
        Entry$(x)=LEFT$(Entry$,Length(x))
        LSET Dat$(x) = Entry$(x)
      END IF
    NEXT x
    GOTO Corrections2
    
WriteRecord:
  IF Inpt=1 THEN
    PUT #1,RecordNumber
    IF DataFlag=1 THEN DataFlag=0 : GOTO ReadLoop
    RecordNumber=RecordNumber+1
  END IF
  IF DataFlag=1 THEN DataFlag=0 : GOTO ReadLoop
NextYN:
  LOCATE 19,1 : PRINT SPACE$(60) : COLOR 3,0
  LOCATE 19,1 : PRINT "Next Record (Y/N)";
  COLOR 1,0 : LINE INPUT a$
  IF UCASE$(a$)="Y" OR a$="" THEN InputLoop
  IF UCASE$(a$)="N" THEN CloseFile
GOTO NextYN

CloseFile:
  CLOSE 1
  OPEN Nam$+".Flds" FOR OUTPUT AS 2
    PRINT #2,NoOfFields
    PRINT #2,RecordLength
    PRINT #2,RecordNumber-1
    FOR x=0 TO NoOfFields
      WRITE #2,Fieldname$(x)
      PRINT #2,Length(x)
    NEXT x
  CLOSE 2
  Nam$=""
GOTO Begin

ReadData:
    CLS : LOCATE 1,1 : PRINT "Read Data"
    IF DataSearch=1 THEN LOCATE 1,1 : PRINT "Search Data"
    LOCATE 3,1 : COLOR 3,0 : PRINT "Enter filename:"
    COLOR 1,0 : LINE INPUT Nam$
    IF Nam$="=" OR Nam$="*" THEN Nam$=Altname$
    IF Nam$="" THEN Begin
    Altname$=Nam$

    GOSUB FieldFileExistYN
    IF FileExist=0 THEN
      PRINT : COLOR 3,0
      PRINT "Press any key."
      COLOR 1,0
      WHILE INKEY$="" : WEND
      GOTO Begin
    END IF
    GOSUB ReadFileField
    IF NoOfRecords=0 THEN
      PRINT : BEEP
      COLOR 1,0
      PRINT "No records in file!"
      PRINT : COLOR 3,0
      PRINT "Press any key."
      COLOR 1,0
      WHILE INKEY$="" : WEND
      GOTO Begin
    END IF
  IF DataSearch=1 THEN GOSUB SearchData
  OPEN "R",#1,Nam$,RecordLength  
      FIELD #1,Length(0) AS Dat$(0),Length(1) AS Dat$(1),Length(2) AS Dat$(2),Length(3) AS Dat$(3),Length(4) AS Dat$(4),Length(5) AS Dat$(5),Length(6) AS Dat$(6),Length(7) AS Dat$(7),Length(8) AS Dat$(8),Length(9) AS Dat$(9)
      RecordNumber=1
ReadLoop:
    CLS : LOCATE 1,1 : COLOR 1,0 : PRINT  "Read Data"
    LOCATE 1,25 : COLOR 3,0 : PRINT "File:";
    COLOR 1,0 : PRINT Nam$
    COLOR 3,0
    LOCATE 17,1 : PRINT  "[Cursor UP]   = Previous Record"
    LOCATE 17,37 : PRINT "[F1]      = First Record"
    PRINT "[Cursor Down] = Next Record"
    LOCATE 18,37 : PRINT "[F2]      = Last Record"
    PRINT "[CTRL]-[P]    = Print Record"
    LOCATE 19,37 : PRINT "[HELP]    = Alter Record"
    PRINT "[F10]         = Main Menu";
  ReadRecord:
    COLOR 1,0
    IF RecordNumber>NoOfRecords THEN BEEP : RecordNumber=NoOfRecords
    IF RecordNumber<1 THEN BEEP : RecordNumber=1
    LOCATE 1,50 : PRINT "Record:";RecordNumber
    GET #1,RecordNumber
    IF DataSearch=1 THEN LOCATE 1,1 : PRINT "Search Data" : GOSUB ExamSearchData
    IF DataSearch=1 AND Found=0 THEN
       IF RecordNumber=NoOfRecords THEN Direction=-1
       IF RecordNumber=NoOfRecords AND FindRecord=0 THEN
          CLS
          LOCATE 5,10 : PRINT "No record found!"
          LOCATE 7,10 : COLOR 3,0
          PRINT  "Press any key."
          COLOR 1,0 : BEEP
          WHILE INKEY$="" : WEND : CLOSE 1 : GOTO Begin
       END IF
       IF RecordNumber=1 THEN Direction=1
       RecordNumber=RecordNumber+Direction
      GOTO ReadRecord
    END IF
    FindRecord=1
    FOR x=0 TO NoOfFields
      LOCATE 5+x,1 : COLOR 2,0 : PRINT Fieldname$(x)":  "
    NEXT x : COLOR 1,0
    FOR x=0 TO NoOfFields
      LOCATE 5+x,LEN(Fieldname$(x))+3
      PRINT  Dat$(x)
      Entry$(x)=Dat$(x)
    NEXT x
    Key$=""
    WHILE Key$="" : Key$=INKEY$ : WEND
    IF Key$=CHR$(28) THEN RecordNumber=RecordNumber-1 : Direction=-1
    IF Key$=CHR$(29) THEN RecordNumber=RecordNumber+1 : Direction=1
    IF Key$=CHR$(129) THEN RecordNumber=1
    IF Key$=CHR$(130) THEN RecordNumber=NoOfRecords
    IF Key$=CHR$(138) THEN EndLoad
    IF Key$=CHR$(16) THEN
       FOR x=0 TO NoOfFields
         LPRINT Fieldname$(x)":"Dat$(x)
       NEXT x
       LPRINT
    END IF
    IF Key$=CHR$(139) THEN DataFlag=1 : GOTO EnterCorrection
GOTO ReadLoop

EndLoad:
    CLOSE 1
    Nam$=""
GOTO Begin

REM ************** Subprogram *******************

SearchData:
  CLS : LOCATE 1,1 : COLOR 1,0 : PRINT "Search Data"
  LOCATE 1,25 : COLOR 3,0 : PRINT "File:";
  COLOR 1,0 : PRINT Nam$
  FOR x=0 TO NoOfFields
    LOCATE 5+x,1 : PRINT Fieldname$(x)":"
  NEXT x
  COLOR 3,0 : LOCATE 4,1  
  PRINT  "Enter search string."
  COLOR 1,0
    FOR x=0 TO NoOfFields
      LOCATE 5+x,LEN(Fieldname$(x))+2
      LINE INPUT Entry$
      IF Entry$<>"" THEN
        Search$=LEFT$(Entry$,Length(x))
        SearchNo=x : x=10
      ELSE
        Search$=""
      END IF
    NEXT x
  Corrections3:
     GOSUB EntryOK
    IF Corr=0 THEN EndSearch
    IF Corr=1 THEN SearchCorr
  GOTO Corrections3

  SearchCorr:
    LOCATE 5+SearchNo,1 : PRINT Fieldname$(SearchNo)":"Search$
    LOCATE 5+SearchNo,LEN(Fieldname$(SearchNo))+2
    LINE INPUT Entry$
    IF Entry$<>"" THEN Search$=LEFT$(Entry$,Length(SearchNo))
  GOTO Corrections3
  
EndSearch:
  IF Search$="" THEN SearchNo=0 : DataSearch=0
  FindRecord=0
RETURN

ExamSearchData:
    x=0
SearchLoop:
    x=x+1
    IF x>LEN(Dat$(SearchNo))-LEN(Search$) THEN Found=0 : RETURN
    IF MID$(Dat$(SearchNo),x,LEN(Search$))=Search$ THEN Found=1 : RETURN  
GOTO SearchLoop  

EntryOK:
  LOCATE 19,1 : COLOR 3,0
  PRINT "Entry Okay? (Y/N)";
  COLOR 1,0 : INPUT "",a$
  IF UCASE$(a$)="Y" OR a$="" THEN Corr=0 : RETURN
  IF UCASE$(a$)="N" THEN Corr=1 : RETURN
GOTO EntryOK

FieldFileExistYN:
  OPEN Nam$+".Flds" FOR APPEND AS 1
    IF LOF(1)<=0 THEN FileExist=0 ELSE FileExist=1
  CLOSE 1
  IF FileExist=0 THEN
    LOCATE 3,1 : PRINT  SPACE$(60) : BEEP
    LOCATE 3,1 : COLOR 1,0 : PRINT "File ";Nam$
    PRINT "not found!"
    KILL Nam$+".Flds"
    Nam$="" : COLOR 3,0
  END IF
RETURN

ReadFileField:
  FOR x=1 TO 10
    Fieldname$(x)="" : Length(x)=0
  NEXT x
  OPEN Nam$+".Flds" FOR INPUT AS 2
    INPUT #2,NoOfFields
    INPUT #2,RecordLength
    INPUT #2,NoOfRecords
    FOR x=0 TO NoOfFields
      INPUT #2,Fieldname$(x)
      INPUT #2,Length(x)
    NEXT x
  CLOSE 2
RETURN