home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 2 BBS / 02-BBS.zip / tmbnk210.zip / TIMEBANK.CMD < prev   
OS/2 REXX Batch file  |  1992-09-28  |  13KB  |  327 lines
  1. /* */
  2. /*                   TimeBank Version 2.01
  3.                        Rexx CMD file for a Time Bank for Maximus
  4.                                   by Edward Owens
  5.                                 of The Looking Glass
  6.                                   FidoNet 1:123/81
  7.  
  8. To run put the following line in your MENU.CTL file where you want it:
  9.  
  10. ReRead     Xtern_Run       TimeBank.cmd_%K_%P     Normal "TimeBank"
  11.  
  12. Then replace the bbs and sysop variables immediately below  and put
  13. this CMD file in your Maximus directory.  You may modify this in any way
  14. your little heart's desires but do not distribute once modified.  This is Freeware, there is no charge for it and I assume no responsibility for any
  15. damage it may do.  Have fun.*/
  16. echo off
  17. SIGNAL ON SYNTAX NAME usergone /* if remote & user hangsup, goto usergone. */
  18. CALL init                      /* register extensions with REXX */  
  19. rc = RxAnsiInit()              /* Set up ANSI variables */
  20. ARG nodenum Commhndl
  21. IF Commhndl ¬= '' THEN         /* If remote user */
  22.    rc = RxMode(MIXED,Commhndl) /* set mode to mixed */
  23. ELSE                   /* but if local */
  24.    rc = RxMouse(ON)            /* turn on mouse support */
  25. bbs="The Looking Glass"  /* Replace with the name of your bbs */
  26. sysop="Fast ED's" /* Replace with your name or handle */
  27. maxtime=120  /* Maximum amount of time on account */
  28. deptime=30   /* Maximum time deposit per day */
  29. withtime=30   /* Maximum time withdrawal per day */
  30. maxbytes=3000   /* Maximum Kbytes on account  */
  31. depbytes=300   /* Maximum Kbytes deposit per day  */
  32. withbytes=300   /* Maximum Kbytes withdrawal per day  */
  33. timeint=10   /* Interest rate per 30 days on time accounts  */
  34. byteint=10   /* Interest rate per 30 days on byte accounts  */
  35. /*  userfile='lastuser.bbs'   */
  36. userfile=INSERT(nodenum,'lastus.bbs',6)  /* Replace with above line if single node */
  37. say testestetsets
  38. rc=RXPUTCHARS(cls)
  39. rc=RXGOTO(2,24)
  40. rc=RXPUTCHARS(cyan'********************************')
  41. rc=RXGOTO(3,24)
  42. rc=RXPUTCHARS(cyan'*'yellow'     Welcome to TimeBank      'cyan'*')
  43. rc=RXGOTO(4,24)
  44. rc=RXPUTCHARS(cyan'*'yellow'       by Edward Owens        'cyan'*')
  45. rc=RXGOTO(5,24)
  46. rc=RXPUTCHARS(cyan'*'yellow'      FidoNet  1:123/81       'cyan'*')
  47. rc=RXGOTO(6,24)
  48. rc=RXPUTCHARS(cyan'*'yellow'   Written in REXX for OS/2   'cyan'*')
  49. rc=RXGOTO(7,24)
  50. rc=RXPUTCHARS(cyan'********************************')
  51. rc=RXGOTO(15,1)
  52. rc=RXPUTCHARS(green'Reading account information.......')
  53. bankfile='timebank.dat'
  54. usedbytes=0
  55. privbytes=0
  56. position=1
  57. tempname=STRIP(CHARIN(userfile,1,36),,'00'x)
  58. name=tempname
  59. if \(SUBWORD(tempname,3,1)='') then
  60.   name=SUBWORD(tempname,1,1)' 'SUBWORD(tempname,2,1)SUBWORD(tempname,3,1)
  61. timeleft=C2D(CHARIN(userfile,111,1)) + (C2D(CHARIN(userfile,112,1)) * 256)
  62. priv=9-C2D(CHARIN(userfile,141,1))
  63. if priv=-1 then priv=0
  64. if priv<-1 then priv=10
  65. do x=212 to 211 by -1
  66.    usedbytes=(usedbytes * 256) + C2D(CHARIN(userfile,x,1))
  67. end  /* do */
  68. call LINEOUT(userfile)
  69. if usedbytes>32767 then usedbytes=usedbytes-65536
  70. do x=325+(priv*14) to 324+(priv*14) by -1
  71.    privbytes=(privbytes * 256) + C2D(CHARIN('max.prm',x,1))
  72. end  /* do */
  73. call LINEOUT('max.prm')
  74. bytes=privbytes-usedbytes
  75. num=0
  76. DO UNTIL (name=SUBWORD(acct.num,1,2)) | (LINES(bankfile)=0)
  77.    num=num + 1   
  78.    acct.num=LINEIN(bankfile)
  79. end /* do */
  80. if (LINES(bankfile)=0) & \(name = SUBWORD(acct.num,1,2)) then do
  81.    banktime=0
  82.    bankbytes=0
  83.    ttime=withtime
  84.    tbytes=withbytes
  85.    okfile=LINEOUT(bankfile,name DATE(S) banktime bankbytes withtime withbytes)
  86.    call LINEOUT(bankfile)
  87. end /* if */
  88. else  do
  89.    call LINEOUT(bankfile)
  90.    banktime=WORD(acct.num,4)
  91.    bankbytes=WORD(acct.num,5)
  92.    if DATE(S) = WORD(acct.num,3) then do
  93.       ttime=WORD(acct.num,6)
  94.       if ttime='' then ttime
  95.       tbytes=WORD(acct.num,7)
  96.       deptime=deptime+withtime-ttime
  97.       withtime=ttime
  98.       depbytes=depbytes+withbytes-tbytes
  99.       withbytes=tbytes
  100.    end /* if */
  101.    else do
  102.       day=WORD(acct.num,3)
  103.       today=DATE(S)
  104.       
  105. days=((LEFT(today,4)-LEFT(day,4))*360)+((SUBSTR(today,5,2)-SUBSTR(day,5,2))*30)+RIGHT(today,2)-RIGHT(day,2)
  106.       inttime=((days*banktime*timeint)%3000)
  107.       intbytes=((days*bankbytes*byteint)%3000)
  108.       banktime=banktime+inttime
  109.       bankbytes=bankbytes+intbytes
  110.       rc=RXGOTO(17,1) 
  111.       rc=RXPUTCHARS(red'You have earned'yellow inttime red'since last time on for a balance of'cyan banktime)
  112.       rc=RXGOTO(18,1) 
  113.       rc=RXPUTCHARS(red'You have earned'yellow intbytes red'since last time on for a balance of'cyan bankbytes)
  114.       rc=RXGOTO(20,1)
  115.       rc=RXPUTCHARS(magenta'Press any key for menu')
  116.       rc=RXGOTO(20,24)
  117.       rc=RXGETCHAR()
  118.    end /* else */
  119. end /* else */
  120. rc=RXPUTCHARS(cls intense)
  121. rc=RXPUTCHARS(cyan"    Welcome"magenta name cyan"to"magenta sysop cyan"Time Bank for Maximus OS/2")
  122. rc=RXGOTO(4,27)
  123. rc=RXPUTCHARS(white"D"magenta"eposit time")
  124. rc=RXGOTO(5,27)
  125. rc=RXPUTCHARS(white"W"magenta"ithdraw time")
  126. rc=RXGOTO(6,27)
  127. rc=RXPUTCHARS(white"P"magenta"ut some Kbytes in")
  128. rc=RXGOTO(7,27)
  129. rc=RXPUTCHARS(white"G"magenta"et some Kbytes out")
  130. rc=RXGOTO(8,27)
  131. rc=RXPUTCHARS(white"S"magenta"peedy maximum deposits")
  132. rc=RXGOTO(9,27)
  133. rc=RXPUTCHARS(white"Q"magenta"uit back to "bbs)
  134. rc=RXGOTO(15,25)
  135. rc=RXPUTCHARS(cyan'What would you like to do?'white)
  136. DO UNTIL (choice='Q') | (choice='q')
  137. rc=RXGOTO(17,9)
  138. rc=RXPUTCHARS('                                                     ')
  139. rc=RXGOTO(18,9)
  140. rc=RXPUTCHARS('                                                     ')
  141. rc=RXGOTO(19,9)
  142. rc=RXPUTCHARS('                                                     ')
  143. rc=RXGOTO(12,10)
  144. rc=RXPUTCHARS(yellow'You have'white banktime yellow'minutes on account and'white timeleft yellow'minutes left on BBS    ')
  145. rc=RXGOTO(13,10)
  146. rc=RXPUTCHARS(yellow'You have'white bankbytes yellow'Kbytes on account and'white bytes yellow'Kbytes left on BBS    'white)
  147. rc=RXGOTO(15,52)
  148. choice=RXGETCHAR()
  149. rc=RXPUTCHARS()
  150. rc=RXPUTCHARS()
  151. select
  152.    when (choice='D') | (choice='d') then do
  153.         rc=RXGOTO(17,9)
  154.         rc=RXPUTCHARS(magenta'You have'white banktime magenta'minutes on account and'white timeleft magenta'minutes left.')
  155.         rc=RXGOTO(18,9)
  156.         rc=RXPUTCHARS(cyan'Maximum on account is'yellow maxtime cyan'and maximum deposit is'yellow deptime)
  157.         rc=RXGOTO(19,9)
  158.     rc=RXPUTCHARS(red'How much would you like to deposit?'blue)
  159.         amount=RXGETCHARS(19,45,4,deptime)
  160.         if (datatype(amount,'W')) & (amount>0) then do
  161.            if amount>timeleft then amount=timeleft
  162.            if amount>deptime then amount=deptime
  163.            if (amount+banktime>maxtime) then amount=maxtime-banktime
  164.            timeleft=timeleft-amount
  165.            banktime=banktime+amount
  166.            deptime=deptime-amount
  167.            withtime=withtime+amount
  168.            if timeleft=0 then choice='Q'
  169.         end
  170.    end
  171.    when (choice='W') | (choice='w') then do
  172.         rc=RXGOTO(17,9)
  173.         rc=RXPUTCHARS(magenta'You have'white banktime magenta'minutes on account and'white timeleft magenta'minutes left.')
  174.         rc=RXGOTO(18,9)
  175.         rc=RXPUTCHARS(cyan'Maximum withdrawal is'yellow withtime)
  176.         rc=RXGOTO(19,9)
  177.     rc=RXPUTCHARS(red'How much would you like to withdraw?'blue)
  178.         amount=RXGETCHARS(19,46,4,withtime)
  179.         if (datatype(amount,'W')) & (amount>0) then do
  180.            if amount>banktime then amount=banktime
  181.            if amount>withtime then amount=withtime
  182.            deptime=deptime+amount
  183.            withtime=withtime-amount
  184.            timeleft=timeleft+amount
  185.            banktime=banktime-amount
  186.         end
  187.    end
  188.    when (choice='P') | (choice='p') then do
  189.         rc=RXGOTO(17,9)
  190.         rc=RXPUTCHARS(magenta'You have'white bankbytes magenta'Kbytes on account and'white bytes magenta'Kbytes left.')
  191.         rc=RXGOTO(18,9)
  192.         rc=RXPUTCHARS(cyan'Maximum on account is'yellow maxbytes cyan'and maximum deposit is'yellow depbytes)
  193.         rc=RXGOTO(19,9)
  194.     rc=RXPUTCHARS(red'How much would you like to deposit?'blue)
  195.         amount=RXGETCHARS(19,45,5,depbytes)
  196.         if (datatype(amount,'W')) & (amount>0) then do
  197.            if amount>bytes then amount=bytes
  198.            if amount>depbytes then amount=depbytes
  199.            if (amount+bankbytes>maxbytes) then amount=maxbytes-bankbytes
  200.            depbytes=depbytes-amount
  201.            withbytes=withbytes+amount
  202.            bytes=bytes-amount
  203.            bankbytes=bankbytes+amount
  204.         end
  205.    end
  206.    when (choice='G') | (choice='g') then do
  207.         rc=RXGOTO(17,9)
  208.         rc=RXPUTCHARS(magenta'You have'white bankbytes magenta'Kbytes on account and'white bytes magenta'Kbytes left.')
  209.         rc=RXGOTO(18,9)
  210.         rc=RXPUTCHARS(cyan'Maximum withdrawal is'yellow withbytes)
  211.         rc=RXGOTO(19,9)
  212.     rc=RXPUTCHARS(red'How much would you like to withdraw?'blue)
  213.         amount=RXGETCHARS(19,46,5,withbytes)
  214.         if (datatype(amount,'W')) & (amount>0) then do
  215.            if amount>bankbytes then amount=bankbytes
  216.            if amount>withbytes then amount=withbytes
  217.            depbytes=depbytes+amount
  218.            withbytes=withbytes-amount
  219.            bytes=bytes+amount
  220.            bankbytes=bankbytes-amount
  221.         end
  222.    end
  223.    when (choice='S') | (choice='s') then do
  224.         rc=RXGOTO(17,9)
  225.         rc=RXPUTCHARS('Making maximum time deposit and byte deposit')
  226.         if timeleft>deptime then amount=deptime
  227.         else amount=timeleft
  228.         if (amount+banktime>maxtime) then amount=maxtime-banktime
  229.         rc=RXGOTO(18,9)
  230.         rc=RXPUTCHARS('Deposited' amount 'minutes')
  231.         timeleft=timeleft-amount
  232.         banktime=banktime+amount
  233.         deptime=deptime-amount
  234.         withtime=withtime+amount
  235.         if bytes>depbytes then amount=depbytes
  236.         else amount=bytes
  237.         if (amount+bankbytes>maxbytes) then amount=maxbytes-bankbytes
  238.         rc=RXGOTO(19,9)
  239.         rc=RXPUTCHARS('Deposited' amount 'Kbytes')
  240.         depbytes=depbytes-amount
  241.         withbytes=withbytes+amount
  242.         bytes=bytes-amount
  243.         bankbytes=bankbytes+amount
  244.         choice='Q'
  245.    end
  246. otherwise NOP
  247. end  /* select */
  248. end
  249. rc=RXGOTO(21,1)
  250. rc=RXPUTCHARS(cyan'Returning you to 'yellow bbs reset)
  251. timeout = d2c(timeleft//256)
  252. okfile = CHAROUT(userfile,timeout,111)
  253. timeout = d2c(timeleft%256)
  254. okfile = CHAROUT(userfile,timeout,112)
  255. usedbytes=privbytes-bytes
  256. bytesout=d2c(0)
  257. if usedbytes<0 then do
  258.    bytesout=d2c(255)
  259.    usedbytes=65536+usedbytes
  260. end
  261.    okfile=CHAROUT(userfile,bytesout,214)
  262.    okfile=CHAROUT(userfile,bytesout,213)
  263. do x=211 to 212 by 1
  264.    bytesout= d2c(usedbytes//256)
  265.    usedbytes= usedbytes%256
  266.    okfile = CHAROUT(userfile,bytesout,x)
  267. end  /* do */
  268. 'ren' bankfile 'timebank.tmp'
  269. DO UNTIL (LINES('timebank.tmp')=0)
  270.    account=LINEIN('timebank.tmp')
  271.    if (name=SUBWORD(account,1,2)) then 
  272.       okfile=LINEOUT(bankfile,name DATE(S) banktime bankbytes withtime withbytes)
  273.    else okfile=LINEOUT(bankfile, account)
  274. end /* do */
  275. call LINEOUT(bankfile)
  276. call LINEOUT('timebank.tmp')
  277. 'del timebank.tmp'
  278. rc=RXPUTCHARS(cls)
  279. CALL term
  280. return
  281.  
  282. /* --------------------------------------------------------------------- */
  283. /* Remote user has hung up - tell host and quit                          */
  284. /* --------------------------------------------------------------------- */
  285. usergone:
  286.   IF lastkey = 'USER GONE' THEN
  287.      SAY 'User gone'
  288.   ELSE
  289.      SAY 'Bug in your Rexx procedure'
  290.   CALL term
  291.   RETURN
  292.  
  293. /* --------------------------------------------------------------------- */
  294. /* Register all the functions to REXX                                    */
  295. /* --------------------------------------------------------------------- */
  296. init : procedure
  297. CALL RxFuncAdd 'RXANSIINIT','RXANSI','RXANSIINIT'
  298. CALL RxFuncAdd 'RXGOTO',    'RXANSI','RXGOTO'
  299. CALL RxFuncAdd 'RXMODE',    'RXANSI','RXMODE'
  300. CALL RxFuncAdd 'RXMOUSE',   'RXANSI','RXMOUSE'
  301. CALL RxFuncAdd 'RXLINE',    'RXANSI','RXLINE'
  302. CALL RxFuncAdd 'RXLINETYPE','RXANSI','RXLINETYPE'
  303. CALL RxFuncAdd 'RXHMENU',   'RXANSI','RXHMENU'
  304. CALL RxFuncAdd 'RXVMENU',   'RXANSI','RXVMENU'
  305. CALL RxFuncAdd 'RXBOX',     'RXANSI','RXBOX'
  306. CALL RxFuncAdd 'RXGETCHAR', 'RXANSI','RXGETCHAR'
  307. CALL RxFuncAdd 'RXGETCHARS','RXANSI','RXGETCHARS'
  308. CALL RxFuncAdd 'RXPUTCHARS','RXANSI','RXPUTCHARS'
  309. RETURN
  310.  
  311. /* --------------------------------------------------------------------- */
  312. /* Deregister all the functions from REXX                                */
  313. /* --------------------------------------------------------------------- */
  314. term : procedure
  315. CALL RxFuncDrop 'RXANSIINIT'
  316. CALL RxFuncDrop 'RXGOTO'
  317. CALL RxFuncDrop 'RXMODE'
  318. CALL RxFuncDrop 'RXMOUSE'
  319. CALL RxFuncDrop 'RXLINE'
  320. CALL RxFuncDrop 'RXLINETYPE'
  321. CALL RxFuncDrop 'RXHMENU'
  322. CALL RxFuncDrop 'RXBOX'
  323. CALL RxFuncDrop 'RXGETCHAR'
  324. CALL RxFuncDrop 'RXGETCHARS'
  325. CALL RxFuncDrop 'RXPUTCHARS'
  326. RETURN
  327.