'===========================================================================
' Subject: ADDRESS BOOK                       Date: 01-12-97 (17:42)       
'  Author: Xtance Coders Alliance             Code: QB, QBasic, PDS        
'  Origin: harrys@castel.nl                 Packet: MISC.ABC
'===========================================================================
DECLARE SUB Reg ()
DECLARE SUB NOFilesFound ()
DECLARE SUB CLSScreen ()
DECLARE FUNCTION CHeckBestand! (Welke$)
DECLARE SUB noBackup ()
DECLARE SUB RESTOREBackup ()
DECLARE SUB Backup ()
DECLARE SUB Copy (Bestand1$, Bestand2$, FileCopyShow%, regel%, waar%, BKleur%, FKleur%, car%)
DECLARE SUB FileRead (filename$, LIneCount%, VNaam$(), ANaam$(), Straat$(), Hnummer$(), PCode$(), Tel$(), Stad$(), GDatum$(), Extra1$(), Extra2$())
DECLARE FUNCTION ED$ (z%, x%, m%, n%)
DECLARE SUB editLine (a$, ExitCode, Ascii)
DECLARE FUNCTION ScanCode! ()
DECLARE SUB info.MrSnow ()
DECLARE SUB inFO.Prog ()
DECLARE SUB expand (UpRow%, LtColum%, LoRow%, RtColum%)
DECLARE SUB Drawbox (UpRow%, LtColum%, LoRow%, RtColum%)
DECLARE SUB pause (ticks%)
DECLARE SUB Shadow (UpRow%, LtColum%, LoRow%, RtColum%)
DECLARE SUB CheckShell ()
DECLARE SUB DeleteAdres.Lijst (Welke%, Ect%)
DECLARE SUB NewDataFIle ()
DECLARE SUB DeleteAdres (Welke%, Ect%)
DECLARE SUB Show.KeuseLijst (aDres$(), BackADRES$(), til%)
DECLARE SUB KeuseLijst ()
DECLARE SUB COL (b!, c!, k$, e!, d!)
DECLARE SUB ShowFile (t%)
DECLARE SUB inPutFile (laatste%)
DECLARE FUNCTION DAtaFile.Exist% ()
DECLARE FUNCTION keycode% ()
CONST LST$ = "ADRES.LST"
TYPE Fixed
  Str AS STRING * 100                          'kopieerbuffer 16384
END TYPE
DIM SHARED VNaam$(500), ANaam$(500), Straat$(500), Hnummer$(500), PCode$(500), Tel$(500), Stad$(500), GDatum$(500), Extra1$(500), Extra2$(500)
ON ERROR GOTO fout

'       This program is made by yours Mr. SN()W From
'
'               Xtance Coders Alliance 1997
'
'       E-mail: Mrsnow@freemail.nl
'       or
'       harryst@castel.nl
'
' Please send mail if you use any thing of this or if you have any comments
'
' For All BASIC Code from William Yu 1997
'
' --------------------------------------------------------------------------




CLS

IF DAtaFile.Exist = 1 THEN
	PRINT "CReating new DATA File ..": NewDataFIle
ELSE
FileRead "ADRES.DAT", LIneCount%, VNaam$(), ANaam$(), Straat$(), Hnummer$(), PCode$(), Tel$(), Stad$(), GDatum$(), Extra1$(), Extra2$()
END IF

Start:
CALL KeuseLijst


neetoch:
CLS
KEY(9) OFF
KeuseLijst
END

fout:
COLOR 7, 0: CLS : PRINT "ERROR #"; ERR; "Found"
END
RESUME

Existfout:
RESUME NEXT


Backupnee:
CALL noBackup

GOTO Start

SUB Backup
ON ERROR GOTO Existfout

'(Bestand1$, Bestand2$, FileCopyShow%, Regel%, Waar%, BKleur%, FKleur%, Car%)
a = CHeckBestand("ADRES.BAK\ADRES.DAT")
b = CHeckBestand("ADRES.BAK\ADRES.EXE")
c = CHeckBestand("ADRES.BAK\ADRES.LST")
IF a = 0 OR b = 0 OR c = 0 THEN CALL NOFilesFound
IF a = 0 OR b = 0 OR c = 0 THEN EXIT SUB

expand 4, 5, 12, 75
LOCATE 4, 35: PRINT "[ Backup ]"

MKDIR "ADRES.BAK"
Copy "ADRES.DAT", "ADRES.BAK\ADRES.DAT", 1, 7, 15, 7, 1, 254
Copy LST$, "ADRES.BAK\ADRES.LST", 1, 7, 15, 7, 1, 254
Copy "ADRES.EXE", "ADRES.BAK\ADRES.EXE", 1, 7, 15, 7, 1, 254
LOCATE 10, 12: PRINT "Press 'Y' to return to the menu ..."
DO: LOOP UNTIL UCASE$(INKEY$) = "Y"
ON ERROR GOTO fout


END SUB

