Stap 9: Bulletin board systeem.
[code]
GEMEENSCHAPPELIJKE gedeelde Car.ret, Car.ret$, Lfeed, Lfeed$, Mod.dem, Console
DECLARE SUB vertraging (SEC!)
DECLARE SUB Lout (l$, Cr!)
CONST onwaar = 0
CONST True = -1
' ****************************************************************************
' Lizzybbs versie 0,00001
' main.loop geschreven door computothought
' sommige gegevens input routines geleend van het dumbbs-programma
' laatste wijziging 02/06/95
Start.Program:
GOSUB huishouding
TERWIJL niet gedaan
GOSUB The.main.loop
WEND
GOSUB end.of.job
EINDE
' *****************************************************************************
' Subroutines
' -----------------------------------------------------------------------------
huishouden:
CLS
SLUITEN
= 0
Cdmask = & H80
Vervoerder = 0
' Status poorten moet Com1 = 3fe en Com2 = 2fe (? f8 + 6)
Rs232.Port = & H3FE: ' & H3F8 + 6
Mod.DEM = 1
Console = 2
Poort van $ = "COM1:"
Baud$ = "300",
Stromen van $ = "N 8, 1": ", DS0"
Minuten = 60
Char.Wait.time = 4 * minuut
Char.Grace.time = 1 * minuut
Lin.length = 40
Q$ = CHR$(34)
Bell$ = CHR$(7)
Car.Ret = 13
Car.Ret$ = CHR$(Car.ret)
Lfeed = 10
Lfeed$ = CHR$(Lfeed)
' ------------------------------------------------
' select.baud - Selecteer de baud-rate
Com.spec$ = poort$ + Baud$ + Flow$
' ----------------------------------------------
' open communicatielijnen
OPEN Com.spec$ voor willekeurige AS #Mod.dem
GOSUB pauze
OPEN "scrn:" voor de OUTPUT AS #Console
AFDRUKKEN
' ---------------------------------------------
' Opnieuw het werk logboekbestand
OPEN "toevoegen", #5, "worklog"
PRINT #5, "Start van baan", $ van de tijd, datum$
NAUWE #5
TERUGKEER
' ------------------------------------------------
' gchar - krijgen een teken
Gchar:
Char.timeout = False
Charet = 0
T = TIMER
DOEN
ZONIET dan EOF(Mod.dem)
Clizzyied$ INPUT$ (1, #Mod.dem) =
C = ASC(Clizzyied$)
PRINT #Mod.dem, CHR$(C);
ALS C <> 8 dan
PRINT #Console, CHR$(C);
ANDERS
PRINT #Console, CHR$(29);
END IF
Charet = 1
END IF
GOSUB Carchek
LUS tot TIMER > T + Char.wait.time of Charet = 1 "of" vervoerder = False
Als TIMER > T + Char.wait.time dan
a$ = Car.ret$ + Lfeed Bell$, $ + Bell$
a$ a$ = + "Deze BBS zal ophangen als u niet op een toets drukt."
OPROEP Lout (een$, True)
Schending = 2
Char.timeout = True
C = 256
END IF
TERUGKEER
' ----------------------------------------------------
' gline - krijgen een lijn
Gline:
In.line$ = ""
GOSUB Clear.garbage
DOEN
GOSUB Gchar
SELECTEER ZAAK C
GEVAL IS > 255, Car.ret
REM
ZAAK 29, 8
In.line$ = links$ (In.line$, LEN(In.line$) - 1)
GEVAL ANDERS
In.Line$ = In.line$ + CHR$(C)
EINDE SELECTEREN
LOOP tot en met LEN(In.line$) > Lin.length OR (C = Car.ret en LEN(In.line$) > 0) of C > 255 "of" vervoerder = False
TERUGKEER
' -------------------------------------------------------------------------
' Dtrlow
Dtrlow:
PRINT #Mod.dem, "ATH0"
GOSUB pauze
PRINT #Mod.dem, "ATZ"
GOSUB pauze
TERUGKEER
' --------------------------------------------------------------------------
' Dtrhi
Dtrhi:
PRINT #Mod.dem, "ATE0M0S0 = 1 & C1"
GOSUB pauze
TERUGKEER
' ----------------------------------------------------------
' bestand downloaden
File.Download:
Dload.item$ = ""
DO WHILE UCASE$(Dload.item$) <> "0"
$ Usefile = "dir.fil"
GOSUB File.display
GOSUB Clear.garbage
GOSUB Gchar
Dload.item$ = UCASE$(CHR$(C))
TERWIJL Dload.item$ < = "Z" en Dload.item$ > = "A"
OPROEP Lout ("Gelieve uw buffer nu openen, dan pers ieder toonsoort!", True)
GOSUB File.display
GOSUB Clear.garbage
GOSUB Gchar
$ Usefile = "\ul\dload" + CHR$(C)
GOSUB File.display
OPROEP Lout ("Gelieve uw buffer nu sluiten, dan pers ieder toonsoort!", True)
GOSUB Clear.garbage
GOSUB Gchar
LOOP
ALS drager = False of Char.timeout dan EXIT doen
LOOP
TERUGKEER
' ----------------------------------------------------------
' bulletin weergeven
bulletins:
Bullet.item$ = ""
DO WHILE UCASE$(Bullet.item$) <> "Q"
$ Usefile = "poster"
GOSUB File.display
OPROEP Lout ("Voer keuze:", False)
GOSUB Clear.garbage
GOSUB Gchar
Bullet.item$ = UCASE$(CHR$(C))
OPROEP Lout ("", True)
DO WHILE C > 48 en C < 57
Usefile$ Usefile$ + Bullet.item$ =
GOSUB File.display
C = 256
LOOP
ALS drager = False of Char.timeout dan EXIT doen
LOOP
TERUGKEER
' ----------------------------------------------------------
' nieuwe gebruiker routine
New.User:
$ Usefile = "newuser"
GOSUB File.display
OPROEP Lout ("Voer een uniek wachtwoord:", False)
GOSUB Gline
OPROEP Lout ("", True)
Pass.in$ = In.line$
NAUWE #4
DODEN "userfile.old"
NAAM "userfile" als "userfile.old"
OPEN "O", #6, "userfile"
Status = 4
PRINT #6, Q$; Log.name$; Q$; ","; Q$; Pass.in$; Q$; ","; Status; ","; Q$; Time.in$; Q$
NAUWE #6
OPEN "I", #7, "userfile.old"
OPEN "A", #8, "userfile"
DO WHILE NIET EOF(7)
INPUT #7, een$, B$, C, D$
PRINT #8, Q$; a$; Q$; ","; Q$; B$; Q$; ","; C; ","; Q$; D$; Q$
Als een$ = "END" dan EXIT doen
LOOP
NAUWE #7
NAUWE #8
TERUGKEER
' ---------------------------------------------------------
' file.display
File.display:
OPEN "I", #3, Usefile$
TERWIJL NIET EOF(3)
LINE INPUT #3, data.in$
OPROEP Lout (data.in$, True)
WEND
NAUWE #3
TERUGKEER
' =========================================================
' De hoofdlus
'
' Dit is waar de 'BBS' eigenlijk begint.
'
The.Main.loop:
Opnieuw opstarten:
WEERGEVEN AFDRUKKEN
GOSUB Dtrlow
GOSUB Dtrhi
CLS
AFDRUKKEN
LOCATE 2, 30: Afdrukken "lizzyied BBS versie 0,001"
AFDRUKKEN
Wait.for.ring:
DOEN
C = 256
ZOEK 3, 30
AFDRUKDATUM$; " "; TIJD$
ZOEK 4, 30
PRINT "Rs232:"; INP(Rs232.Port)
GOSUB Carchek
LUS tot Carrier
' -----------------------------------------------------
' start
Mainloop:
WEERGEVEN AFDRUKKEN 6 TOT EN MET 25
GOSUB Clear.garbage
AFDRUKKEN
' -----------------------------------------------------
' kop
$ Usefile = "prelog"
GOSUB File.display
' -----------------------------------------------------
' aanmelding
aanmelden:
Time.in$ = tijd$
Juridische = False
OPROEP Lout ("Voer uw naam in:", False)
GOSUB Gline
Log.name$ = In.line$
OPROEP Lout ("", True)
NAUWE #4
OPEN "I", #4, "userfile"
DO WHILE NIET EOF(4)
INPUT #4, Name.in$, Pass.in$, Status, Start$
IF UCASE$(Name.in$) = UCASE$(Log.name$) of Name.in$ = "END" dan EXIT doen
LOOP
IF Name.in$ = "END" THEN
GOSUB New.user
ANDERS
FOR xdummy = 1 tot en met 3
OPROEP Lout ("wachtwoord:", False)
GOSUB Gline
Pass.Word$ = ""
Pass.Word$ = In.line$
OPROEP Lout ("", True)
IF Pass.word$ = Pass.in$ THEN
AFSLUITEN VOOR
ELSEIF ((Pass.word$ <> Pass.in$) en (xdummy > 3)) dan
schenden = 1
GOTO afmelden
END IF
VOLGENDE xdummy
END IF
NAUWE #4
' -----------------------------------------------------
' belangrijkste
menu.item$ = ""
DO WHILE UCASE$(menu.item$) <> "G"
$ Usefile = "post2"
GOSUB File.display
OPROEP Lout ("", True)
OPROEP Lout ("uw keuze:", False)
GOSUB Clear.garbage
GOSUB Gchar
menu.item$ = UCASE$(CHR$(C))
OPROEP Lout ("", True)
SELECT CASE menu.item$
CASE "D"
GOSUB file.download
CASE "B"
GOSUB bulletins
GEVAL VAN "G"
schenden = 0
EINDE SELECTEREN
ALS drager = False of Char.timeout dan EXIT doen
LOOP
' -----------------------------------------------------
' voettekst
$ Usefile = "epilog"
GOSUB File.display
' -----------------------------------------------------
' onderbreken
pauze:
VOOR x = 1 tot 4000
VOLGENDE x
TERUGKEER
' -----------------------------------------------------
' afmelden
Afmelden:
OPEN "toevoegen", #5, "worklog"
PRINT #5, Name.in$, Pass.word$, Time.in$, tijd$, schenden
NAUWE #5
a$ = "Afmelden"
OPROEP Lout (een$, True)
a$ = "+++"
OPROEP Lout (een$, True)
T = TIMER
DOEN
LUS tot TIMER > 4 + T
PRINT "Turning DTR laag"
GOSUB Dtrlow
OPROEP delay(2)
PRINT "Bringing DTR hoog"
GOSUB Dtrhi
OPROEP delay(2)
TERUGKEER
' ------------------------------------------------------
Carchek:
CC = (INP(Rs232.port) en Cdmask)
ALS CC = 128 THEN
Vervoerder = True
ANDERS
Vervoerder = False
END IF
TERUGKEER
' ------------------------------------------------------
Clear.garbage:
ZONIET DAN EOF(1)
DOEN
Clizzyied$ INPUT$ (1, #Mod.dem) =
LUS tot EOF(Mod.dem)
END IF
TERUGKEER
' ------------------------------------------------------
End.of.job:
OPEN "toevoegen", #5, "worklog"
PRINT #5, "End of gebruik", $ van de tijd, datum$
NAUWE #5
SLUITEN
TERUGKEER
' ===========================================================================
SUB vertraging (SEC)
' ------------------------------------------------
' vertraging - wacht zoveel seconden
vertraging (SEC):
T1 = TIMER
DOEN
LUS tot TIMER > 40 + T1
END SUB
SUB flush (keer)
' ----------------------------------------------------
' flush - buffer leegmaken
T = TIMER
DOEN
ZONIET dan EOF(Mod.dem)
Dummy van $ = INPUT$(LOF(Mod.dem), #Mod.dem)
END IF
LUS tot TIMER > T + tijd
END SUB
SUB Lout (l$, Cr)
' ---------------------------------------------------
' lout - lijnuitgang
FOR j = 1 TO LEN(l$)
G = ASC (MID$ (l$, j, 1))
PRINT #Mod.dem, CHR$(G);
PRINT #Console, CHR$(G);
VOLGENDE j
ALS Cr vervolgens
PRINT #Mod.dem, Car.ret$; Lfeed$
PRINT #Console, Car.ret$;
END IF
END SUB
[/ code]