jargon

"token fbc.bas"

Sep 20th, 2020
1,102
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. #lang "fb"
  2.  
  3. '"Token FBC.BAS" is supposed to scan a string for collisions with a list of dynamic length delimiters in the form of a token by index or otherwise the count of such.
  4.  
  5. #define  __DEBUG_TOKEN__
  6.  
  7. 'Token fbc routines by Tim Keal & Mysoft
  8.  
  9. declare sub token_test()
  10.  
  11. declare sub token_by_delimiter(buffer as string, sep() as string, s() as long, byref o as long, byref d as long)
  12.  
  13. declare function token_count(subject as string, sep() as string, index as string="ct") as long
  14.  
  15. declare function token_by_index(subject as string, sep() as string, index as string="1") as string
  16.  
  17. declare function token overload (subject as string, sep() as string, index as string="1") as string
  18.  
  19. declare function token(subject as string, sep as string=",", index as string="1") as string
  20.  
  21. token_test
  22.  
  23. sub token_test()
  24.  
  25.     dim as string subject, sep, index
  26.  
  27.     do
  28.  
  29.         input "subject:", subject
  30.        
  31.         if len(subject)=0 then
  32.             subject="hello world!"
  33.             print "subject:"; subject
  34.         end if
  35.        
  36.         if subject = "exit" then exit do
  37.        
  38.         input "sep:", sep
  39.         input "index:", index  
  40.        
  41.         print "token:";token(subject, sep, index)
  42.         print "---"
  43.  
  44.     loop
  45.  
  46. end sub
  47.  
  48.  
  49. sub token_by_delimiter(buffer as string, sep() as string, s() as long, byref o as long,byref d as long)
  50.    
  51.     dim as long n
  52.    
  53.     redim as long s(lbound(sep, 1) to ubound(sep, 1))
  54.    
  55.     for n = lbound(sep, 1) to ubound(sep, 1)
  56.         s(n) = instr(1, buffer, sep(n))
  57.     next n
  58.  
  59.     d = lbound(sep, 1)
  60.  
  61.     for n = lbound(sep, 1) to ubound(sep, 1)
  62.         if s(n) <= s(d) and s(n) > 0 then
  63.        
  64.             o = s(n)
  65.             d = n
  66.  
  67.         end if
  68.     next n
  69.    
  70. end sub
  71.  
  72. function token_count(subject as string, sep() as string, index as string="ct") as long
  73.  
  74.     dim as string buffer, Ln, c, tok
  75.     dim as long o, t, i, n, d
  76.     dim as long s(lbound(sep, 1) to ubound(sep, 1))
  77.    
  78.     buffer = subject
  79.    
  80.     t = 0
  81.        
  82.     do while o <> 0
  83.            
  84.         c = inkey : if c = chr(27) then exit do
  85.        
  86.         t = t + 1
  87.        
  88.         token_by_delimiter buffer, sep(), s(), o, d
  89.        
  90.         if o > len(buffer) then
  91.             tok = buffer
  92.             o = 0
  93.             exit do
  94.         end if
  95.            
  96.         Ln = left(buffer, o - 1)
  97.            
  98.         #ifdef  __DEBUG_TOKEN__
  99.             print Ln;",";
  100.         #endif
  101.            
  102.         if o > 0 then
  103.             buffer = mid(buffer,o + len(sep(d)))
  104.         else
  105.             buffer = space(0)
  106.         end if
  107.        
  108.         #ifdef  __DEBUG_TOKEN__
  109.             print "t:";t;",o:";o;",sz:";len(buffer)
  110.         #endif
  111.        
  112.         if (o = 0) or (len(buffer) = 0) then exit do
  113.        
  114.     loop
  115.    
  116.     token_count=t
  117.    
  118. end function
  119.  
  120. function token_by_index(subject as string, sep() as string, index as string="1") as string
  121.    
  122.     dim as string buffer, Ln, c, tok
  123.     dim as long o, t, i, n, d
  124.     dim as long s(lbound(sep, 1) to ubound(sep, 1))
  125.    
  126.     buffer = subject
  127.  
  128.     t = 0
  129.        
  130.     do
  131.         c = inkey : if c = chr(27) then exit do
  132.            
  133.         if len(buffer)=0 then exit do
  134.  
  135.         t = t + 1
  136.  
  137.         token_by_delimiter buffer, sep(), s(), o, d
  138.            
  139.         Ln = left(buffer, o - 1)
  140.            
  141.         if o > 0 then
  142.             Ln = left(buffer, o - 1)
  143.         else
  144.             Ln = buffer
  145.         end if
  146.            
  147.         if o > len(buffer) then
  148.             tok = buffer
  149.             o = 0
  150.             exit do
  151.         end if
  152.  
  153.         if o > 0 then
  154.             buffer = mid(buffer,o + len(sep(d)))
  155.         else
  156.             buffer = space(0)
  157.         end if
  158.        
  159.         #ifdef  __DEBUG_TOKEN__
  160.             print "t:";t;",o:";o;",sz:";len(buffer)
  161.         #endif
  162.         if (t = i) or (o = 0) or (len(buffer) = 0) then exit do
  163.            
  164.     loop
  165.        
  166.     token_by_index = Ln
  167.        
  168. end function
  169.  
  170. function token overload (subject as string, sep() as string, index as string="1") as string
  171.     dim as string buffer, Ln, c, tok
  172.     dim as long o, t, i, n, d
  173.     dim as long s(lbound(sep, 1) to ubound(sep, 1))
  174.    
  175.     buffer = subject
  176.  
  177.     if index="ct" then
  178.         i=0
  179.     else
  180.         i=val(index)
  181.     end if
  182.    
  183.     o = len(buffer)+1
  184.  
  185.     select case i
  186.  
  187.     case is > 0
  188.        
  189.         tok = token_by_index(subject, sep(), index)
  190.  
  191.     case is = 0
  192.                
  193.         tok = str(token_count(subject, sep(), "ct"))
  194.    
  195.     case else
  196.        
  197.         tok = space(0)
  198.        
  199.     end select
  200.    
  201.     #ifdef  __DEBUG_TOKEN__
  202.         print "tok:";tok
  203.     #endif
  204.    
  205.     token = tok
  206.  
  207. end function
  208.  
  209. function token(subject as string, sep as string=",", index as string="1") as string
  210.  
  211.   dim as string sTemp(0 to 0) : sTemp(0) = sep
  212.  
  213.   return token(subject, sTemp(), index)
  214.  
  215. end function
  216.  
  217.  
RAW Paste Data