FUNCTION CHeckBestand (Welke$)
OPEN Welke$ FOR APPEND AS #5
i = LOF(5)
CLOSE
IF i = 0 THEN CHeckBestand = 0
IF i >= 1 THEN CHeckBestand = 1
END FUNCTION

SUB CheckShell STATIC
OPEN "ADres.Dat" FOR APPEND AS #1
OPEN LST$ FOR APPEND AS #2
a = LOF(1): b = LOF(2)
CLOSE 1, 2
IF a < 30 AND b < 10 THEN CALL NewDataFIle
END SUB

SUB CLSScreen
FOR i = 1 TO 24
LOCATE i, 1: PRINT STRING$(80, 32);
NEXT i
END SUB

SUB COL (b, c, k$, e, d) STATIC
COLOR b, c
PRINT k$
COLOR e, d
END SUB

DEFINT A-Z
SUB Copy (Bestand1$, Bestand2$, FileCopyShow%, regel%, waar%, BKleur%, FKleur%, car%)
COLOR BKleur%, FKleur%
LOCATE regel%, waar%
PRINT STRING$(52, 32);
COLOR BKleur%, FKleur%
LOCATE regel%, waar%
PRINT STRING$(51, 32);


Add% = 0  '0 = overschrijven. -1 = Toevoegen
CopyDate% = 1 '0 = huidige datum. -1 = datum van bronbestand
REDIM Buffer(0) AS Fixed                         ' fixed string in far heap

f1% = FREEFILE                                   ' handle #F1%
OPEN Bestand1$ FOR BINARY AS #f1% LEN = 4096     ' open bronbestand

f2% = FREEFILE                                   ' handle #F2%
IF NOT Add% THEN                                 ' overschrijven
  OPEN Bestand2$ FOR OUTPUT AS #f2%              ' voor alle zekerheid...
  CLOSE #f2%                                     '
  KILL Bestand2$                                 ' wissen
END IF

OPEN Bestand2$ FOR BINARY AS #f2% LEN = 4096     ' open doelbestand

IF Add% THEN                                     ' Toevoegen
  TotalBytes& = LOF(f1%) + LOF(f2%)              ' tel op
  SEEK #f2%, LOF(f2%) + 1                        ' append
ELSE
  TotalBytes& = LOF(f1%)
END IF

DO
  GET #f1%, , Buffer(0)                          ' lees dan 16Kb
  IF NOT EOF(f1%) THEN
    PUT #f2%, , Buffer(0)                        ' schrijf naar 2
  ELSE                                           ' hoeveel rest ?
    FOR x% = 1 TO (TotalBytes& - LOF(f2%)) STEP 4096
	IF TotalBytes& - LOF(f2%) >= 4096 THEN     ' blokken van 4Kb
	Temp$ = MID$(Buffer(0).Str, x%, 4096)
	ELSE
	Temp$ = MID$(Buffer(0).Str, x%, (TotalBytes& - LOF(f2%)))
	END IF
	PUT #f2%, , Temp$                          ' schrijf rest
  
    NEXT x%
  END IF
IF FileCopyShow = 1 THEN
COLOR BKleur%, FKleur%
'LOCATE regel%, waar%
'PRINT STRING$(FIX(LOF(f2%) / (LOF(f1%) / 100)) / 2, Car%); '219

LOCATE regel%, waar% + (FIX(LOF(f2%) / (LOF(f1%) / 100)) / 2)
COLOR 10, 1
PRINT "->"
COLOR BKleur%, FKleur%
LOCATE regel% + 1, waar% + 18: PRINT FIX(LOF(f2%) / (LOF(f1%) / 100)); "% Done  "
LOCATE regel - 2, waar% - 8: PRINT "File: "; Bestand1$; " -->-> "; Bestand2$
END IF

LOOP UNTIL EOF(f1%)
CLOSE 1, 2
SLEEP 1

COLOR BKleur%, FKleur%
END SUB

FUNCTION DAtaFile.Exist STATIC
OPEN "ADRES.DAT" FOR APPEND AS #9
IF LOF(9) < 1 THEN DAtaFile.Exist = 1
IF LOF(9) > 1 THEN DAtaFile.Exist = 2
IF LOF(9) < 1 THEN GOTO nee

CLOSE 9

EXIT FUNCTION
nee:
CLOSE 9
KILL "ADRES.DAT"

END FUNCTION

DEFSNG A-Z
SUB DeleteAdres (Welke%, Ect%) STATIC
'PRINT Welke%, Ect%: END

OPEN "ADRES.DAT" FOR INPUT AS #1
OPEN "ADres.TMP" FOR OUTPUT AS #2

IF Welke% = Ect% THEN GOTO EindeWeg
IF Welke% = 1 THEN GOTO beginWeg

FOR t% = 1 TO Welke% - 1
INPUT #1, VNaam$(t%), ANaam$(t%), Straat$(t%), Hnummer$(t%), PCode$(t%), Stad$(t%), Tel$(t%), GDatum$(t%), Extra1$(t%), Extra2$(t%)
WRITE #2, VNaam$(t%), ANaam$(t%), Straat$(t%), Hnummer$(t%), PCode$(t%), Stad$(t%), Tel$(t%), GDatum$(t%), Extra1$(t%), Extra2$(t%)
NEXT t%

