home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PCBOARD / PEPSTER.ZIP / LISTER.PPS < prev    next >
Text File  |  1994-04-01  |  9KB  |  344 lines
  1. ;BBS LISTER 1.00 Beta
  2. ;Date 3-27-94, Sunday
  3. ;Written by John R. Pepp
  4. ;Updated : 04-01-95, Friday
  5. ;Program No. 2 - A General BBS listing Program!
  6. ;FREEWARE
  7.  
  8. BOOLEAN No_add 'Only One Per Customer :=)
  9. BOOLEAN quit 'Main Menu Condition
  10. BOOLEAN max_bull 'Max Bull Condition
  11. BOOLEAN main_exit ' Flag to determine Exit Point for 2nd Menu
  12. BOOLEAN edit_exit ' Flag to exit EDIT MENU
  13.  
  14. STRING name             ; Temp variable for bbs name
  15. STRING number           ;
  16. STRING sysop            ; Temp variable for bbs sysop
  17. STRING b_user           ;
  18. STRING s_date           ;
  19. STRING check            ;
  20. STRING current_user(250) ; Current User Name
  21. STRING mark(250)         ; Mark For LogOFF?
  22. STRING bbs_name(250)     ; Name of BBS
  23. STRING bbs_phone(250)    ; Telephone of BBS
  24. STRING bbs_sysop(250)    ; Sysop of BBS
  25. STRING bbs_soft(250)     ; Software used by Sysop
  26. STRING bbs_op(250)       ; Type Of Operation
  27. STRING bbs_desc(250)     ; Description of BBS
  28. STRING areacode         ; Area Code
  29. STRING prefix           ; Pre-Fix
  30. STRING suffix           ; Suffix
  31. STRING cmd              ; Callers Response
  32. STRING stamp_date(250)   ; Date Caller Listed BBS
  33. STRING line             ; Place BBS is Bullentins
  34. STRING code             ; Enter area code for search
  35. STRING hold             ; Get Area Code From Data File
  36.  
  37. INTEGER x,y, stored, count,total ; array counters for bbs List
  38.  
  39. LET no_add  = FALSE 'Do not let user's to add more than one bbs listing.
  40. LET quit = FALSE
  41. LET max_bull = FALSE
  42. LET edit_exit = FALSE
  43. LET main_exit = FALSE
  44.  
  45. LET count = 0  'Reset total BBS Listings
  46. LET total = 6 'Max. Number of Logoff Listings!
  47. LET cmd = " "
  48. WHILE ( !(main_exit) ) DO
  49.  
  50. GOSUB general
  51.  
  52. ENDWHILE
  53.  
  54. END ' End Program
  55.  
  56. :GENERAL
  57.  
  58. CLS 'clear the screen!
  59. LET cmd = " "
  60.  
  61. DISPFILE PPEPATH()+"MENU2G",SEC+GRAPH+LANG 'Main Menu
  62. INPUTSTR "Enter A, V, Q, or L ", cmd, @X0B, 1, "AVQL", UPCASE+GUIDE+FIELDLEN+NEWLINE
  63.  
  64. IF (cmd = "A") THEN
  65.   GOSUB get_info
  66.   IF (CURSEC() >= SYSOPSEC()) THEN
  67.     GOSUB data_entry
  68.     LET no_add = TRUE
  69.   ELSE IF (!(no_add)) THEN
  70.     GOSUB data_entry
  71.   ELSE IF (no_add) THEN
  72.     GOSUB edit_menu
  73.   ENDIF
  74. ELSE IF (cmd = "V") THEN
  75.   GOSUB view
  76. ELSE IF (cmd = "Q") THEN
  77.   main_exit = TRUE
  78. ELSE IF (cmd = "L") THEN
  79.   DISPFILE PPEPATH()+"GOODBYEG",SEC+GRAPH+LANG 'LOGOFF SCREE
  80.   BYE
  81. ENDIF
  82.  
  83. RETURN
  84.  
  85. :VIEW
  86. STRING key
  87.  
  88. CLS
  89. INPUTSTR "Enter Area Code to search ", code, @X0B, 3, "1234567890",FIELDLEN+GUIDE+NEWLINE
  90. FOPEN 1, PPEPATH()+"BBS", O_RD, S_DW
  91. FREWIND 1
  92. CLS
  93. PRINTLN "@X0AHere are the BBSes in the ", "@X0B"+code, "@X0A area code.@X07"
  94. NEWLINE
  95.  
  96. WHILE (!FERR(1)) DO
  97.   FGET 1, name
  98.   FGET 1, number
  99.   FGET 1, sysop
  100.   FGet 1, s_date
  101.   FGET 1, b_user
  102.   FGET 1, check
  103.   hold = LEFT(number, 4)
  104.   hold = LTRIM(HOLD, "(")
  105.  
  106.   IF (code = hold) THEN
  107.     PRINT "@X0F"+name
  108.     PRINT "  "
  109.     PRINT "@X0B"+number
  110.     PRINT "  "
  111.     PRINTLN "@X0A"+sysop
  112.   ENDIF
  113. ENDWHILE
  114. FCLOSE 1
  115.  
  116. NEWLINE
  117. PRINTLN "Press @X0BSPACE @X0Ato return to @X8CMAIN MENU@X07 "
  118. WHILE (key <> CHR(32)) do
  119.   LET key = inkey()
  120. ENDWHILE
  121. LET KEY = CHR(13)
  122.  
  123. RETURN
  124.  
  125. :Data_Entry
  126. CLS
  127. Let count = 0 ' Reset Counter
  128. Let x = 0 'Reset X counter
  129. Let cmd = ""
  130. GOSUB GET_INFO 'Retreive Stored info
  131. count = count + 1;
  132. stored = count
  133.  
  134. GOSUB name_of_bbs
  135. GOSUB sysop_of_bbs
  136. GOSUB phone_of_bbs
  137. GOSUB ask_mark
  138. GOSUB edit_menu
  139.  
  140. if (cmd = "A") THEN
  141.   count = count - 1
  142.   stored = 0
  143. endif
  144.  
  145. RETURN
  146.  
  147. :bmaker 'Create a Generic Bulletin that can be used as Logoff Screen
  148.  
  149. FCREATE 4, PPEPATH()+"GOODBYEG", O_WR, S_DN
  150. FPUTLN 4,"@CLS@@X70╒@X7F════════════════════════════════════════════════════════════════════════════╗@X07"
  151. FPUTLN 4,"@X70│                             @X74BBS LISTER 1.00                                @X7F║@X07"
  152. FPUTLN 4,"@X70│                                                                            @X7F║@X07"
  153. FPUTLN 4,"@X70│ @X71Bulletin Board      @X7FTelephone        @X74Sysop's                @X70Date           @X7F║@X07"
  154. FPUTLN 4,"@X70│ @X71Name              @X7F  Number           @X74Name                   @X70Posted         @X7F║@X07"
  155. FPUTLN 4,"@X70│                                                                            @X7F║@X07"
  156.  
  157.  
  158. FCREATE 6, PPEPATH()+"SYSOPG", O_WR, S_DN
  159. FOR x = 1 to count
  160.  
  161.   IF (mark(x) = "Y") THEN
  162.     FPUT 6, "@X70│@X71 "
  163.     FPUTPAD 6, bbs_name(x), -20
  164.     FPUTPAD 6, bbs_phone(x), -17
  165.     FPUTPAD 6, bbs_sysop(x),-23
  166.     FPUTPAD 6, stamp_date(x), -15
  167.     FPUTLN 6, "@X7F║@X07"
  168.   ENDIF
  169.  
  170. NEXT
  171. FCLOSE 6  'Channel for writting BBSs in bulletin form.
  172.  
  173. FOPEN 2, PPEPATH()+"SYSOPG", O_RD, S_DW
  174. FREWIND 2
  175. FGET 2, line
  176. WHILE (!FERR(2)) DO
  177.   FPUTLN 4, line
  178.   FGET 2, line
  179. ENDWHILE
  180.  
  181. FCLOSE 2 'Put BBSs in Bullentin Lister
  182. FPUTLN 4,"@X70│                                                                            @X7F║@X07"
  183. FPUTLN 4,"@X70│ @X71PEPSTER'S PLACE  (313) 421-9145  SYSOP : JOHN PEPP (AUTHOR OF BBS LISTER)  @X7F║@X07"
  184. FPUTLN 4,"@X70└────────────────────────────────────────────────────────────────────────────╜@X07"
  185. FCLOSE 4 'Channel for Bullentin Lister
  186. RETURN
  187.  
  188. :ENTER_INFO 'Create Text File OF BBS Listings
  189.  
  190. FCREATE 1, PPEPATH()+"BBS", O_WR, S_DN
  191.  
  192. FOR x = 1 TO count
  193.   FPUTLN 1, bbs_name(x)
  194.   FPUTLN 1, bbs_phone(x)
  195.   FPUTLN 1, bbs_sysop(x)
  196.   FPUTLN 1, stamp_date(x)
  197.   FPUTLN 1, current_user(x)
  198.   FPUTLN 1, mark(x)
  199. NEXT
  200.  
  201. FCLOSE 1
  202.  
  203. FCREATE 2, PPEPATH()+"TOTAL", O_WR, S_DN
  204.   FPUTLN 2, count
  205. FCLOSE 2
  206.  
  207. RETURN
  208.  
  209. :GET_INFO
  210.  
  211. FOPEN 3, PPEPATH()+"TOTAL", O_RD, S_DW
  212. FREWIND 3
  213.  
  214. IF (FERR(3)) THEN
  215.   SPRINTLN "Error, File Doesn't Exist"
  216.   Let count = 0
  217.   GOTO skip 'No need to open other file
  218. ENDIF
  219.  
  220. IF (!FERR(3)) THEN
  221.   FGET 3, count
  222. ENDIF
  223.  
  224. IF (count >= total) THEN
  225.   max_bull = TRUE
  226. ENDIF
  227.  
  228. FOPEN 1, PPEPATH()+"BBS", O_RD, S_DW
  229. FREWIND 1
  230. FOR x = 1 TO count
  231.  
  232.   FGET 1, bbs_name(x)
  233.   FGET 1, bbs_phone(x)
  234.   FGET 1, bbs_sysop(x)
  235.   FGET 1, stamp_date(x)
  236.   FGET 1, current_user(x)
  237.   FGET 1, mark(x)
  238.   IF (U_NAME() = current_user(X)) THEN
  239.      no_add = TRUE
  240.      stored = x 'Store Users Record
  241.   ENDIF
  242.  
  243. NEXT
  244. FCLOSE 1
  245. :skip 'File Doesn't Exist No Need for Opening It!
  246.  
  247. FCLOSE 3
  248.  
  249. RETURN
  250.  
  251. :name_of_bbs
  252.  
  253. INPUTSTR "Enter BBS Name : ", name, @X0B, 20, MASK_ASCII(), FIELDLEN+GUIDE+NEWLINE
  254. LET bbs_name(stored) = name
  255.  
  256. RETURN
  257.  
  258. :sysop_of_bbs
  259.  
  260. INPUTSTR "Enter BBS Sysop's Name : ", sysop, @X0B, 20, MASK_ASCII(), FIELDLEN+GUIDE+NEWLINE
  261. LET bbs_sysop(stored) = sysop
  262. LET current_user(stored) = U_NAME()
  263. RETURN
  264.  
  265. :phone_of_bbs
  266.  
  267. CLS
  268. PRINTLN "@X0FPlease Enter BBS Telephone Number."
  269. NEWLINES 5
  270. INPUTSTR "Area Code", areacode, @X0B, 3, "1234567890", FIELDLEN+GUIDE+NEWLINE
  271. INPUTSTR "Prefix", prefix, @X0B, 3, "1234567890", FIELDLEN+GUIDE+NEWLINE
  272. INPUTSTR "Suffix", suffix, @X0B, 4, "1234567890", FIELDLEN+GUIDE+NEWLINE
  273. LET bbs_phone(stored) = "("+areacode+") "+prefix+"-"+suffix
  274. LET stamp_date(stored) = DATE() 'Stamp the Date the USER entered the BBS
  275.  
  276. RETURN
  277.  
  278.  
  279. :edit_menu
  280.  
  281. WHILE (!(edit_exit)) DO
  282.   CLS
  283.   PRINTLN "@X0AThe Edit Menu "
  284.   NEWLINES 2
  285.   PRINTLN "@X0BBBS (@X0DN@X0B)ame                          @X0F|  @X07", "@X0A"+bbs_name(stored)
  286.   PRINTLN "@X0BBBS (@X0DT@X0B)elephone Number of BBS       @X0F|  @X07", "@X0A"+bbs_phone(stored)
  287.   PRINTLN "@X0BBBS S(@X0DY@X0B)sop                         @X0F|  @X07", "@X0A"+bbs_sysop(stored)
  288.   PRINTLN "@X0BLog(@X0DO@X0B)ff Screen (Y/N)               @X0F|  @X07", "@X0A"+mark(stored)
  289.   PRINTLN
  290.   PRINTLN "@X0A(@X0CS@X0A)ave Changes@X07"
  291.   PRINTLN "@X0A(@X0CA@X0A)bort Changes@X07 "
  292.   NEWLINE
  293.   LET cmd = " "
  294.  
  295.   INPUTSTR "Enter N, T, Y, O, S, or A ", cmd, @X0B, 1, "NTYOSA", UPCASE+FIELDLEN+GUIDE+NEWLINE
  296.  
  297.   IF (cmd = "A") THEN
  298.     CLS
  299.     PRINTLN "@X8CAborting and Returning to Menu@X07"
  300.     LET name = ""
  301.     LET sysop = ""
  302.     LET areacode = ""
  303.     LET prefix = ""
  304.     LET suffix = ""
  305.     RETURN
  306.   ELSE IF (cmd = "N") THEN
  307.     GOSUB name_of_bbs
  308.   ELSE IF (cmd = "T") THEN
  309.     GOSUB phone_of_bbs
  310.   ELSE IF (cmd = "Y") THEN
  311.     GOSUB sysop_of_bbs
  312.   ELSE IF (cmd = "O") THEN
  313.     GOSUB ask_mark
  314.   ELSE IF (cmd = "S") THEN
  315.     CLS
  316.     GOSUB enter_info
  317.     GOSUB bmaker 'Generate Bulletin
  318.     edit_exit = TRUE
  319.   ENDIF
  320.  
  321. ENDWHILE
  322. edit_exit = FALSE 'Set Back Flag to False
  323. RETURN
  324.  
  325. :ask_mark
  326.  
  327. CLS
  328. IF (CURSEC() > 20) THEN
  329.   INPUTSTR "Do you want you bbs to show up on Goodbye Screen (Y/N)", mark(stored), @X0E, 1, "", AUTO+YESNO
  330. ELSE
  331.   PRINTLN "@X0CIf you wish to have a Logoff Listing on @BOARDNAME@@X07"
  332.   PRINTLN "@X0CPlease Leave a Private Message to the Sysop "
  333.   PRINTLN "@X0A-OR-@X07"
  334.   PRINTLN "@X0FRent A Line for $5.00@X07"
  335.   PRINTLN "@X0BMake check/money order (Do Not Send Cash!) to : "
  336.   PRINTLN "John Pepp                                       "
  337.   PRINTLN "P.O. Box 51171 "
  338.   PRINTLN "Livonia, Mi 48151@X07"
  339.   DELAY 18*7
  340.   mark(stored) = "N"
  341. ENDIF
  342.  
  343. RETURN
  344.