10REM > IDstamp 1.10
20REM User I.D. Stamper for
30REM "I.D. ***" 8BS issues
40REM written 10/9/97
50REM (c) 3 Spaceman (E3Y)
60REM (c) DataDream FreeWare
70REM Tell all your friends!
80REM Fixed by JGH - K8G
90MODE7
100ONERRORPROCE
110REM *FX4,2
120PRINT
130FORP%=0TO1
140PRINTCHR$(129+P%*4)CHR$141"8BS User
I.D. Stamper"
150NEXT
160PRINT" By 3 Spaceman (E3Y)"
170PRINT'" Please enter your user I.D
.: ***"
180VDU31,31,5
190ID$="":REPEATL%=LENID$:G%=GET
200IF(G%>47ANDG%<58ORG%>64ANDG%<91)AND
L%<3VDUG%:ID$=ID$+CHR$G%
210IFG%=127ANDL%>0VDU8,42,8:ID$=LEFT$(
ID$,L%-1)
220UNTILG%=13ANDL%=3
230VDU28,0,24,39,7
240*DIR$
250REM *OPT1,2
260REM A%=135
270CLS
280PRINT" Please insert 8BS issue dis
c to be"'" I.D. stamped."
290PRINT" ENSURE WRITE-PROTECT LATCH
IS CLOSED!"
300PROCK
310ONERRORGOTO340
320*MOUNT0
330GOTO350
340*DRIVE0
350ONERRORPROCE
360REM *LOAD!Boot 2000 --> What happe
ns if program/vars are here?
370out%=OPENUP("!Boot"):PTR#out%=&2F
380REM IF?&202F<>42OR?&2030<>42OR?&203
1<>42PRINT'" THIS IS EITHER NOT AN 8BS
ISSUE DISC OR IT ALREADY HAS AN I.D.
STAMP!":PROCK:GOTO270
390IF BGET#out%<>42 OR BGET#out%<>42 O
R BGET#out%<>42:PRINT'" THIS IS EITHER
NOT AN 8BS ISSUE DISC OR IT ALREADY H
AS AN I.D. STAMP!":CLOSE#out%:out%=0:PRO
CK:GOTO270
400REM l$=""
410PTR#out%=&2F
420REM FORX%=30TO33 --> What happe
ns if length is not there?
430REM VDU31,X%,5:C%=(USR(&FFF4)AND&FF
FF)DIV&100
440REM l$=l$+CHR$C% --> Ie, with A
DFS, HADFS, NFS, CoProFS, RamFS
450REM NEXT --> Ie, anythi
ng other than DFS
460FORW%=1TO3
470REM ?(&202E+W%)=ASCMID$(ID$,W%,1)
480BPUT#out%,ASCMID$(ID$,W%,1)
490NEXT:CLOSE#out%:out%=0
500PRINT
510REM PROCO("SAVE!Boot 2000+"+l$+" FF
802B FF0E00") <-- Why not FFFF802B ?
520PRINT''" All done."'" PLEASE OPEN
WRITE-PROTECT LATCH AGAIN."
530PRINT'" Another (Y/N)?";
540REPEATI%=INSTR("YyNn",GET$):UNTILI%
550IFI%<3GOTO270
560PRINT'" Have a nice day!"'
570*FX4
580END
590DEFPROCE
600PRINT'
610IFERR=201PRINT"SHUT THE WRITE-PROTE
CT LATCH!!":PROCK:GOTO270
620IFERR=214PRINT"THIS DISC HAS NO ""!
BOOT"" FILE!":PROCK:GOTO270
630IFERR=195PRINT"THE ""!BOOT"" FILE O
N THIS DISC IS LOCKED!":PROCK:GOTO270
640REPORT:PRINT" @ ";ERL
650END
660DEFPROCK
670PRINT'" Press a key...";:G%=GET
680PRINT:ENDPROC
690DEFPROCO($&900)
700X%=0:Y%=9:CALL&FFF7
710ENDPROC