INPUT #1, VNaam$(Welke% + 1), ANaam$(Welke% + 1), Straat$(Welke% + 1), Hnummer$(Welke% + 1), PCode$(Welke% + 1), Stad$(Welke% + 1), Tel$(Welke% + 1), GDatum$(Welke% + 1), Extra1$(Welke% + 1), Extra2$(Welke% + 1)

FOR t% = Welke% + 1 TO Ect%
INPUT #1, VNaam$(t%), ANaam$(t%), Straat$(t%), Hnummer$(t%), PCode$(t%), Stad$(t%), Tel$(t%), GDatum$(t%), Extra1$(t%), Extra2$(t%)
WRITE #2, VNaam$(t%), ANaam$(t%), Straat$(t%), Hnummer$(t%), PCode$(t%), Stad$(t%), Tel$(t%), GDatum$(t%), Extra1$(t%), Extra2$(t%)
NEXT t%
CLOSE 1, 2
KILL "ADRES.DAT"
NAME "ADRES.TMP" AS "ADRES.DAT"
EXIT SUB

EindeWeg:
FOR i% = 1 TO Ect% - 1
INPUT #1, VNaam$(i%), ANaam$(i%), Straat$(i%), Hnummer$(i%), PCode$(i%), Stad$(i%), Tel$(i%), GDatum$(i%), Extra1$(i%), Extra2$(i%)
WRITE #2, VNaam$(i%), ANaam$(i%), Straat$(i%), Hnummer$(i%), PCode$(i%), Stad$(i%), Tel$(i%), GDatum$(i%), Extra1$(i%), Extra2$(i%)
NEXT i%

CLOSE 1, 2
KILL "ADRES.DAT"
NAME "ADRES.TMP" AS "ADRES.DAT"
EXIT SUB

beginWeg:
INPUT #1, VNaam$(i%), ANaam$(i%), Straat$(i%), Hnummer$(i%), PCode$(i%), Stad$(i%), Tel$(i%), GDatum$(i%), Extra1$(i%), Extra2$(i%)

FOR i% = 2 TO Ect%
INPUT #1, VNaam$(i%), ANaam$(i%), Straat$(i%), Hnummer$(i%), PCode$(i%), Stad$(i%), Tel$(i%), GDatum$(i%), Extra1$(i%), Extra2$(i%)
WRITE #2, VNaam$(i%), ANaam$(i%), Straat$(i%), Hnummer$(i%), PCode$(i%), Stad$(i%), Tel$(i%), GDatum$(i%), Extra1$(i%), Extra2$(i%)
NEXT i%
CLOSE 1, 2
KILL "ADRES.DAT"
NAME "ADRES.TMP" AS "ADRES.DAT"
EXIT SUB

END SUB

SUB DeleteAdres.Lijst (Welke%, Ect%) STATIC
'PRINT Welke%, Ect%: END
OPEN LST$ FOR INPUT AS #1
OPEN "ADres.TMP" FOR OUTPUT AS #2

IF Welke% = Ect% THEN GOTO EindeWegLijst
IF Welke% = 1 THEN GOTO beginWegLijst

FOR i% = 1 TO Welke% - 1
INPUT #1, VNaam$(i%), ANaam$(i%)
WRITE #2, VNaam$(i%), ANaam$(i%)
NEXT i%

INPUT #1, VNaam$(Welke% + 1), ANaam$(Welke% + 1)

FOR i% = Welke% + 1 TO Ect%
INPUT #1, VNaam$(i%), ANaam$(i%)
WRITE #2, VNaam$(i%), ANaam$(i%)
NEXT i%
CLOSE 1, 2
KILL LST$
NAME "ADRES.TMP" AS LST$
EXIT SUB

EindeWegLijst:
FOR i% = 1 TO Ect% - 1
INPUT #1, VNaam$(i%), ANaam$(i%)
WRITE #2, VNaam$(i%), ANaam$(i%)
NEXT i%

CLOSE 1, 2
KILL LST$
NAME "ADRES.TMP" AS LST$
EXIT SUB

beginWegLijst:
INPUT #1, VNaam$(1), ANaam$(1)

FOR i% = 2 TO Ect%
INPUT #1, VNaam$(i%), ANaam$(i%)
WRITE #2, VNaam$(i%), ANaam$(i%)
NEXT i%
CLOSE 1, 2
KILL LST$
NAME "ADRES.TMP" AS LST$
EXIT SUB


END SUB

 SUB Drawbox (UpRow%, LtColum%, LoRow%, RtColum%) STATIC
    Wide% = (RtColum% - LtColum%) - 1
    LOCATE UpRow%, LtColum%
    PRINT CHR$(201); STRING$(Wide%, CHR$(205)); CHR$(187);
    FOR i% = UpRow% + 1 TO LoRow% - 1
	LOCATE i%, LtColum%
	PRINT CHR$(186); SPACE$(Wide%); CHR$(186);
    NEXT i%
    LOCATE LoRow%, LtColum%
    PRINT CHR$(200); STRING$(Wide%, CHR$(205)); CHR$(188);
 END SUB

