Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : TURBBS-2.ZIP
Filename : BBS.PRG
frame = chr(201) + chr(205) + chr(187) + chr(186) + chr(188) +;
chr(205) + chr(200) + chr(186) + chr(32)
set safety off
set talk off
set scoreboard off
intvar = handles()
if pcount() > 0
if upper(setmode) = 'S'
do setup
endif
endif
*if (val(substr(time(),1,2)) > 2) .and. (val(substr(time(),1,2)) < 6)
* do readfidomail
*endif
set safety off
set talk off
set scoreboard off
dclear = clear()
do openscreen
if .not. file('idfile.dbf')
? 'Please insert data disk'
wait
endif
if .not. file('mailchck.ntx')
use msghead
index on hd_base+hd_to+hd_recvd to mailchck
endif
if .not. file('relativ.ntx')
use clmnlist
index on cl_relativ to relativ
endif
if .not. file('clnumber.ntx')
use clmnlist
index on cl_number to clnumber
endif
if .not. file('idhandle.ntx')
use idfile
index on id_handle to idhandle
endif
if .not. file('idaccess.ntx')
use idfile
index on id_access to idaccess
endif
if .not. file('hdnum.ntx')
use msghead
index on hd_number to hdnum
endif
if .not. file('hdfrom.ntx')
use msghead
index on hd_from to hdfrom
endif
if .not. file('hdto.ntx')
use msghead
index on hd_to to hdto
endif
if .not. file('hdbase.ntx')
use msghead
index on hd_base to hdbase
endif
if .not. file('txtnum.ntx')
use msgtext
index on tx_number to txtnum
endif
if .not. file('basehand.ntx')
use messlast
index on ml_basehan to basehand
endif
if .not. file('flarea.ntx')
use files
index on fl_area to flarea
endif
if .not. file('flfilenm.ntx')
use files
index on fl_filenm to flfilenm
endif
if .not. file('flareadt.ntx')
use files
index on str(fl_area,2)+str(3000-year(fl_date),4)+str(13-month(fl_date),2)+str(32-day(fl_date),2) to flareadt
endif
if .not. file('sthandle.ntx')
use usrstory
index on st_handle to sthandle
endif
if .not. file('numcalls.mem')
numcalls = 0
save all like numcalls to numcalls
endif
top = 0
left=0
bottom=22
right=79
select 1
use idfile index idhandle, idaccess
select 2
use log
select 3
use usrstory index sthandle
select 4
use comments
select 5
use msghead index hdnum,hdfrom,hdto,mailchck,hdbase
select 6
use msgtext index txtnum
select 7
use messlast index basehand
select 8
use clmnlist index relativ, clnumber
select 9
use files index flarea, flfilenm, flareadt
if file('defaults.mem')
restore from defaults additive
declare filearea[numfileareas], flareapath[numfileareas]
for tt = 1 to numfileareas
if tt > 9
dd = str(tt,2)
else
dd = str(tt,1)
endif
filearea[tt] = filearea&dd
flareapath[tt] = flarpth&dd
next tt
else
do setup
restore from defaults additive
declare filearea[numfileareas], flareapath[numfileareas]
for tt = 1 to numfileareas
if tt > 9
dd = str(tt,2)
else
dd = str(tt,1)
endif
filearea[tt] = filearea&dd
flareapath[tt] = flarpth&dd
next tt
endif
finish = .f.
do while .not. finish
dclear = clear()
@ 0,0 say "One moment..."
run mode com1:1200,n,8,1
menuexit = .f.
call init_comm
more = .f.
tline = 1
msg = 'AT E0 V0 Q0 X1 S0=1'+chr(13)
call outp_char with msg
chained = .f.
print = .f.
local = .f.
tphour2 = 0
wantchat = .f.
cancelled = .f.
junk = inp_char(.t.)
chatmode = .f.
cr = chr(13)
lf = chr(10)
bksp = chr(8)
bell = chr(7)
breakflag = .f.
command = .t.
buffer = ''
echo = .t.
ok = .f.
baudrate = 1200
x = inkey(1)
msg = 'AT E0 V0 Q0 X1 S0=1'+cr
call outp_char with msg
junk = ''
set deleted on
base = 1
linecount = 1
numlines = 255
declare line[numlines]
hdnumber = space(9)
hdfrom = space(30)
hdto = space(30)
hdsubject = space(30)
hdpriv = .f.
hdrecvd = 'N'
hdbase = space(20)
hddate = space(16)
hdtime = space(8)
txnumber = space(9)
txtext = space(79)
idhandle = space(30)
idname = space(30)
idaddress = space(30)
idcity = space(15)
idprov = space(2)
idphone = space(14)
idpasswrd = space(20)
idltlogdt = ctod(' / / ')
idltlogtm = ' : : '
idmore = .t.
idwidth = 080
idclear = 010
idexpert = .f.
idaccess = 1
idcaps = .f.
idlf = .t.
idbksp = 008
idprompt = .f.
idpoints = 2000
lgintime = time()
lgindate = date()
if .not. file('lastnum.mem')
select 5
set order to 5
go top
for tt = 1 to numbases
if tt > 9
dd = str(tt,2)
else
dd = str(tt,1)
endif
seek trim(messbase&dd)
if eof()
lastnum&dd = 0
else
do while (.not. eof()) .and. (trim(messbase&dd) = trim(hd_base))
skip
enddo
skip -1
lastnum&dd = val(substr(hd_number,5,5))
endif
next tt
save all like lastnum* to lastnum
set order to 1
go top
endif
restore from lastnum additive
restore from numcalls additive
junk = inp_char(.t.)
do awaitcall
if finish
loop
endif
junk = inp_char(.t.)
msg = space(79)
controls = .t.
if carrier() .or. local
do openscrn
endif
if carrier() .or. local
do login
endif
* if idlf
lf = chr(10)
* else
* lf = chr(0)
* endif
bksp = chr(idbksp)
controls = .t.
if carrier() .or. local
do bulletin
numcalls = numcalls + 1
msg = cr+lf+'You are caller number '+str(numcalls,5)+cr+lf
do output with msg
tpdow = cdow(idltlogdt)
tpmonth = cmonth(idltlogdt)
tpday = str(day(idltlogdt),2)
tpyear = str(year(idltlogdt),4)
tpampm = ampm(idltlogtm)
do output with cr+lf+'Your last logon was at:'+cr+lf+tpampm+' on '+tpdow+' '+tpmonth+' '+tpday+', '+tpyear+cr+lf
do dispstats
if idexpert
msg = cr+lf+'Menu mode: Expert'+cr+lf
else
msg = cr+lf+'Menu mode: Novice'+cr+lf
endif
do output with msg
save all like numcalls to numcalls
endif
if carrier() .or. local
do mainmenu
endif
if carrier() .or. local
do connecttime
msg = cr+lf+'Thanks for calling. Keep calling back!!!'+cr+lf+'--- Disconnected ---'
do output with msg
endif
if local
run mode com1:1200,n,8,1
endif
call uninit_com
do logout
keyboard ""
d = inkey(1)
call init_comm
d = inkey(1)
local = .f.
do output with '+++'
d = inkey(1)
call outp_char with 'ATZ'+cr
d = inkey(1)
junk = inp_char(.t.)
enddo
dclear = clear()
@ 0,0 say 'End of Turbo BBS Version 1.0 by James Nickel'
call uninit_com
procedure openscreen
dclear = clear()
@ 0,0 say ' ________________ _____ ____ ____________ ____________ _____________'
@ 1,0 say ' / / / / / / / / / / _____ / / / _____ / / / ______ / /'
@ 2,0 say '/_____ ____/_/ / / / / / / / / / / / / / / / / / / / / / / / /'
@ 3,0 say ' / / / / / / / / / / /_/__/ / / / /_/__/ / / / / / / / /'
@ 4,0 say ' / / / / / / / / / / _______/_/ / _______ \ \ / / / / / /'
@ 5,0 say ' / / / / / / / / / / /\ \ \ / / / / / / / / / / / /'
@ 6,0 say ' / / / / / / / / / / / /\ \ \ / / / / / / / / / / / /'
@ 7,0 say ' / / / / /_/___/ / / / / / \ \ \ / /_/____/ / / / /_/___/ / /'
@ 8,0 say ' /__/_/ /__________/_/ /__/_/ \_\_\/___________/_/ /__________/_/'
@ 9,0 say ' ____________ _____ _____ ____ ______________'
@ 10,0 say ' / _____ / / / / / / / / / / / / ______ / /'
@ 11,0 say ' / / / / / / / / / / / / / / / / / / /__/_/'
@ 12,0 say ' / /_/__/ / / / / / / / / / / / / /_/________'
@ 13,0 say ' / _______/_/ / / / / / / / / / /________ / /'
@ 14,0 say ' / / / / / / / / / / / / / / /'
@ 15,0 say ' / / / / / / / / / / / / _____ / / /'
@ 16,0 say ' / / / / /_/_______ / /_/___/ / / / /_/___/ / /'
@ 17,0 say ' /__/_/ /__________/_/ /__________/_/ /___________/_/'
msg = 'Bulletin Board System. Version 1.0 By James Nickel'
@ 19,center(msg) say msg
@ 20,0 say 'If you use this program regularly, and find it useful, and enjoyable,'
@ 21,0 say 'then you might like to have the newest version, along with the source code.'
@ 22,0 say 'You may obtain this by sending $35 to:'
@ 23,0 say 'James Nickel, 15 McNab Crescent Regina, Saskatchewan, Canada. If you'
@ 24,0 say 'have questions, you may contact me at (306)569-2434(voice), 586-7560(data)'
function center
parameter string
return (40-(len(string)/2))
procedure setup
save screen
dclear = clear()
@ 0,0,2,79 box frame
msg = 'TURBO PLUS BBS SYSTEM SETUP'
@ 1,center(msg) say msg
if file('defaults.mem')
restore from defaults additive
else
numbases = 5
numfileareas = 6
maxnummess = 1000
sysflprivate = .f.
filearea1 = 'GENERAL '
filearea2 = 'MS-DOS '
filearea3 = 'C-64 '
filearea4 = 'COCO '
filearea5 = 'APPLE '
filearea6 = 'ATARI '
flarpth1 = 'C:\TURBO\GENERAL\ '
flarpth2 = 'C:\TURBO\MSDOS\ '
flarpth3 = 'C:\TURBO\C64\ '
flarpth4 = 'C:\TURBO\COCO\ '
flarpth5 = 'C:\TURBO\APPLE\ '
flarpth6 = 'C:\TURBO\ATARI\ '
meetingstxt = 'C:\TURBO\TXTFILES\MEETINGS.TXT '
mainmenutxt = 'C:\TURBO\TXTFILES\MAINMENU.TXT '
mainmessmenu = 'C:\TURBO\TXTFILES\MAINMESS.TXT '
newusrfile = 'C:\TURBO\TXTFILES\NEWUSER.TXT '
filemenutxt = 'C:\TURBO\TXTFILES\FILEMENU.TXT '
messbase1 = 'General '
messbase2 = 'Philosophy'
messbase3 = 'Poetry '
messbase4 = 'Entertainment '
messbase5 = 'For Sale '
scrncodes = 'C:\TURBO\TXTFILES\SCRNCODE.TXT '
editmenu = 'C:\TURBO\TXTFILES\EDITMENU.TXT '
bulletintxt = 'C:\TURBO\TXTFILES\BULLETIN.TXT '
sysinfo = 'C:\TURBO\TXTFILES\SYSINFO.TXT '
welcomeinfo = 'C:\TURBO\TXTFILES\WELCOME.TXT '
othersyslist = 'C:\TURBO\TXTFILES\BBSLIST.TXT '
opening = 'C:\TURBO\TXTFILES\OPENING.TXT '
installmenu = 'C:\TURBO\TXTFILES\INSTALL.TXT '
helpfile = 'C:\TURBO\TXTFILES\HELPFILE.TXT '
usrstory = "C:\TURBO\TXTFILES\USRSTORY.TXT "
opnstory = "C:\TURBO\TXTFILES\OPNSTORY.TXT "
endif
setdone = .f.
do while .not. setdone
@ 4,0 say 'Number of message areas : ' get numbases picture '99'
@ 4,40 say 'Number of file areas : ' get numfileareas picture '99'
@ 5,0 say 'Maximum number of messages : ' get maxnummess picture '99999'
@ 6,0 say 'Should files uploaded be made private (Y/N) ? ' get sysflprivate
@ 7,0 say 'File names (and paths including drive) for the following text files:'
@ 8,0 say 'Main menu : ' get mainmenutxt picture '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
@ 9,0 say 'Message area selection menu : ' get mainmessmenu picture '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
@ 10,0 say 'New user information : ' get newusrfile picture '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
@ 11,0 say 'User installation menu : ' get installmenu picture '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
@ 12,0 say 'Opening bulletin : ' get bulletintxt picture '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
@ 13,0 say 'Opening screen : ' get opening picture '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
@ 14,0 say 'Screen clear codes list : ' get scrncodes picture '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
@ 15,0 say 'System information file : ' get sysinfo picture '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
@ 16,0 say 'Other BBS listing : ' get othersyslist picture '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
@ 17,0 say 'Welcome information file : ' get welcomeinfo picture '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
@ 18,0 say 'File menu : ' get filemenutxt picture '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
@ 19,0 say 'Meetings list : ' get meetingstxt picture '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
@ 20,0 say 'Message editing menu : ' get editmenu picture '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
@ 21,0 say 'Help file : ' get helpfile picture '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
@ 22,0 say 'User story introduction : ' get opnstory picture '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
@ 23,0 say 'User story text : ' get usrstory picture '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
read
msg = 'Is this correct (Y/N/Abort) ? '
pp = 'Y'
@ 24,center(msg) say msg get pp
read
if upper(pp) = 'Y' .or. upper(pp) = 'A'
setdone = .t.
loop
endif
enddo
if upper(pp) = 'A'
dclear = clear()
quit
endif
dclear = clear()
for tt = 1 to numfileareas
if tt > 9
dd = str(tt,2)
else
dd = str(tt,1)
endif
public filearea&dd
if empty(filearea&dd)
filearea&dd = space(15)
endif
if len(filearea&dd) < 1
filearea&dd = space(15)
else
filearea&dd = filearea&dd + space(15 - len(filearea&dd))
endif
@ tt,0 say 'File area name '+str(tt,2)+': ' get filearea&dd
next
read
dclear = clear()
for tt = 1 to numfileareas
if tt > 9
dd = str(tt,2)
else
dd = str(tt,1)
endif
public flarpth&dd
if empty(flarpth&dd)
flarpth&dd = space(28)
endif
if len(flarpth&dd) < 1
flarpth&dd = space(28)
else
flarpth&dd = flarpth&dd + space(28 - len(flarpth&dd))
endif
@ tt,0 say 'File area path '+str(tt,2)+': '+filearea&dd+': ' get flarpth&dd
next
read
dclear = clear()
for tt = 1 to numbases
if tt > 9
dd = str(tt,2)
else
dd = str(tt,1)
endif
public messbase&dd
if empty(messbase&dd)
messbase&dd = space(20)
endif
if len(messbase&dd) < 1
messbase&dd = space(20)
else
messbase&dd = messbase&dd + space(20 - len(messbase&dd))
endif
@ tt,0 say 'Message area name '+str(tt,2)+': ' get messbase&dd
next
read
dclear = clear()
save to defaults
return
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/