home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1994 #1
/
monster.zip
/
monster
/
PCBOARD
/
PEPSTER.ZIP
/
LISTER.PPS
< prev
next >
Wrap
Text File
|
1994-04-01
|
9KB
|
344 lines
;BBS LISTER 1.00 Beta
;Date 3-27-94, Sunday
;Written by John R. Pepp
;Updated : 04-01-95, Friday
;Program No. 2 - A General BBS listing Program!
;FREEWARE
BOOLEAN No_add 'Only One Per Customer :=)
BOOLEAN quit 'Main Menu Condition
BOOLEAN max_bull 'Max Bull Condition
BOOLEAN main_exit ' Flag to determine Exit Point for 2nd Menu
BOOLEAN edit_exit ' Flag to exit EDIT MENU
STRING name ; Temp variable for bbs name
STRING number ;
STRING sysop ; Temp variable for bbs sysop
STRING b_user ;
STRING s_date ;
STRING check ;
STRING current_user(250) ; Current User Name
STRING mark(250) ; Mark For LogOFF?
STRING bbs_name(250) ; Name of BBS
STRING bbs_phone(250) ; Telephone of BBS
STRING bbs_sysop(250) ; Sysop of BBS
STRING bbs_soft(250) ; Software used by Sysop
STRING bbs_op(250) ; Type Of Operation
STRING bbs_desc(250) ; Description of BBS
STRING areacode ; Area Code
STRING prefix ; Pre-Fix
STRING suffix ; Suffix
STRING cmd ; Callers Response
STRING stamp_date(250) ; Date Caller Listed BBS
STRING line ; Place BBS is Bullentins
STRING code ; Enter area code for search
STRING hold ; Get Area Code From Data File
INTEGER x,y, stored, count,total ; array counters for bbs List
LET no_add = FALSE 'Do not let user's to add more than one bbs listing.
LET quit = FALSE
LET max_bull = FALSE
LET edit_exit = FALSE
LET main_exit = FALSE
LET count = 0 'Reset total BBS Listings
LET total = 6 'Max. Number of Logoff Listings!
LET cmd = " "
WHILE ( !(main_exit) ) DO
GOSUB general
ENDWHILE
END ' End Program
:GENERAL
CLS 'clear the screen!
LET cmd = " "
DISPFILE PPEPATH()+"MENU2G",SEC+GRAPH+LANG 'Main Menu
INPUTSTR "Enter A, V, Q, or L ", cmd, @X0B, 1, "AVQL", UPCASE+GUIDE+FIELDLEN+NEWLINE
IF (cmd = "A") THEN
GOSUB get_info
IF (CURSEC() >= SYSOPSEC()) THEN
GOSUB data_entry
LET no_add = TRUE
ELSE IF (!(no_add)) THEN
GOSUB data_entry
ELSE IF (no_add) THEN
GOSUB edit_menu
ENDIF
ELSE IF (cmd = "V") THEN
GOSUB view
ELSE IF (cmd = "Q") THEN
main_exit = TRUE
ELSE IF (cmd = "L") THEN
DISPFILE PPEPATH()+"GOODBYEG",SEC+GRAPH+LANG 'LOGOFF SCREE
BYE
ENDIF
RETURN
:VIEW
STRING key
CLS
INPUTSTR "Enter Area Code to search ", code, @X0B, 3, "1234567890",FIELDLEN+GUIDE+NEWLINE
FOPEN 1, PPEPATH()+"BBS", O_RD, S_DW
FREWIND 1
CLS
PRINTLN "@X0AHere are the BBSes in the ", "@X0B"+code, "@X0A area code.@X07"
NEWLINE
WHILE (!FERR(1)) DO
FGET 1, name
FGET 1, number
FGET 1, sysop
FGet 1, s_date
FGET 1, b_user
FGET 1, check
hold = LEFT(number, 4)
hold = LTRIM(HOLD, "(")
IF (code = hold) THEN
PRINT "@X0F"+name
PRINT " "
PRINT "@X0B"+number
PRINT " "
PRINTLN "@X0A"+sysop
ENDIF
ENDWHILE
FCLOSE 1
NEWLINE
PRINTLN "Press @X0BSPACE @X0Ato return to @X8CMAIN MENU@X07 "
WHILE (key <> CHR(32)) do
LET key = inkey()
ENDWHILE
LET KEY = CHR(13)
RETURN
:Data_Entry
CLS
Let count = 0 ' Reset Counter
Let x = 0 'Reset X counter
Let cmd = ""
GOSUB GET_INFO 'Retreive Stored info
count = count + 1;
stored = count
GOSUB name_of_bbs
GOSUB sysop_of_bbs
GOSUB phone_of_bbs
GOSUB ask_mark
GOSUB edit_menu
if (cmd = "A") THEN
count = count - 1
stored = 0
endif
RETURN
:bmaker 'Create a Generic Bulletin that can be used as Logoff Screen
FCREATE 4, PPEPATH()+"GOODBYEG", O_WR, S_DN
FPUTLN 4,"@CLS@@X70╒@X7F════════════════════════════════════════════════════════════════════════════╗@X07"
FPUTLN 4,"@X70│ @X74BBS LISTER 1.00 @X7F║@X07"
FPUTLN 4,"@X70│ @X7F║@X07"
FPUTLN 4,"@X70│ @X71Bulletin Board @X7FTelephone @X74Sysop's @X70Date @X7F║@X07"
FPUTLN 4,"@X70│ @X71Name @X7F Number @X74Name @X70Posted @X7F║@X07"
FPUTLN 4,"@X70│ @X7F║@X07"
FCREATE 6, PPEPATH()+"SYSOPG", O_WR, S_DN
FOR x = 1 to count
IF (mark(x) = "Y") THEN
FPUT 6, "@X70│@X71 "
FPUTPAD 6, bbs_name(x), -20
FPUTPAD 6, bbs_phone(x), -17
FPUTPAD 6, bbs_sysop(x),-23
FPUTPAD 6, stamp_date(x), -15
FPUTLN 6, "@X7F║@X07"
ENDIF
NEXT
FCLOSE 6 'Channel for writting BBSs in bulletin form.
FOPEN 2, PPEPATH()+"SYSOPG", O_RD, S_DW
FREWIND 2
FGET 2, line
WHILE (!FERR(2)) DO
FPUTLN 4, line
FGET 2, line
ENDWHILE
FCLOSE 2 'Put BBSs in Bullentin Lister
FPUTLN 4,"@X70│ @X7F║@X07"
FPUTLN 4,"@X70│ @X71PEPSTER'S PLACE (313) 421-9145 SYSOP : JOHN PEPP (AUTHOR OF BBS LISTER) @X7F║@X07"
FPUTLN 4,"@X70└────────────────────────────────────────────────────────────────────────────╜@X07"
FCLOSE 4 'Channel for Bullentin Lister
RETURN
:ENTER_INFO 'Create Text File OF BBS Listings
FCREATE 1, PPEPATH()+"BBS", O_WR, S_DN
FOR x = 1 TO count
FPUTLN 1, bbs_name(x)
FPUTLN 1, bbs_phone(x)
FPUTLN 1, bbs_sysop(x)
FPUTLN 1, stamp_date(x)
FPUTLN 1, current_user(x)
FPUTLN 1, mark(x)
NEXT
FCLOSE 1
FCREATE 2, PPEPATH()+"TOTAL", O_WR, S_DN
FPUTLN 2, count
FCLOSE 2
RETURN
:GET_INFO
FOPEN 3, PPEPATH()+"TOTAL", O_RD, S_DW
FREWIND 3
IF (FERR(3)) THEN
SPRINTLN "Error, File Doesn't Exist"
Let count = 0
GOTO skip 'No need to open other file
ENDIF
IF (!FERR(3)) THEN
FGET 3, count
ENDIF
IF (count >= total) THEN
max_bull = TRUE
ENDIF
FOPEN 1, PPEPATH()+"BBS", O_RD, S_DW
FREWIND 1
FOR x = 1 TO count
FGET 1, bbs_name(x)
FGET 1, bbs_phone(x)
FGET 1, bbs_sysop(x)
FGET 1, stamp_date(x)
FGET 1, current_user(x)
FGET 1, mark(x)
IF (U_NAME() = current_user(X)) THEN
no_add = TRUE
stored = x 'Store Users Record
ENDIF
NEXT
FCLOSE 1
:skip 'File Doesn't Exist No Need for Opening It!
FCLOSE 3
RETURN
:name_of_bbs
INPUTSTR "Enter BBS Name : ", name, @X0B, 20, MASK_ASCII(), FIELDLEN+GUIDE+NEWLINE
LET bbs_name(stored) = name
RETURN
:sysop_of_bbs
INPUTSTR "Enter BBS Sysop's Name : ", sysop, @X0B, 20, MASK_ASCII(), FIELDLEN+GUIDE+NEWLINE
LET bbs_sysop(stored) = sysop
LET current_user(stored) = U_NAME()
RETURN
:phone_of_bbs
CLS
PRINTLN "@X0FPlease Enter BBS Telephone Number."
NEWLINES 5
INPUTSTR "Area Code", areacode, @X0B, 3, "1234567890", FIELDLEN+GUIDE+NEWLINE
INPUTSTR "Prefix", prefix, @X0B, 3, "1234567890", FIELDLEN+GUIDE+NEWLINE
INPUTSTR "Suffix", suffix, @X0B, 4, "1234567890", FIELDLEN+GUIDE+NEWLINE
LET bbs_phone(stored) = "("+areacode+") "+prefix+"-"+suffix
LET stamp_date(stored) = DATE() 'Stamp the Date the USER entered the BBS
RETURN
:edit_menu
WHILE (!(edit_exit)) DO
CLS
PRINTLN "@X0AThe Edit Menu "
NEWLINES 2
PRINTLN "@X0BBBS (@X0DN@X0B)ame @X0F| @X07", "@X0A"+bbs_name(stored)
PRINTLN "@X0BBBS (@X0DT@X0B)elephone Number of BBS @X0F| @X07", "@X0A"+bbs_phone(stored)
PRINTLN "@X0BBBS S(@X0DY@X0B)sop @X0F| @X07", "@X0A"+bbs_sysop(stored)
PRINTLN "@X0BLog(@X0DO@X0B)ff Screen (Y/N) @X0F| @X07", "@X0A"+mark(stored)
PRINTLN
PRINTLN "@X0A(@X0CS@X0A)ave Changes@X07"
PRINTLN "@X0A(@X0CA@X0A)bort Changes@X07 "
NEWLINE
LET cmd = " "
INPUTSTR "Enter N, T, Y, O, S, or A ", cmd, @X0B, 1, "NTYOSA", UPCASE+FIELDLEN+GUIDE+NEWLINE
IF (cmd = "A") THEN
CLS
PRINTLN "@X8CAborting and Returning to Menu@X07"
LET name = ""
LET sysop = ""
LET areacode = ""
LET prefix = ""
LET suffix = ""
RETURN
ELSE IF (cmd = "N") THEN
GOSUB name_of_bbs
ELSE IF (cmd = "T") THEN
GOSUB phone_of_bbs
ELSE IF (cmd = "Y") THEN
GOSUB sysop_of_bbs
ELSE IF (cmd = "O") THEN
GOSUB ask_mark
ELSE IF (cmd = "S") THEN
CLS
GOSUB enter_info
GOSUB bmaker 'Generate Bulletin
edit_exit = TRUE
ENDIF
ENDWHILE
edit_exit = FALSE 'Set Back Flag to False
RETURN
:ask_mark
CLS
IF (CURSEC() > 20) THEN
INPUTSTR "Do you want you bbs to show up on Goodbye Screen (Y/N)", mark(stored), @X0E, 1, "", AUTO+YESNO
ELSE
PRINTLN "@X0CIf you wish to have a Logoff Listing on @BOARDNAME@@X07"
PRINTLN "@X0CPlease Leave a Private Message to the Sysop "
PRINTLN "@X0A-OR-@X07"
PRINTLN "@X0FRent A Line for $5.00@X07"
PRINTLN "@X0BMake check/money order (Do Not Send Cash!) to : "
PRINTLN "John Pepp "
PRINTLN "P.O. Box 51171 "
PRINTLN "Livonia, Mi 48151@X07"
DELAY 18*7
mark(stored) = "N"
ENDIF
RETURN