FUNCTION ED$ (z%, x%, m%, n%)
Erik$ = STRING$(25, 32)
COLOR z%, x%
editLine Erik$, ExitCode, 32
COLOR m%, n%
ED$ = Erik$
END FUNCTION

SUB editLine (a$, ExitCode, Ascii) STATIC
    CONST FALSE = 0, TRUE = NOT FALSE
    CONST BACKSPACE = 8
    CONST DELETEKEY = -83
    CONST ENDKEY = -79
    CONST ENTER = 13
    CONST ESCAPE = 27
    CONST HOME = -71
    CONST INSERTKEY = -82
    CONST LEFTARROW = -75
    CONST RIGHTARROW = -77
    CONST TABKEY = 9
 
    row = CSRLIN
    Coli% = POS(0)
    length = LEN(a$)
    Ptr = 0
    insirt = TRUE
    quit = FALSE
    original$ = a$
    DO

    LOCATE row, Coli%, 0
	PRINT a$;
	IF insirt THEN
	    LOCATE row, Coli% + Ptr, 1, 6, 7
	ELSE
	    LOCATE row, Coli% + Ptr, 1, 1, 7
	END IF
	 
	kee = ScanCode
	SELECT CASE kee
	    CASE INSERTKEY
		IF insirt THEN
		    insirt = FALSE
		ELSE
		    insirt = TRUE
		END IF
	    CASE BACKSPACE
		IF Ptr THEN
		    a$ = a$ + CHR$(Ascii)
		    a$ = LEFT$(a$, Ptr - 1) + MID$(a$, Ptr + 1)
		    Ptr = Ptr - 1
		END IF
	    CASE DELETEKEY
		a$ = a$ + CHR$(Ascii)
		a$ = LEFT$(a$, Ptr) + MID$(a$, Ptr + 2)
	    CASE UPARROW
		ExitCode = 1
		quit = TRUE
	    CASE DOWNARROW
		ExitCode = -1
		quit = TRUE
	    CASE LEFTARROW
		IF Ptr THEN
		    Ptr = Ptr - 1
		END IF
	    CASE RIGHTARROW
		IF Ptr < length - 1 THEN
		    Ptr = Ptr + 1
		END IF
	    CASE ENTER
		a$ = LEFT$(a$, Ptr)
		ExitCode = 0
		quit = TRUE
	    CASE HOME
		Ptr = 0
	    CASE ENDKEY
		Ptr = lengte + LEN(RTRIM$(a$))
	    CASE CTRLRIGHTARROW
		DO UNTIL MID$(a$, Ptr + 1, 1) = " " OR Ptr = length - 1
		    Ptr = Ptr + 1
		LOOP
		DO UNTIL MID$(a$, Ptr + 1, 1) <> " " OR Ptr = length - 1
		    Ptr = Ptr + 1
		LOOP
	    CASE CTRLLEFTARROW
		DO UNTIL MID$(a$, Ptr + 1, 1) = " " OR Ptr = 0
		    Ptr = Ptr - 1
		LOOP
		DO UNTIL MID$(a$, Ptr + 1, 1) <> " " OR Ptr = 0
		    Ptr = Ptr - 1
		LOOP
		DO UNTIL MID$(a$, Ptr + 1, 1) = " " OR Ptr = 0
		    Ptr = Ptr - 1
		LOOP
		IF Ptr THEN
		    Ptr = Ptr + 1
		END IF
	    CASE CTRLY
		a$ = SPACE$(length)
		Ptr = 0
	    CASE ESCAPE
		a$ = original$
		Ptr = 0
		insirt = TRUE
	    CASE IS > 255
				
	    CASE IS < 32
		
	    CASE ELSE
		kee$ = CHR$(kee)
		IF insirt THEN
		    a$ = LEFT$(a$, Ptr) + kee$ + MID$(a$, Ptr + 1)
		    a$ = LEFT$(a$, length)
		ELSEIF Ptr < length THEN
		    MID$(a$, Ptr + 1, 1) = kee$
		END IF
		IF Ptr < length THEN
		    Ptr = Ptr + 1
		ELSE
		
		END IF
		ctrlQflag = FALSE
	END SELECT
    LOOP UNTIL quit
a$ = a$

END SUB

 SUB expand (UpRow%, LtColum%, LoRow%, RtColum%) STATIC
    RowCenter% = ((LoRow% - UpRow%) / 2) + UpRow%
    ColCenter% = ((RtColum% - LtColum%) / 2) + LtColum%
    UprRow% = RowCenter%: LeftColum% = ColCenter%
    LwrRow% = RowCenter%: RghtColum% = ColCenter%
    DO
	LeftColum% = LeftColum% - 1
	RghtColum% = RghtColum% + 1
	IF LeftColum% < LtColum% THEN LeftColum% = LtColum%
	IF RghtColum% > RtColum% THEN RghtColum% = RtColum%
	Drawbox UprRow%, LeftColum%, LwrRow%, RghtColum%
	IF LeftColum% = LtColum% AND RghtColum% = RtColum% THEN EXIT DO
    LOOP
    DO
	UprRow% = UprRow% - 1
	LwrRow% = LwrRow% + 1
	IF UprRow% < UpRow% THEN UprRow% = UpRow%
	IF LwrRow% >= LoRow% THEN LwrRow% = LoRow%
	Drawbox UprRow%, LeftColum%, LwrRow%, RghtColum%
	IF UprRow% = UpRow% AND LwrRow% = LoRow% THEN EXIT DO
	pause 1
    LOOP
    Shadow UpRow%, LtColum%, LoRow%, RtColum%
 END SUB

