Advertisement
jargon

Keal's SEQ Database (v0x22)

Dec 17th, 2022
2,898
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1.  
  2.  
  3. Dim Shared As String SEQ_Out_Buffer
  4.  
  5. SEQ_Out_Buffer = ""
  6.  
  7. Dim Shared As Long SEQ_Text_Buffer_Count
  8.  
  9. SEQ_Text_Buffer_Count = 0
  10.  
  11. Declare Sub SEQ_Inc_Capacity( DB() As SEQ_Database, Counter As Long = 1 )
  12.  
  13. Declare Function SEQ_CRLF_Buffer(Buffer As String ) As String
  14.  
  15. Declare Sub SEQ_Digest_Word( DB() As SEQ_Database, Buffer As String = "" )
  16.  
  17. declare Sub SEQ_Bubble_Sort( DB() As SEQ_Database )
  18.  
  19. declare Function SEQ_Binary_Find( DB() As SEQ_Database, Request As string, byref WhereToAdd As Long=0 ) As Long
  20.  
  21. declare Function SEQ_Database_Query( DB() As SEQ_Database, Request As string ) As SEQ_Database
  22.  
  23. declare Function SEQ_Database_Set( DB() As SEQ_Database, sName As string, sValue As string ) As Long
  24.  
  25. declare Function SEQ_Database_Delete( DB() As SEQ_Database, sName As string ) As Long    
  26.  
  27. Declare Function DB_Query_Int( DB() As SEQ_Database, Request As String = "" ) As Long
  28.  
  29. #include once "./TPlus22/TPlus22 RGBA Macro.bas"
  30.  
  31. #include once "./TPlus22/TPlus22 Common Conversions.bas"
  32.  
  33. #include once "./TPlus22/TPlus22 File Support.bas"
  34.  
  35. #include once "./TPlus22/TPlus22 String Support.bas"
  36.  
  37. #include once "./TPlus22/TPlus22 WaitKey.bas"
  38.  
  39. #include once "./TPlus22/TPlus22 Func Support.bas"
  40.  
  41. #Include Once "./SEQ22/SEQ22 File IO.bas"
  42.  
  43. #Include Once "./SEQ22/SEQ22 Poll IO.bas"
  44.  
  45. #Include Once "./SEQ22/SEQ22 Display IO.bas"
  46.  
  47. Sub SEQ_Inc_Capacity( DB() As SEQ_Database, Counter As Long = 1 )
  48.  
  49.     Do While Not ( Counter = 0 )
  50.        
  51.         Select Case Counter
  52.         Case Is > 0
  53.  
  54.             If LBound( DB, 1 ) = 0 And UBound( DB, 1 ) = -1 Then
  55.  
  56.                 Redim DB( 0 To 0 )
  57.  
  58.             Else
  59.  
  60.                 Redim Preserve DB( LBound( DB, 1 ) To UBound( DB, 1 ) + 1 )
  61.  
  62.             End If
  63.  
  64.             Counter -= 1
  65.  
  66.         Case Is < 0
  67.  
  68.             If LBound( DB, 1 ) = 0 And UBound( DB, 1 ) = 0 Then
  69.  
  70.                 Erase DB
  71.  
  72.                 Exit Do
  73.  
  74.             Else
  75.  
  76.                 Redim Preserve DB( LBound( DB, 1 ) To UBound( DB, 1 ) - 1 )
  77.  
  78.             End If
  79.  
  80.             Counter += 1
  81.        
  82.         Case 0
  83.            
  84.             Exit Do
  85.            
  86.         End Select
  87.  
  88.     Loop
  89.  
  90. End Sub
  91.  
  92. Function SEQ_CRLF_Buffer(Buffer As String ) As String
  93.  
  94.     If Len(Buffer) > 0 Then
  95.  
  96.         Buffer &= CRLF
  97.  
  98.     End If
  99.  
  100.     Return Buffer
  101.  
  102. End Function
  103.  
  104. Sub SEQ_Digest_Word( DB() As SEQ_Database, Buffer As String = "" )
  105.  
  106.     Erase DB
  107.  
  108.     Do While Len( Buffer ) > 0
  109.  
  110.         If strpos( CRLF, Buffer ) < strpos( Chr(32), Buffer ) Then
  111.  
  112.             SEQ_Inc_Capacity( DB(), 1 )
  113.  
  114.             With DB( UBound( DB, 1 ) )
  115.  
  116.                 .Iterator = -1
  117.  
  118.                 .Label = Hex( UBound( DB, 1 ) + 1 )
  119.  
  120.                 .Value = Prefix( CRLF, Buffer )
  121.  
  122.             End With
  123.  
  124.             Buffer = Suffix( CRLF, Buffer )
  125.  
  126.             SEQ_Inc_Capacity( DB(), 1 )
  127.  
  128.             With DB( UBound( DB, 1 ) )
  129.  
  130.                 .Iterator = -1
  131.  
  132.                 .Label = Hex( UBound( DB, 1 ) + 1 )
  133.  
  134.                 .Value = "{% CRLF %}"
  135.  
  136.             End With
  137.  
  138.         Else
  139.  
  140.             SEQ_Inc_Capacity( DB(), 1 )
  141.  
  142.             With DB( UBound( DB, 1 ) )
  143.  
  144.                 .Iterator = -1
  145.  
  146.                 .Label = Hex( UBound( DB, 1 ) + 1 )
  147.  
  148.                 .Value = Prefix( Chr(32), Buffer )
  149.  
  150.             End With
  151.  
  152.             Buffer = Suffix( Chr(32), Buffer )
  153.  
  154.         End If
  155.  
  156.     Loop
  157.  
  158.     SEQ_Bubble_Sort( DB() )
  159.  
  160.     SEQ_DB_To_File( DB(), "./Assets (v0x22)/Words.SEQ" )
  161.  
  162. End Sub
  163.  
  164. Sub SEQ_Bubble_Sort( DB() As SEQ_Database )
  165.  
  166.     'Bubble
  167.    
  168.     If ( LBound( DB, 1 ) = 0 ) AndAlso ( ( UBound( DB, 1 ) = -1 ) Or ( UBound( DB, 1 ) = 0 ) ) Then
  169.        
  170.         Exit Sub
  171.        
  172.     End If
  173.  
  174.     Do
  175.  
  176.         Dim As Long Sorted = 0
  177.  
  178.         For Iterator As Long = LBound( DB, 1 ) To UBound( DB, 1 ) - 1
  179.  
  180.             If DB( Iterator ).Label > DB( Iterator + 1 ).Label Then
  181.  
  182.                 Swap DB( Iterator ).Iterator, DB( Iterator + 1 ).Iterator
  183.  
  184.                 Swap DB( Iterator ), DB( Iterator + 1 )
  185.  
  186.                 Sorted = 1
  187.  
  188.             End If
  189.  
  190.         Next
  191.  
  192.         If Sorted = 0 Then Exit Do
  193.  
  194.     Loop
  195.  
  196. End Sub
  197.  
  198. Function SEQ_Binary_Find( DB() As SEQ_Database, Request As string, byref WhereToAdd As Long = 0 ) As Long
  199.  
  200.     'Binary
  201.  
  202.     Dim As Long Lo = LBound( DB, 1 ), Hi = UBound( DB, 1 )
  203.  
  204.     If Lo = 0 AndAlso Hi = -1 Then
  205.  
  206.         WhereToAdd = 0
  207.        
  208.         Return -1
  209.        
  210.     End If
  211.  
  212.     While Hi >= Lo
  213.  
  214.         Dim As Long Md = ( Lo + Hi + 1 ) \ 2
  215.  
  216.         Dim As Long Result = StrCmp( Request, DB( Md ).Label )
  217.  
  218.         Select Case Result
  219.  
  220.         Case 0
  221.  
  222.             Return Md
  223.  
  224.         Case Is > 0
  225.  
  226.             Lo = Md + 1
  227.  
  228.         Case Else
  229.  
  230.             Hi = Md - 1
  231.  
  232.         End Select
  233.  
  234.     Wend
  235.  
  236.     WhereToAdd = Lo
  237.  
  238.     Return -1
  239.  
  240. End Function
  241.  
  242. Function SEQ_Database_Query( DB() As SEQ_Database, Request As string ) As SEQ_Database
  243.  
  244.     Var iIndex = SEQ_Binary_Find( DB(), Request )
  245.  
  246.     If iIndex >= 0 Then Return DB( iIndex ) Else Return Bogus
  247.  
  248. End Function
  249.  
  250. Function SEQ_Database_Set( DB() As SEQ_Database, sName As string, sValue As string ) As Long
  251.  
  252.     Dim As Long uNewPos = any
  253.  
  254.     Var iIndex = SEQ_Binary_Find( DB(), sName, uNewPos )    
  255.  
  256.     If iIndex >= 0 Then 'replace If found
  257.  
  258.         DB( iIndex ).Value = sValue
  259.  
  260.         Return iIndex
  261.  
  262.     End If
  263.  
  264.     SEQ_Inc_Capacity( DB(), 1 )
  265.  
  266.     Dim As Long Lo = LBound( DB, 1 ), Hi = UBound( DB, 1 )
  267.  
  268.     If uNewPos <> ( Hi + 1 ) Then
  269.  
  270.         MemMove( @DB( uNewPos + 1 ), @DB( uNewPos ), ( ( Hi - uNewPos ) - 1 ) *SizeOf( DB( 0 ) ) )
  271.  
  272.         MemSet( @DB( uNewPos ), 0, SizeOf( DB( 0 ) ) )
  273.  
  274.     End If
  275.  
  276.     With DB( uNewPos )
  277.  
  278.         .Iterator = -1
  279.  
  280.         .Label = sName
  281.  
  282.         .Value = sValue
  283.  
  284.     End With
  285.  
  286.     Return uNewPos    
  287.  
  288. End Function
  289.  
  290. Function SEQ_Database_Delete( DB() As SEQ_Database, sName As string ) As Long    
  291.  
  292.     Var iIndex = SEQ_Binary_Find( DB(), sName )
  293.    
  294.     If iIndex < 0 Then Return iIndex 'failed
  295.  
  296.     With DB( iIndex )
  297.  
  298.         'clean strings before delete!!
  299.  
  300.         .Label = ""
  301.         .Value = ""
  302.  
  303.     End With
  304.  
  305.     Var Lo = LBound( DB ), Hi = UBound( DB )
  306.  
  307.     MemMove( @DB( iIndex ), @DB( iIndex + 1 ), ( ( Hi - iIndex ) ) *SizeOf( DB( 0 ) ) )
  308.  
  309.     MemSet( @DB( Hi ), 0, SizeOf( DB( 0 ) ) )
  310.  
  311.     Lo = LBound( DB, 1 )
  312.  
  313.     Hi = UBound( DB, 1 )
  314.  
  315.     SEQ_Inc_Capacity( DB(), -1 )
  316.  
  317.     Return iIndex
  318.  
  319. End Function
  320.  
  321. #IfDef __SEQ22_Demo__
  322.  
  323.     #Include Once "./SEQ22/SEQ22 Demo.bas"
  324.  
  325.     #Include Once "./TPlus22/TPlus22 Func Support.bas"
  326.  
  327. #EndIf
  328.  
  329. Function DB_Query_Int( DB() As SEQ_Database, Request As String = "" ) As Long
  330.  
  331.     Return ValInt( SEQ_Database_Query( DB(), Request ).Value )
  332.  
  333. End Function
  334.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement