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