DEFINT A-Z
SUB FileRead (filename$, LIneCount%, VNaam$(), ANaam$(), Straat$(), Hnummer$(), PCode$(), Tel$(), Stad$(), GDatum$(), Extra1$(), Extra2$()) STATIC
 filenumber% = FREEFILE
 OPEN filename$ FOR INPUT AS filenumber%
 IF LOF(1) <= 10 THEN GOTO theend
 DO
  LIneCount% = LIneCount% + 1
  l% = LIneCount%
  INPUT #filenumber%, VNaam$(l%), ANaam$(l%), Straat$(l%), Hnummer$(l%), PCode$(l%), Stad$(l%), Tel$(l%), GDatum$(l%), Extra1$(l%), Extra2$(l%)
		  
 LOOP UNTIL EOF(1)
theend:
CLOSE
EXIT SUB
 
END SUB

DEFSNG A-Z
SUB info.MrSnow STATIC
CLS
COLOR 14, 1
expand 1, 1, 24, 78
LOCATE 1, 33: PRINT "[ MrSnow '95 ]"
LOCATE 7, 10: PRINT "Things that I have Made in QuickBasic '4.5'"
LOCATE 8, 10: PRINT "--------------------------------------------"
LOCATE 9, 10: PRINT "PICME.EXE <-- GIF/PCX Viewer"
LOCATE 10, 10: PRINT "PCX2GIF.EXE <-- PCX to GIF converter"
LOCATE 11, 10: PRINT "REBOOT.EXE <-- Nice REBOOT programm"
LOCATE 12, 10: PRINT "FASTVIEW.EXE <-- Fast TEXT file viewer"
LOCATE 13, 10: PRINT "QSyS.EXE <-- QuickSySinformation "
LOCATE 14, 10: PRINT "TXT2BAS.EXE <-- Converts a TXT file to .BAS file+Viewer"
LOCATE 15, 10: PRINT "CD_INST.EXE <-- CD-ROM Installer '95"
LOCATE 16, 10: PRINT "TCP.QLB/LIB <-- Nice Quickbasic Libery"
LOCATE 18, 10: PRINT "Ect,Ect I have made much more"
LOCATE 22, 20: PRINT "Press 'Q' to Return to the menu ..."
COLOR 7, 1
DO
LOOP UNTIL UCASE$(INKEY$) = CHR$(81)

END SUB

SUB inFO.Prog STATIC
CLS
COLOR 14, 1
expand 1, 1, 18, 78
LOCATE 1, 33: PRINT "[ ADRES.EXE ]"
LOCATE 5, 10: PRINT "Made on 1995-8-27/28"
LOCATE 6, 10: PRINT "This programm is made by: Mr. Snow"
LOCATE 7, 10: PRINT "It's made in QuickBasic 4.5"
LOCATE 8, 10: PRINT "On a BAD Day"
LOCATE 10, 10: PRINT "INclude Files are:"
LOCATE 11, 28: PRINT "ADRES.EXE"
LOCATE 12, 28: PRINT "ADRES.DAT "
LOCATE 13, 28: PRINT "ADRES.LST"
LOCATE 16, 20: PRINT "Press 'Q' to Return to the menu ..."
DO
LOOP UNTIL UCASE$(INKEY$) = CHR$(81)
COLOR 7, 1
END SUB

SUB inPutFile (laatste%) STATIC
b$ = "                    "
ON KEY(9) GOSUB neetoch
KEY(9) ON
'<-- Met EDitLine of LineEdit ??? >>092ouldhekurdkj7y857rq8_*&(@^JDGHUFD"
t% = laatste%
expand 1, 1, 15, 50
LOCATE 1, 51: PRINT "F9 to Abort"
LOCATE 3, 5: PRINT "VoorNaam :";
VNaam$(t%) = ED$(14, 0, 7, 1)
LOCATE 4, 5: PRINT "AchterNaam :";
ANaam$(t%) = ED$(14, 0, 7, 1)
LOCATE 5, 5: PRINT "Straat :";
Straat$(t%) = ED$(14, 0, 7, 1)
LOCATE 6, 5: PRINT "HuisNummer :";
Hnummer$(t%) = ED$(14, 0, 7, 1)
LOCATE 7, 5: PRINT "PostCode :";
PCode$(t%) = ED$(14, 0, 7, 1)
LOCATE 8, 5: PRINT "Plaats (Stad) :";
Stad$(t%) = ED$(14, 0, 7, 1)
LOCATE 9, 5: PRINT "Telefoon :";
Tel$(t%) = ED$(14, 0, 7, 1)
LOCATE 10, 5: PRINT "GeboorteDatum :";
GDatum$(t%) = ED$(14, 0, 7, 1)
LOCATE 12, 5: PRINT "EXtra: ";
Extra1$(t%) = ED$(14, 0, 7, 1)
LOCATE 13, 5: PRINT "EXtra: ";
Extra2$(t%) = ED$(14, 0, 7, 1)
OPEN "ADRES.DAT" FOR APPEND AS #1

