home *** CD-ROM | disk | FTP | other *** search
/ 8bitfiles.net/archives / archives.tar / archives / genie-commodore-file-library / C64-128Toolkit / EGBBBS.ARC / P.ADDER (.txt) < prev    next >
Encoding:
Commodore BASIC  |  2019-04-13  |  8.2 KB  |  402 lines
  1. 10 ;"OPEN15,9,15,"S0:P.A*":P[210]15,"I":SAVE"P.ADDER",9:VERIFY"P.ADDER",9
  2. 15 ;
  3. 20 ;        P.ADDER
  4. 25 BEG .BYTE 0
  5. 30 ;
  6. 35 I[162] LDA #[179]PFIL:LDX #[177]PFIL:STX RATS
  7. 40 JSR STRING
  8. 45 ;
  9. 50 JSR RATF:JSR FINU
  10. 55 ;
  11. 60 LDA #[179]WBAD:LDX #[177]WBAD:JMP STRING
  12. 65 ;
  13. 70 PFIL .BYTE 13 13
  14. 75 .BYTE "ASCILING DATA FOR VALIDATION...":.BYTE 13 13 0
  15. 80 ;
  16. 85 WBAD .BYTE 13 13
  17. 90 .BYTE "(null)OU'LL BE ADDED TO THE STR$ATA PEEKANK":.BYTE 148
  18. 95 .BYTE "IF VALIDATED. [(null)SUALLY W/IN 24 HOURS]":.BYTE 13 13 0
  19. 100 ;
  20. 105 ;[172][172][172][172][172] FILE TEMP[176]ARY MASTER [131]
  21. 110 ;
  22. 115 FINU JSR [156]CHN
  23. 120 LDA #7:LDX #[179]VFIL:LDY #[177]VFIL
  24. 125 JSR EXIS:LDA RATS:BEQ PJ
  25. 130 ;
  26. 135 LDA #"W";  CREATE FILE
  27. 140 .BYTE 44
  28. 145 PJ LDA #"A";  APP[128] [164] FILE
  29. 150 ;
  30. 155 STA VFIL[170]10
  31. 160 ;
  32. 165 LDA #14
  33. 170 LDX #[179]VFIL:LDY #[177]VFIL:JSR SETNAM
  34. 175 ;
  35. 180 LDA #7:LDX DRIV:TAY:JSR SETLFS
  36. 185 JSR [159]:JSR [156]CHN
  37. 190 ;
  38. 195 ;
  39. 200 LDX #7:JSR CHKOUT
  40. 205 ;
  41. 210 ;[172][172][172][172][172] P0 WILL S[128] FILE [164] DISK
  42. 215 ;
  43. 220 P0 LDY #0;  LAST NAME
  44. 225 P9 LDA WYRL,Y:JSR CHROUT
  45. 230 CMP #13:BEQ PA
  46. 235 INY:BNE P9
  47. 240 ;
  48. 245 PA LDY #0;  ADDRESS
  49. 250 PB LDA WYDD,Y:JSR CHROUT
  50. 255 CMP #13:BEQ PC
  51. 260 INY:BNE PB
  52. 265 ;
  53. 270 PC LDY #0;  CTY[173]ST[173]ZIP
  54. 275 PD LDA WCTY,Y:JSR CHROUT
  55. 280 CMP #13:BEQ PE
  56. 285 INY:BNE PD
  57. 290 ;
  58. 295 PE LDY #0;  TELEPH[145]E
  59. 300 PF LDA WYTL,Y:JSR CHROUT
  60. 305 CMP #13:BEQ PG
  61. 310 INY:BNE PF
  62. 315 ;
  63. 320 PG LDY #0;  PASSW[176]D
  64. 325 PH LDA WYPS,Y:JSR CHROUT
  65. 330 CMP #13:BEQ PI
  66. 335 INY:BNE PH
  67. 340 ;
  68. 345 PI LDA #7:JSR [160]:JSR [143]ODEM
  69. 350 JMP INITL
  70. 355 ;
  71. 360 VFIL .BYTE 48 58
  72. 365 .BYTE "ADDON,S,W":.BYTE 0
  73. 370 ;
  74. 375 ;[172][172][172][172][172][172][172][172][172][172][172][172][172][172][172][172][172][172][172][172][172][172][172][172][172]
  75. 380 ;
  76. 385 ; P1 BUFFERS ALL [131]
  77. 390 ; P6 WILL SET LAST [188][145]
  78. 395 ;
  79. 400 ;[172][172][172][172][172] BUFFER IN ROM BLOCK
  80. 405 ;
  81. 410 P1 LDY #0;   PSWD
  82. 415 P2 LDA WYPS,Y:BEQ P3
  83. 420 CMP #13:BEQ P3
  84. 425 STA ($FB),Y:INY:CPY #8:BNE P2
  85. 430 ;
  86. 435 P3 LDY #8:LDX #0; H[175]LE
  87. 440 P4 LDA WYHL,X:BEQ P5
  88. 445 CMP #13:BEQ P5
  89. 450 STA ($FB),Y:INX:INY:CPY #20:BNE P4
  90. 455 ;
  91. 460 P5 LDA ACSS:LDY #20:STA ($FB),Y
  92. 465 INY:LDA ACSS[170]1:STA ($FB),Y; STATUS
  93. 470 ;
  94. 475 INY:LDA CRDT:STA ($FB),Y; DL CRDTS
  95. 480 INY:LDA CRDT[170]1:STA ($FB),Y
  96. 485 ;
  97. 490 INY:LDA AGRE:STA ($FB),Y; MY TERM
  98. 495 ;
  99. 500 INY:LDA USYT:STA ($FB),Y; [158]TEM
  100. 505 ;
  101. 510 INY:LDA TLIM:STA ($FB),Y; TIME LMT
  102. 515 ;
  103. 520 LDY #30:LDA FEED:STA ($FB),Y; LFDS
  104. 525 ;
  105. 530 LDY #31:LDA COMS:STA ($FB),Y; COLS
  106. 535 ;
  107. 540 LDA #2:STA RGSR[170]1
  108. 545 ;
  109. 550 ;[172][172][172][172][172] COMM[145] LAST [188][145] ROUTINE
  110. 555 ;
  111. 560 P6 LDY #27:LDA BMO:STA ($FB),Y
  112. 565 INY:LDA BDA:STA ($FB),Y
  113. 570 INY:LDA BYR:STA ($FB),Y:RTS
  114. 575 ;
  115. 580 ;[172][172][172][172][172] TEST [129] FILE PRESENCE
  116. 585 ;
  117. 590 ; CHECKS [129] FILE PRESENCE.  [142]S W[173]RATS SET [139] FILE DOESN'T EZIST
  118. 595 ; CALLER MUST SET FILE NAME [175] LOCATI[145] IN A[173]X[173]Y BE[129]E CALLING
  119. 600 ;
  120. 605 EXIS JSR SETNAM
  121. 610 ;
  122. 615 LDA #7:LDX DRIV:TAY:JSR SETLFS
  123. 620 JSR [159]:JSR [156]CHN
  124. 625 ;
  125. 630 LDX #7:JSR CHKIN
  126. 635 JSR [161]IN:JSR [161]IN
  127. 640 ;
  128. 645 LDA $90:STA RATS
  129. 650 ;
  130. 655 LDA #7:JSR [160]
  131. 660 JSR [156]CHN:JMP [143]ODEM
  132. 665 ;
  133. 670 ;[172][172][172][172][172][172][172][172] SHOW USER [131] ********
  134. 675 ;
  135. 680 UDAT LDY #7:LDA #0:STA MODE
  136. 685 STA SERCH[170]1:STA SERCH:INC SERCH
  137. 690 PS STA YES,Y:DEY:BPL PS
  138. 695 ;
  139. 700 PT LDA #[179]XIST:LDX #[177]XIST:JSR EOO
  140. 705 BEQ P37; [168] SPEC[139]IC MEMBER
  141. 710 CMP #"N":BEQ P7
  142. 715 P1H JMP MENU; AB[176]T
  143. 720 ;
  144. 725 P37 INC YES
  145. 730 ;
  146. 735 JSR RET2:JSR LOOK:BCS P1H
  147. 740 ;
  148. 745 P1D LDA SERCH[170]1:BNE PT
  149. 750 ;
  150. 755 LDA SERCH:CMP UNUM:BEQ P1E
  151. 760 ;
  152. 765 JSR P1G:BCS P1H; CHECK ACCESS
  153. 770 ;
  154. 775 P1F LDA SERCH:CMP #251:BCS PT
  155. 780 P1E STA SERCH[170]1:JMP P7A
  156. 785 ;
  157. 790 ;[172][172][172][172] LAST [188][145]
  158. 795 ;
  159. 800 P7 JSR P1G:BCS P1H; CHECK ACCESS
  160. 805 JSR FLAS
  161. 810 ;
  162. 815 P7A LDA #[179]XLAL:LDX #[177]XLAL:JSR EOO
  163. 820 BNE P8
  164. 825 INC YES[170]1;  SHOW LAST [188][145]
  165. 830 ;
  166. 835 ;[172][172][172][172] PASSW[176]DS
  167. 840 ;
  168. 845 P8 LDA #[179]XLAP:LDX #[177]XLAP:JSR EOO
  169. 850 BNE PK
  170. 855 INC YES[170]2
  171. 860 ;
  172. 865 ;[172][172][172][172] STATUS
  173. 870 ;
  174. 875 PK LDA #[179]XLAS:LDX #[177]XLAS:JSR EOO
  175. 880 BNE PL
  176. 885 INC YES[170]3
  177. 890 ;
  178. 895 ;[172][172][172][172] ACCESS
  179. 900 ;
  180. 905 PL LDA #[179]XLAG:LDX #[177]XLAG:JSR EOO
  181. 910 BNE PM
  182. 915 INC YES[170]4
  183. 920 ;
  184. 925 ;[172][172][172][172] [155] FROM [128]
  185. 930 ;
  186. 935 PM LDA YES; IS THIS JUST [145]E USER
  187. 940 BNE PY
  188. 945 ;
  189. 950 LDA #[179]XLFE:LDX #[177]XLFE:JSR EOO
  190. 955 BNE PN
  191. 960 ;
  192. 965 LDA SERCH[170]1:STA SERCH
  193. 970 ;
  194. 975 LDA #45
  195. 980 .BYTE 44
  196. 985 PN LDA #43
  197. 990 STA MODE;   [129]E[173]BACKWARD
  198. 995 ;
  199. 1000 ;[172][172][172][172][172] NOW PROCESS SELECTI[145]S
  200. 1005 ;
  201. 1010 PY JSR POK; [161] [131] INTO BUFFER
  202. 1015 ;
  203. 1020 PZ JSR RET2
  204. 1025 LDY SERCH:LDA #0:JSR ROMNUM
  205. 1030 P1P LDY TRY:CPY #12:BEQ P2P
  206. 1035 JSR SPC:INC TRY:BNE P1P
  207. 1040 P2P LDA #58:JSR CHAR:JSR PHDL
  208. 1045 JSR BRIK:BCS P40
  209. 1050 ;
  210. 1055 LDA YES[170]2:BEQ P30
  211. 1060 JSR PPSW:JSR BRIK:BCS P40
  212. 1065 ;
  213. 1070 P30 LDA YES[170]1:BEQ P31
  214. 1075 JSR PLLO:JSR BRIK:BCS P40
  215. 1080 ;
  216. 1085 P31 LDA YES[170]3:BEQ P32
  217. 1090 JSR PLAC:JSR BRIK:BCS P40
  218. 1095 ;
  219. 1100 P32 LDA YES[170]4:BEQ P33
  220. 1105 JSR PLOC:JSR BRIK:BCS P40
  221. 1110 ;
  222. 1115 P33 LDA YES[170]5:BEQ P33A
  223. 1120 RTS
  224. 1125 P33A JSR P35:BCS P36
  225. 1130 ;
  226. 1135 BCC PY
  227. 1140 ;
  228. 1145 P40 LDA #0:STA MODE
  229. 1150 LDA YES[170]5:BEQ P35
  230. 1155 RTS
  231. 1160 ;
  232. 1165 ;[172][172][172][172] PROCESS MODE
  233. 1170 ;
  234. 1175 P35 LDA MODE:BNE PU
  235. 1180 P36 JSR ANY:JMP UDAT
  236. 1185 ;
  237. 1190 PU CMP #43:BEQ PV
  238. 1195 CMP #45:BNE P36
  239. 1200 ;
  240. 1205 DEC SERCH:BEQ PWA
  241. 1210 ;
  242. 1215 PW CLC:RTS
  243. 1220 PWA SEC:RTS
  244. 1225 ;
  245. 1230 PV LDA SERCH:CMP SERCH[170]1:BEQ PWA
  246. 1235 INC SERCH:BNE PW
  247. 1240 ;
  248. 1245 ;[172][172][172][172] [161] USER [131]
  249. 1250 ;
  250. 1255 POK LDA UNUM:STA MIN
  251. 1260 LDA SERCH:STA UNUM
  252. 1265 ;
  253. 1270 LDX #1:STX R3[170]4
  254. 1275 JSR RPASS:LDA MIN:STA UNUM
  255. 1280 LDX #0:STX R3[170]4:RTS
  256. 1285 ;
  257. 1290 ;[172][172][172][172] PROCESS AB[176]TS HERE
  258. 1295 ;
  259. 1300 BRIK JSR RATF
  260. 1305 JSR BROK:LDA RATS:BEQ P99
  261. 1310 SEC:RTS
  262. 1315 P99 CLC:RTS
  263. 1320 ;
  264. 1325 ;[172][172][172][172] FIND LAST USER NUMBER
  265. 1330 ;
  266. 1335 ; FLAS WILL [142] HIGHEST USER
  267. 1340 ; IN BUFFER IN X [175] [185]TI[145] OF
  268. 1345 ; BLOCK IN $FB[173]C. CALLER SHOULD
  269. 1350 ; INCREASE X BY 1.
  270. 1355 ;
  271. 1360 FLAS LDA #160:STA $FC
  272. 1365 LDA #0:STA $FB:TAX
  273. 1370 ;
  274. 1375 JSR BASOFF
  275. 1380 ;
  276. 1385 PO LDY #0:LDA ($FB),Y:BEQ PQ
  277. 1390 LDA $FB:CLC:ADC #32:STA $FB
  278. 1395 JSR AFC:INX:STX SERCH[170]1
  279. 1400 CPX #250:BNE PO
  280. 1405 JSR BAS[145]:SEC:RTS
  281. 1410 ;
  282. 1415 PQ JSR BAS[145]:CLC:RTS
  283. 1420 ;
  284. 1425 ;[172][172][172] ASST [158]OP[173]USER [131]
  285. 1430 ;
  286. 1435 P1G LDX #64:STX PTEK
  287. 1440 LDX #128:STX PTEK[170]1:JMP SECURITY
  288. 1445 ;
  289. 1450 ;[172][172][172][172][172]
  290. 1455 ;
  291. 1460 YES .BYTE 0 0 0 0 0 0 0 0
  292. 1465 ;.
  293. 1470 ;[172][172][172][172] SHOW USER [131] *****
  294. 1475 ;
  295. 1480 ;[172][172] SHOW H[175]LE[173]DL CREDITS[173]TIME LIMIT
  296. 1485 ;
  297. 1490 PHDL LDA #8:LDX #19
  298. 1495 JSR PSST:JSR SHTL:JMP PULD
  299. 1500 ;
  300. 1505 ;[172][172][172][172] SHOW PASSW[176]D
  301. 1510 ;
  302. 1515 PPSW LDA #[179]XYPS:LDX #[177]XYPS
  303. 1520 JSR STRING
  304. 1525 LDA #0:LDX #8:JMP PSST
  305. 1530 ;
  306. 1535 ;[172][172][172][172] SHOW LAST [188][145]
  307. 1540 ;
  308. 1545 PLLO LDA #[179]XYLO:LDX #[177]XYLO
  309. 1550 JSR STRING
  310. 1555 ;
  311. 1560 LDY #27
  312. 1565 LDA UBFR,Y:STA M[145]TH
  313. 1570 INY:LDA UBFR,Y:STA DATE
  314. 1575 INY:LDA UBFR,Y:STA YEAR
  315. 1580 JMP U0
  316. 1585 ;
  317. 1590 ;[172][172][172][172][172] SHOW STATUS LEVELS
  318. 1595 ;
  319. 1600 PLAC LDA #[179]XTAT:LDX #[177]XTAT
  320. 1605 JSR STRING
  321. 1610 LDA UBFR[170]20:CMP #255:BEQ P10
  322. 1615 CMP #127:BEQ P11
  323. 1620 CMP #63:BEQ P12
  324. 1625 CMP #31:BEQ P13
  325. 1630 CMP #15:BEQ P14
  326. 1635 CMP #7:BEQ P15
  327. 1640 CMP #3:BEQ P16
  328. 1645 ;
  329. 1650 P98 LDA #[179]LEV5:LDX #[177]LEV5:BNE P17
  330. 1655 P16 LDA #[179]LEV4:LDX #[177]LEV4:BNE P17
  331. 1660 P15 LDA #[179]LEV3:LDX #[177]LEV3:BNE P17
  332. 1665 P14 LDA #[179]LEV2:LDX #[177]LEV2:BNE P17
  333. 1670 P13 LDA #[179]LEV1:LDX #[177]LEV1:BNE P17
  334. 1675 P12 LDA #[179]SGSY:LDX #[177]SGSY:BNE P17
  335. 1680 P11 LDA #[179]A[158]:LDX #[177]A[158]:BNE P17
  336. 1685 P10 LDA #[179][158]O:LDX #[177][158]O
  337. 1690 P17 JMP STRING
  338. 1695 ;
  339. 1700 ;[172][172][172][172] SHOW ACCESS LEVELS
  340. 1705 ;
  341. 1710 PLOC JSR RET1:JSR TABT
  342. 1715 LDA #[179]XACS:LDX #[177]XACS:JSR STRING
  343. 1720 LDA UBFR[170]21:[175] #128:BEQ P18
  344. 1725 JSR TABT:LDA #[179]TUD:LDX #[177]TUD:JSR P25
  345. 1730 P18 LDA UBFR[170]21:[175] #64:BEQ P27
  346. 1735 JSR TABT:LDA #[179]TLIB:LDX #[177]TLIB:JSR P25
  347. 1740 P27 LDA UBFR[170]21:[175] #32:BEQ P19
  348. 1745 JSR TABT:LDA #[179]TSIG:LDX #[177]TSIG:JSR P25
  349. 1750 P19 LDA UBFR[170]21:[175] #16:BEQ P20
  350. 1755 JSR TABT:LDA #[179]TMAL:LDX #[177]TMAL:JSR P25
  351. 1760 P20 LDA UBFR[170]21:[175] #8:BEQ P21
  352. 1765 JSR TABT:LDA #[179]TMAG:LDX #[177]TMAG:JSR P25
  353. 1770 P21 LDA UBFR[170]21:[175] #4:BEQ P22
  354. 1775 JSR TABT:LDA #[179]TXFR:LDX #[177]TXFR:JSR P25
  355. 1780 P22 LDA UBFR[170]21:[175] #2:BEQ P23
  356. 1785 JSR TABT:LDA #[179]TADV:LDX #[177]TADV:JSR P25
  357. 1790 P23 LDA UBFR[170]21:[175] #1:BEQ P28
  358. 1795 ;
  359. 1800 P24 JSR TABT:LDA #[179]TBBS:LDX #[177]TBBS
  360. 1805 P25 JSR STRING
  361. 1810 P28 JMP RET1
  362. 1815 ;
  363. 1820 ;[172][172][172][172] DL CREDITS
  364. 1825 ;
  365. 1830 PULD LDA #[179]XLBC:LDX #[177]XLBC
  366. 1835 STX RATS:JSR STRING
  367. 1840 LDY UBFR[170]22:LDA UBFR[170]23
  368. 1845 JSR ROMNUM:JMP RET1
  369. 1850 ;
  370. 1855 ;[172][172][172][172][172] SHOW TIME LIMIT
  371. 1860 ;
  372. 1865 SHTL LDA UBFR[170]26:JSR [198]I
  373. 1870 LDA HUNS:STA XTIL[170]13
  374. 1875 LDA TENS:STA XTIL[170]14
  375. 1880 LDA [145]ES:STA XTIL[170]15
  376. 1885 LDA #[179]XTIL:LDX #[177]XTIL:STX RATS
  377. 1890 JMP STRING
  378. 1895 ;
  379. 1900 ;[172][172][172][172] SHOW FIELDS
  380. 1905 ;
  381. 1910 PSST STA BEG:STX BEG[170]1:LDX #0
  382. 1915 P1A LDY BEG:CPY BEG[170]1:BEQ PX
  383. 1920 LDA UBFR,Y:BEQ PX
  384. 1925 JSR CHAR:INC BEG:BNE P1A
  385. 1930 PX JMP RET1
  386. 1935 ;
  387. 1940 ;[172][172][172][172] TAB [129] ACCESS LEVELS
  388. 1945 ;
  389. 1950 TABT LDA #[179]XTBC:LDX #[177]XTBC:STX RATS
  390. 1955 JMP STRING
  391. 1960 ;
  392. 1965 ;[172][172][172][172]
  393. 1970 XYLO .BYTE "(null)AST (null)OG (null)N ":.BYTE 58 0
  394. 1975 XACS .BYTE "** ATNCCESS (null)O **":.BYTE 13 13 0
  395. 1980 XTAT .BYTE "(null)TATUS      ":.BYTE 58 0
  396. 1985 XTBC .BYTE "            ":.BYTE 58 0
  397. 1990 XLBC .BYTE "STR$(null) LENREDITS  ":.BYTE 58 0
  398. 1995 XTIL .BYTE "(null)IME (null)IMIT  ":.BYTE 58:.BYTE "000 (null)INUTES":.BYTE 13 0
  399. 2000 ;
  400. 2005 XYPS .BYTE "(null)ASSWORD    ":.BYTE 58 0
  401. 2010 .FILE 0:Q.D[155]
  402.