home *** CD-ROM | disk | FTP | other *** search
/ 8bitfiles.net/archives / archives.tar / archives / genie-commodore-file-library / C64-128BBS / PROG950307.ARC / A / DATABASE2.MOD < prev    next >
Encoding:
Text File  |  2019-04-13  |  12.2 KB  |  577 lines
  1. ' ─╘╩-─ATABASE ═ODULE - PART 2
  2.  
  3. ' --- SUBROUTINES ----
  4.  
  5. "CHARIN"   JSR &C17D
  6.            BCC "CH00"
  7. "EXIT"     LDX 3
  8.            LDA 160
  9. "EX00"     STA (956),X
  10.            DEX
  11.            BPL "EX00"
  12.            LDX (".X.")
  13.            TXS
  14.            LDA 8
  15.            JSR "CLOSE"
  16.            LDA 1
  17.            JSR "CLOSE"
  18. "CH00"     RTS
  19.  
  20. "+CLRCHN"  JSR "CLRCHN"
  21.            LDX 2
  22.            JSR "CHKIN"
  23.            LDX 2
  24.            JSR "CHKOUT"
  25.            LDY 0
  26.            RTS
  27.  
  28. "POSITION" JSR "CLRCHN"
  29.            JSR "DISPPOS"
  30.            LDA ("REC-LO")
  31.            LDX 1
  32.            JSR "CHKOUT"
  33.            LDY 0
  34. "PO00"     LDA ("PTEXT"),Y
  35.            JSR "CHROUT"
  36.            INY
  37.            CPY 5
  38.            BNE "PO00"
  39. "GETER"    JSR "CLRCHN"
  40.            LDX 1
  41.            JSR "CHKIN"
  42.            JSR "CHRIN"
  43.            AND &0F
  44.            ASL
  45.            ASL
  46.            ASL
  47.            ASL
  48.            STA ("ER00")
  49.            JSR "CHRIN"
  50.            AND &0F
  51.            DF &09
  52. "ER00"     DF &00
  53.            STA ("ER00")
  54. "ER01"     JSR "CHRIN"
  55.            LDA ("KSTATUS")
  56.            BEQ "ER01"
  57.            JSR "CLRCHN"
  58.            LDA ("ER00")
  59.            RTS
  60.  
  61. "READ"     LDA $A
  62.            STA ("RDATBUFF")
  63.            JSR "POSITION"
  64.            BNE "R03"
  65.            LDX 8
  66.            JSR "CHKIN"
  67.            LDY 0
  68.            STY ("KSTATUS")
  69. "R00"      JSR "CHRIN"
  70.            STA ("RDATBUFF"),Y
  71.            INY
  72.            LDA ("KSTATUS")
  73.            BEQ "R00"
  74.            LDA 0
  75.            STA ("RDATBUFF"),Y
  76.            LDA ("RDATBUFF")
  77.            CMP $N
  78.            BEQ "R01"
  79.            CMP $V
  80.            BEQ "R01"
  81.            LDA $A
  82.            STA ("RDATBUFF")
  83.            JSR "R03"
  84. "R01"      JSR "+CLRCHN"
  85.            LDA 0
  86. "R02"      CLC
  87.            RTS
  88. "R03"      LDY 3
  89. "R04"      LDA (1023),Y
  90.            AND &7F
  91.            STA ("RDATBUFF"),Y
  92.            DEY
  93.            BNE "R04"
  94.            SEC
  95.            RTS
  96.  
  97. "WRITE"    LDA $N
  98.            LDX (1028)
  99.            CPX &D3
  100.            BNE "WR-ALT"
  101.            LDA $V
  102. "WR-ALT"   STA ("WDATBUFF")
  103.            JSR "GETVAR"
  104.            DF $X
  105.            DF &00
  106.            LDY 5
  107.            LDX 10
  108.            LDA &0D
  109.            STA ("WDATBUFF"),X
  110. "W001"     DEX
  111.            LDA ["TMP2L"],Y
  112.            STA ("WDATBUFF"),X
  113.            DEY
  114.            BPL "W001"
  115.            JSR "POSITION"
  116.            BEQ "W00"
  117.            CMP &50
  118.            BNE "W03"
  119. "W00"      LDX 8
  120.            JSR "CHKOUT"
  121.            LDY 0
  122. "W01"      LDA ("WDATBUFF"),Y
  123.            JSR "CHROUT"
  124.            INY
  125.            CPY ("RECLEN")
  126.            BNE "W01"
  127. "W02"      JSR "POSITION"
  128.            CMP &50
  129.            BEQ "W00"
  130. "W03"      CMP 0
  131.            RTS
  132.  
  133. "DISPPOS"  LDX 0
  134.            LDA ("REC-HI")
  135.            JSR "DISPHEX"
  136.            LDA ("REC-LO")
  137. "DISPHEX"  PHA
  138.            LSR
  139.            LSR
  140.            LSR
  141.            LSR
  142.            JSR "DH00"
  143.            PLA
  144.            AND &0F
  145. "DH00"     CMP 10
  146.            BCC "DH01"
  147.            ADC 6
  148. "DH01"     ORA 176
  149.            STA (1080),X
  150.            STA (956),X
  151.            INX
  152.            RTS
  153.  
  154. "FINDSET"  LDX 0
  155.            STX ("1STAVAIL")
  156.            STX ("1STAVAIH")
  157.            STX ("REC-HI")
  158.            STX ("REC-LO")
  159.            RTS
  160.  
  161. "FINDNEXT" LDY 0
  162.            STY ("FERROR")
  163.            INC ("REC-LO")
  164.            BNE "FN00"
  165.            INC ("REC-HI")
  166. "FN00"     JSR "READ"
  167.            BCC "FN000"
  168.            JMP "FN05"
  169. "FN000"    LDA ("RDATBUFF")
  170.            CMP $A
  171.            BNE "FN01"
  172.            LDA ("1STAVAIL")
  173.            ORA ("1STAVAIH")
  174.            BNE "FINDNEXT"
  175.            LDA ("REC-LO")
  176.            STA ("1STAVAIL")
  177.            LDA ("REC-HI")
  178.            STA ("1STAVAIH")
  179.            JMP "FINDNEXT"
  180. "FN01"     LDA ("CMD")
  181.            BNE "FN031"
  182.            LDX 11
  183. "FN02"     LDA ("WDATBUFF"),X
  184.            CMP ("RDATBUFF"),X
  185.            BEQ "FN03"
  186.            CMP &0D
  187.            BNE "FINDNEXT"
  188.            LDA ("CMD")
  189.            CMP 1
  190.            BCC "FINDNEXT"
  191.            BCS "FN06"
  192. "FN03"     INX
  193.            CMP &0D
  194.            BNE "FN02"
  195.            BEQ "FN030"
  196. "FN031"    LDA L"RDATBUF+"
  197.            STA (&9B)
  198.            LDA H"RDATBUF+"
  199.            STA (&9C)
  200. "FN033"    LDY 255
  201. "FN032"    INY
  202.            LDA (49152),Y
  203.            CMP $?
  204.            BEQ "FN032"
  205.            CMP $*
  206.            BEQ "FN030"
  207.            CMP &0D
  208.            BEQ "FN030"
  209.            EOR [&9B],Y
  210.            AND &7F
  211.            BEQ "FN032"
  212.            LDA [&9B],Y
  213.            BEQ "FINDNEXT"
  214.            INC (&9B)
  215.            BNE "FN033"
  216.            INC (&9C)
  217.            BNE "FN033"
  218. "FN030"    LDA ("CMD")
  219.            CMP 1
  220.            BCS "FN06"
  221.            LDA ("USERLOCK")
  222.            BEQ "FN06"
  223.            LDA (1028)
  224.            CMP &D3
  225.            BEQ "FN06"
  226.            LDX 3
  227. "FN04"     LDA (1023),X
  228.            AND &7F
  229.            CMP ("RDATBUFF"),X
  230.            BNE "FN08"
  231.            DEX
  232.            BNE "FN04"
  233.            BEQ "FN06"
  234. "FN08"     LDX 9
  235.            STX ("FERROR")
  236.            JSR "DISPTEXT"
  237. "FN07"     SEC
  238.            BCS "FN05"
  239. "FN06"     CLC
  240. "FN05"     PHP
  241.            LDA ("1STAVAIL")
  242.            ORA ("1STAVAIH")
  243.            BEQ "FN09"
  244.            LDA ("CMD")
  245.            BNE "FN09"
  246.            LDA ("1STAVAIL")
  247.            STA ("REC-LO")
  248.            LDA ("1STAVAIH")
  249.            STA ("REC-HI")
  250. "FN09"     PLP
  251.            RTS
  252.  
  253. "I-BS"     CPY 0
  254.            BEQ "I00"
  255. "I-BS00"   LDA &14
  256.            JSR "CHROUT"
  257.            DEY
  258.            JSR "FTEST"
  259.            BNE "I-BS"
  260.            BEQ "I00"
  261.  
  262. "I-CR"     CPY 0
  263.            BNE "I-CR00"
  264.            LDX ("MANDFLAG")
  265.            BNE "I00"
  266. "I-CR00"   LDA ["TMP2L"],Y
  267.            BEQ "I-CR01"
  268.            LDA &0D
  269.            STA ["TMP3L"],Y
  270.            INY
  271.            BNE "I-CR00"
  272. "I-CR01"   LDA &0D
  273.            STA ["TMP3L"],Y
  274.            JMP "CHROUT"
  275.  
  276. "INPUT"    JSR "+CLRCHN"
  277. "I00"      JSR "FTEST"
  278.            BEQ "I07"
  279.            LDA ["TMP2L"],Y
  280.            BEQ "I07"
  281.            STA ["TMP3L"],Y
  282.            JSR "CHROUT"
  283.            INY
  284.            BNE "I00"
  285. "I07"      LDA &0D
  286.            STA ["TMP3L"],Y
  287.            JSR "CHARIN"
  288.            CMP &0D      ' ├╥?
  289.            BEQ "I-CR"
  290.            CMP &14      ' ┬╙?
  291.            BEQ "I-BS"
  292.            CMP &20      ' ├ONTROL?
  293.            BCC "I00"
  294.            TAX
  295.            LDA ["TMP2L"],Y
  296.            AND &7F
  297.            BEQ "I00"    'END OF FIELD?
  298.            CMP $$       'ALPHANUMERIC?
  299.            BEQ "I05"
  300.            CMP $N       'NON-SPACE?
  301.            BNE "I01"
  302.            CPX $!
  303.            BCC "I00"
  304.            BCS "I05"
  305. "I01"      CMP $?       '┘ OR ╬?
  306.            BNE "I02"
  307.            TXA
  308.            AND &7F
  309.            CMP $N
  310.            BEQ "I05"
  311.            CMP $Y
  312.            BEQ "I05"
  313. "I000"     JMP "I00"
  314. "I02"      CMP $A       'ALPHA ONLY?
  315.            BNE "I03"
  316.            TXA
  317.            AND &7F
  318.            CMP $A
  319.            BCC "I000"
  320.            CMP $[
  321.            BCS "I000"
  322.            BCC "I05"
  323. "I03"      CMP $0       'NUMERIC ONLY?
  324.            BCC "I06"
  325.            CMP $:
  326.            BCS "I06"
  327.            STX ("I04")
  328.            DF &C9       ' ├═╨
  329. "I04"      DF &00
  330.            BCC "I000"
  331.            CPX $0
  332.            BCC "I000"
  333. "I05"      TXA
  334. "I06"      STA ["TMP3L"],Y
  335.            JSR "CHROUT"
  336.            INY
  337.            BNE "I000"
  338.  
  339. "FTEST"    LDX 14
  340. "FT00"     LDA ["TMP2L"],Y
  341.            AND &7F
  342.            CMP ("FIELDTST"),X
  343.            BEQ "FT01"
  344.            DEX
  345.            BPL "FT00"
  346. "FT01"     RTS
  347.  
  348. ' SETUP POINTERS TO FIELD NAME, FIELD
  349. '   FORMAT STRING, AND WRITE BUFFER.
  350.  
  351. "SETFIELD" JSR "+CLRCHN"
  352.            STY ("MANDFLAG")
  353.            STY ("PRIVATE")
  354.            LDA ("FIELDNUM")
  355.            CMP ("TOTFLDS")
  356.            BCS "SF09"
  357.            CLC
  358.            ADC 16
  359.            TAX
  360.            JSR "FINDTEXT"
  361.            LDY 255
  362. "SF00"     INY
  363.            LDA [100],Y
  364.            BEQ "SF03"
  365. "SF01"     CMP $+
  366.            BNE "SF02"
  367.            STA ("MANDFLAG")
  368.            BEQ "SF00"
  369. "SF02"     CMP $*
  370.            BNE "SF00"
  371.            STA ("PRIVATE")
  372.            BEQ "SF00"
  373. "SF03"     LDY 9
  374.            LDX ("FIELDNUM")
  375. "SF05"     INY
  376.            LDA ["INTH"],Y
  377.            BNE "SF05"
  378.            DEX
  379.            BNE "SF05"
  380. "SF06"     INY
  381.            STY ("RECPOS")
  382.            LDA L"WDATBUFF"
  383.            CLC
  384.            ADC ("RECPOS")
  385.            STA ("TMP3L")
  386.            LDA H"WDATBUFF"
  387.            STA ("TMP3H")
  388.            BCC "SF07"
  389.            INC ("TMP3H")
  390. "SF07"     LDA ("INTH")
  391.            CLC
  392.            ADC ("RECPOS")
  393.            STA ("TMP2L")
  394.            LDA ("INTL")
  395.            STA ("TMP2H")
  396.            BCC "SF08"
  397.            INC ("TMP2H")
  398. "SF08"     CLC
  399.            RTS
  400. "SF09"     SEC
  401.            RTS
  402.  
  403. "DSPFIELD" JSR "+CLRCHN"
  404.            LDY 255
  405. "DF00"     INY
  406.            LDA [100],Y
  407.            BEQ "DF01"
  408.            CMP $+
  409.            BEQ "DF00"
  410.            CMP $*
  411.            BEQ "DF00"
  412.            JSR "CHROUT"
  413.            BCC "DF00"
  414. "DF01"     RTS
  415.  
  416. "DISPTEXT" JSR "FINDTEXT"
  417.            JSR "+CLRCHN"
  418. "DT00"     LDA [100],Y
  419.            BEQ "DT01"
  420.            JSR "CHROUT"
  421.            INY
  422.            BNE "DT00"
  423. "DT01"     RTS
  424.  
  425. "FINDTEXT" LDA L"TEXT"
  426.            STA (100)
  427.            LDA H"TEXT"
  428.            STA (101)
  429.            LDY 0
  430. "FX00"     DEX
  431.            BMI "FX03"
  432. "FX01"     LDA [100],Y
  433.            INC (100)
  434.            BNE "FX02"
  435.            INC (101)
  436. "FX02"     CMP 0
  437.            BNE "FX01"
  438.            BEQ "FX00"
  439. "FX03"     RTS
  440.  
  441. "GETVAR"   PLA
  442.            STA ("TMP2L")
  443.            PLA
  444.            STA ("TMP2H")
  445.            INC ("TMP2L")
  446.            BNE "GV00"
  447.            INC ("TMP2H")
  448. "GV00"     LDA 2
  449.            CLC
  450.            ADC ("TMP2L")
  451.            STA ("GVJMPL")
  452.            LDA 0
  453.            ADC ("TMP2H")
  454.            STA ("GVJMPH")
  455.            LDA (&2D)
  456.            STA ("TMP3L")
  457.            LDA (&2E)
  458.            STA ("TMP3H")
  459. "GV01"     LDY 0
  460.            LDA ["TMP3L"],Y
  461.            CMP ["TMP2L"],Y
  462.            BNE "GV02"
  463.            INY
  464.            LDA ["TMP3L"],Y
  465.            EOR &80
  466.            CMP ["TMP2L"],Y
  467.            BEQ "GV03"
  468. "GV02"     LDA &07
  469.            CLC
  470.            ADC ("TMP3L")
  471.            STA ("TMP3L")
  472.            BCC "GV01"
  473.            INC ("TMP3H")
  474.            BNE "GV01"
  475. "GV03"     LDY 3
  476.            LDA ["TMP3L"],Y
  477.            STA ("TMP2L")
  478.            INY
  479.            LDA ["TMP3L"],Y
  480.            STA ("TMP2H")
  481.            DF &4C
  482. "GVJMPL"   DF &00
  483. "GVJMPH"   DF &00
  484.  
  485. ' DATA APPENDED TO THIS FILE IS IN THE
  486. ' FOLLOWING FORMAT:
  487. ' 
  488. '   TITLE PARAGRAPH WITH PROMPT
  489. '            (NULL TERMINATED)
  490. '   EDIT PROMPT (NULL TERMINATED)
  491. '   FIELD INFO
  492. '     A.  FIELDNAME (NULL TERMINATED)
  493. '     B.  FIELDDATA (NULL TERMINATED)
  494.  
  495. "DRIVE"    DF $A
  496. "FILENLEN" DF &0B
  497. "FILENAME" DF $BBS.DAT,L,
  498.            DF &70
  499.            DF $*********
  500. "TOTFLDS"  DF &05
  501. "OPTIONS"  DF $UDLSE
  502. "USERLOCK" DF &00
  503. "TEXT"     DF $╒PDATE
  504.            DF &0D0D
  505.            DF $╨LEASE ENTER THE FOLLOWING INFORMATION:
  506.            DF &0D0D00
  507.            DF $─ELETE
  508.            DF &0D00
  509.            DF $╠IST
  510.            DF &0D0D
  511.            DF $╙EARCH FOR:
  512.            DF &00
  513.            DF $╙EARCH
  514.            DF &0D0D
  515.            DF $╙EARCH FOR: 
  516.            DF &00
  517.            DF $┼XIT
  518.            DF &0D000D
  519.            DF $╔S THIS CORRECT? 
  520.            DF &00
  521.            DF $┘ES.
  522.            DF &0D0D
  523.            DF $╒PDATING DATABASE.  
  524.            DF $╨LEASE WAIT.
  525.            DF &0D00
  526.            DF $╬O.
  527.            DF &0D000D
  528.            DF $─ONE.
  529.            DF &0D000D
  530.            DF $╥ECORD EXISTS - 
  531.            DF $NO ACCESS.
  532.            DF &0D000D
  533.            DF $┴RE YOU SURE? 
  534.            DF &00
  535.            DF $─ELETING...
  536.            DF &0D00
  537.            DF $╙EARCHING...
  538.            DF &0D0D000D
  539.            DF $[╬]EXT / [┼]XIT
  540.            DF &0D000D
  541.            DF $[╬]EXT / [─]ELETE / [┼]XIT
  542.            DF &0D00
  543.            DF $┬┬╙ ╠ISTING ─ATABASE
  544.            DF &0D0D
  545.            DF $┼NTER YOUR SELECTION:
  546.            DF &0D
  547.            DF $[╒]PDATE / [─]ELETE / [╠]IST / [╙]EARCH / [┼]XIT
  548.            DF &0D3A00
  549.            DF $╨HONE ╬UMBER   ╬AME OF ┬
  550.            DF $┬╙              ╠OCATION
  551.            DF $                    ┬AUD
  552.            DF &200D
  553.            DF $ ├OMMENTS
  554.            DF &00
  555.            DF $+╨HONE (╪╪╪-╪╪╪-╪╪╪╪)
  556.            DF &0D3A00
  557.            DF $+╬AME OF ┬┬╙
  558.            DF &0D3A00
  559.            DF $*╠OCATION (├ITY & ╙TATE)
  560.            DF &0D3A00
  561.            DF $═AXIMUM ┬AUDRATE
  562.            DF &0D3A00
  563.            DF $├OMMENTS ABOUT THIS ┬┬╙
  564.            DF &0D3A00
  565.            DF $(999) 999-9999
  566.            DF &00
  567.            DF $N$$$$$$$$$$$$$$$$$$$$$$$
  568.            DF &00
  569.            DF $N$$$$$$$$$$$$$$$$$$$$$$$$$$
  570.            DF &00
  571.            DF $99999
  572.            DF &00
  573.            DF $$$$$$$$$$$$$$$$$$$$$$$$$$$$
  574.            DF &00
  575.            DF $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
  576.            DF &00
  577.