WRITE #1, VNaam$(t%), ANaam$(t%), Straat$(t%), Hnummer$(t%), PCode$(t%), Stad$(t%), Tel$(t%), GDatum$(t%), Extra1$(t%), Extra2$(t%)
CLOSE 1

OPEN "ADRES.LST" FOR APPEND AS #1
WRITE #1, VNaam$(t%), ANaam$(t%)
CLOSE
CLS

END SUB

DEFINT A-Z
SUB KeuseLijst STATIC
DIM aDres$(1500), BackADRES$(1500)
OPEN LST$ FOR INPUT AS #1
i = LOF(1)
CLOSE 1
IF i <= 8 THEN LOCATE 20, 20: PRINT "NO Adresses Found !": CALL NewDataFIle
OPEN LST$ FOR INPUT AS #1

l% = 10

DO
l% = l% + 1
INPUT #1, aDres$(l%), BackADRES$(l%)
LOOP UNTIL EOF(1)
CLOSE 1

FOR b = l% + 1 TO l% + 15
aDres$(b) = "": BackADRES$(b) = ""
NEXT b
Show.KeuseLijst aDres$(), BackADRES$(), l%
EXIT SUB

END SUB

FUNCTION keycode% STATIC
 DO
 k$ = INKEY$
 LOOP UNTIL k$ <> ""
 keycode% = CVI(k$ + CHR$(0))
END FUNCTION

DEFSNG A-Z
SUB NewDataFIle
OPEN "ADRES.DAT" FOR OUTPUT AS #9
OPEN LST$ FOR OUTPUT AS #10
    ' VNaam$(t%), ANaam$(t%),    Straat$(t%), Hnummer$(t%), PCode$(t%), Stad$(t%), tel$(t%), GDatum$(t%), Extra1$(t%), Extra2$(t%)
WRITE #9, "Mr.", "Snow", "Heaven", "102", "9736 AD", "Holland", "06-9666", "1980-7-3", "From Xtance Coders All-", "iance 1997"

WRITE #10, "Mr.", "Snow"
CLOSE 9, 10

END SUB

SUB noBackup
expand 4, 5, 13, 75
LOCATE 6, 15: PRINT "You don't have made any BACKUP!!"
LOCATE 8, 15: PRINT "Sleep tyde and you better can "
LOCATE 9, 15: PRINT "Think first....."
LOCATE 11, 15: PRINT "Press [Enter] to return to the menu.."
DO: LOOP UNTIL INKEY$ = CHR$(13)
CLOSE

END SUB

SUB NOFilesFound
expand 4, 5, 13, 75
LOCATE 6, 15: PRINT "Can't Finde one of the FIles to Backup"
LOCATE 8, 15: PRINT "Files: ADRES.DAT ADRES.LST ADRES.EXE"
LOCATE 9, 15: PRINT "Think first....."
LOCATE 11, 15: PRINT "Press [Enter] to return to the menu.."
DO: LOOP UNTIL INKEY$ = CHR$(13)
CLOSE

END SUB

 SUB pause (ticks%) STATIC
    DEF SEG = 0
    DO UNTIL TestTick% > ticks%
	IF LEN(INKEY$) THEN EXIT SUB
	LastTick% = GetTick%
	GetTick% = PEEK(&H46C)
	IF LastTick% <> GetTick% THEN
	    TestTick% = TestTick% + 1
	END IF
    LOOP


    DEF SEG
 END SUB

SUB Reg
END SUB

SUB RESTOREBackup
ON ERROR GOTO Existfout
'(Bestand1$, Bestand2$, FileCopyShow%, Regel%, Waar%, BKleur%, FKleur%, Car%)
a = CHeckBestand("ADRES.BAK\ADRES.DAT")
b = CHeckBestand("ADRES.BAK\ADRES.EXE")
c = CHeckBestand("ADRES.BAK\ADRES.LST")
IF a = 0 OR b = 0 OR c = 0 THEN CALL noBackup
IF a = 0 OR b = 0 OR c = 0 THEN EXIT SUB

expand 4, 5, 10, 75
LOCATE 4, 35: PRINT "[ RESTORE ]"

CHDIR "ADRES.BAK"
CHDIR ".."


Copy "ADRES.BAK\ADRES.DAT", "ADRES.DAT", 1, 7, 15, 7, 1, 254
Copy "ADRES.BAK\ADRES.LST", LST$, 1, 7, 15, 7, 1, 254
Copy "ADRES.BAK\ADRES.EXE", "ADRES.EXE", 1, 7, 15, 7, 1, 254

ON ERROR GOTO fout
END SUB

FUNCTION ScanCode STATIC
    DO
	a$ = INKEY$
    LOOP WHILE a$ = ""
    IF ASC(LEFT$(a$, 1)) = 0 THEN
	ScanCode = -ASC(RIGHT$(a$, 1))
    ELSE
	ScanCode = ASC(a$)
    END IF
END FUNCTION

 SUB Shadow (UpRow%, LtColum%, LoRow%, RtColum%) STATIC
    DEF SEG = &H40
    mono% = PEEK(&H10)
    IF (mono% AND 48) = 48 THEN
	EXIT SUB            '*** Forget the Shadow if it's monochrome.
    ELSE
	DEF SEG = &HB800
    END IF

 attr% = SCREEN(LoRow% + 1, RtColum% + 1, -1)  ' Get the attribute.
    attr% = attr% AND 15                     ' Calculate forground.
    attr% = attr% - 8                        ' Remove bright.
    IF attr% < 1 THEN attr% = 8              ' In case color wasn't bright.


    FOR row% = UpRow% + 1 TO LoRow% + 1       '***** right edge locations.
	FOR Colum% = RtColum% + 1 TO RtColum% + 2   '***** make it 2 chars Wide.
	    offset% = (row% - 1) * 160 + (Colum% - 1) * 2 + 1
	    POKE offset%, attr%
	NEXT
    NEXT
    row% = LoRow% + 1                        '***** now POKE along the
    FOR Colum% = LtColum% + 2 TO RtColum% + 2      '***** bottom edge
	offset% = (row% - 1) * 160 + (Colum% - 1) * 2 + 1
	POKE offset%, attr%
    NEXT
    DEF SEG
 END SUB

DEFINT A-Z
SUB Show.KeuseLijst (aDres$(), BackADRES$(), til) STATIC
IF til = 0 THEN PRINT "NO ADresses": SLEEP 2: EXIT SUB
'IF Til < 11 THEN Til = Til
Begin:
BKleur = 7: FKleur = 1
COLOR BKleur, FKleur
CLSScreen

StartFile = 1 '2

StartOver:
CLSScreen
GOSUB lijn
GOSUB FilePRintLinks


StartToets:
LOCATE 5, 10: PRINT "["; til - 10; "Adresses Found ]"

LOCATE , , 0
DO
a$ = INKEY$
LOOP UNTIL a$ <> ""
'PRINT a$: END
SELECT CASE UCASE$(a$)
CASE CHR$(8)

IF LEN(Toetsen$) > 0 THEN
Toetsen$ = LEFT$(Toetsen$, LEN(Toetsen$) - 1)
END IF

CASE CHR$(13) '<--- Enter
ShowFile TagFIle
GOTO StartOver

CASE CHR$(27)        '<--- Esc
Toetsen$ = ""
LOCATE 23, 2: PRINT STRING$(30, 205); '<--- HELUPPPP
a$ = ""

CASE CHR$(0) + ";" '<-- F1
inPutFile til + 1 - 10
KeuseLijst

CASE CHR$(0) + "<" '<-- F2
expand 10, 20, 15, 60
LOCATE 11, 25: PRINT "Kill the DATA from:"
LOCATE 12, 30: PRINT "--> "; tagBack$; " "; tag$; "<--"
LOCATE 14, 27: PRINT "Keuse [Y/N]:";
DO: a$ = INKEY$: LOOP UNTIL a$ <> ""
PRINT UCASE$(a$)
IF UCASE$(a$) = "Y" OR UCASE$(a$) = "J" THEN
CALL DeleteAdres(TagFIle, til - 10)
CALL DeleteAdres.Lijst(TagFIle, til - 10)
KeuseLijst
ELSE
GOTO StartOver

END IF

CASE CHR$(0) + "=" '<-- F3
expand 9, 20, 11, 60
LOCATE 10, 23: PRINT "Realy! (Kill the LIST) [Y/N]: ";
DO: a$ = INKEY$: LOOP UNTIL a$ <> ""
IF UCASE$(a$) = "Y" OR UCASE$(a$) = "J" THEN
KILL "ADres.DAT": KILL "ADRES.LST"
NewDataFIle
KeuseLijst
ELSE
GOTO Begin
END IF

CASE CHR$(0) + ">"
Backup
GOTO Begin

CASE CHR$(0) + "?" '<-- F5
RESTOREBackup
CALL KeuseLijst

CASE CHR$(0) + "@" '<-- F6
inFO.Prog
GOTO StartOver

CASE CHR$(0) + "A"'<-- F7
info.MrSnow
GOTO StartOver

CASE CHR$(0) + "B" '<-- F8
COLOR 7, 0: CLS
PRINT "Type EXIT to return to the menu ..."
SHELL
CALL CheckShell
KeuseLijst

CASE CHR$(0) + "D" '<-- F10
COLOR 7, 0
CLS : PRINT "Thanks for using ADRES.EXE by Mr. Snow"
Reg
END
		    

CASE CHR$(0) + "P"
o = StartFile
StartFile = StartFile + 1
IF StartFile > til - 10 THEN StartFile = til - 10


CASE CHR$(0) + "H"
o = StartFile
StartFile = StartFile - 1
IF StartFile < 1 THEN StartFile = 1

CASE ELSE
o = StartFile
END SELECT
IF o <> StartFile THEN GOSUB FilePRintLinks
GOTO StartToets






FilePRintLinks:
COLOR 4, 7
LOCATE 10, 2: PRINT " --->                             <---"

COLOR BKleur, FKleur

FOR i = 7 TO 21
IF i = 10 THEN COLOR 4, 7 ELSE COLOR 7, 1
LOCATE i, 8: PRINT SPC(28);
LOCATE i, 8: PRINT aDres$(StartFile + i); " "; BackADRES$(StartFile + i)

IF i = 10 THEN tag$ = aDres$(StartFile + i): tagBack$ = BackADRES$(StartFile + i)
IF i = 10 THEN TagFIle = StartFile + i - 10

NEXT i
RETURN

lijn:
LOCATE , , 0
COLOR BKleur, FKleur
FOR lijn = 6 TO 23
LOCATE lijn, 1: PRINT CHR$(179); SPC(38); CHR$(179);
NEXT lijn

LOCATE 5, 1: PRINT CHR$(213); STRING$(38, 205); CHR$(184);
LOCATE 23, 1: PRINT CHR$(212); STRING$(38, 205); CHR$(190);
LOCATE 1, 1: PRINT CHR$(213); STRING$(78, 205); CHR$(184);
FOR lijn = 2 TO 3
LOCATE lijn, 1: PRINT CHR$(179); SPC(78); CHR$(179);
NEXT lijn

LOCATE 4, 1: PRINT CHR$(212); STRING$(78, 205); CHR$(190);

COLOR 0, 0
LOCATE 25, 1: PRINT SPACE$(80);
COLOR BKleur, FKleur
LOCATE 1, 30: PRINT "[ Done by MrSnow '95 ]"
LOCATE 7, 50: PRINT "F1 - Input new adres"
LOCATE 8, 50: PRINT "F2 - Remove adres"
LOCATE 9, 50: PRINT "F3 - Clear List"
LOCATE 10, 50: PRINT "F4 - Make BACKup of LIST"
LOCATE 11, 50: PRINT "F5 - REstore BACKup of LIST"
LOCATE 12, 50: PRINT "F6 - Info About Programm"
LOCATE 13, 50: PRINT "F7 - Info About MrSnow '95"
LOCATE 14, 50: PRINT "F8 - Shell to Dos"

LOCATE 17, 50: PRINT "F10 - Exit Menu"
COLOR BKleur, 0
RETURN


END SUB

DEFSNG A-Z
SUB ShowFile (t%) STATIC
COLOR 7, 1
OPEN "ADRES.DAT" FOR INPUT AS #1

FOR i = 1 TO t% - 1
INPUT #1, VNaam$(t%), ANaam$(t%), Straat$(t%), Hnummer$(t%), PCode$(t%), Stad$(t%), Tel$(t%), GDatum$(t%), Extra1$(t%), Extra2$(t%)
NEXT i
INPUT #1, VNaam$(t%), ANaam$(t%), Straat$(t%), Hnummer$(t%), PCode$(t%), Stad$(t%), Tel$(t%), GDatum$(t%), Extra1$(t%), Extra2$(t%)
CLOSE 1
expand 5, 8, 20, 55
LOCATE 6, 10: PRINT "VoorNaam :";
CALL COL(14, 1, VNaam$(t%), 7, 1)
LOCATE 7, 10: PRINT "AchterNaam :";
CALL COL(14, 1, ANaam$(t%), 7, 1)
LOCATE 8, 10: PRINT "Straat :";
CALL COL(14, 1, Straat$(t%), 7, 1)
LOCATE 9, 10: PRINT "HuisNummer :";
CALL COL(14, 1, Hnummer$(t%), 7, 1)
LOCATE 10, 10: PRINT "PostCode :";
CALL COL(14, 1, PCode$(t%), 7, 1)
LOCATE 11, 10: PRINT "Plaats (Stad) :";
CALL COL(14, 1, Stad$(t%), 7, 1)
LOCATE 12, 10: PRINT "TeleFoon :";
CALL COL(14, 1, Tel$(t%), 7, 1)
LOCATE 13, 10: PRINT "GeboorteDatum :";
CALL COL(14, 1, GDatum$(t%), 7, 1)

LOCATE 15, 10: PRINT "Extra :";
CALL COL(14, 1, Extra1$(t%), 7, 1)
LOCATE 16, 10: PRINT "Extra :";
CALL COL(14, 1, Extra2$(t%), 7, 1)

LOCATE 18, 10: PRINT "Press [Enter] to return to the ADRES Menu"
DO: LOOP UNTIL INKEY$ = CHR$(13)
END SUB