VB开发安卓程序_例程3类DBUtils1操作SQLite数据库

工程源码已上传。

类DBUtils

布局文件

运行截图

运行截图 

main模块源码

#Region Module Attributes
	#FullScreen: False
	#IncludeTitle: True
	#ApplicationLabel: DBUtils
	#VersionCode: 2
	#VersionName: 1.01
	#SupportedOrientations: portrait
#End Region

Sub Process_Globals
	
End Sub

Sub Globals
	Private lblStudentName As Label
	Private spnrStudentId As Spinner
	Private spnrTests As Spinner
	Private lblBirthday As Label
	Private lstFailedTest As ListView
	Private txtGrade As EditText
	Private WebView1 As WebView
End Sub

Sub Activity_Create(FirstTime As Boolean)
	Activity.LoadLayout("1")
	'Fill the students id spinner.
	DBUtils.ExecuteSpinner(Starter.SQL, "SELECT Id FROM Students", Null, 0, spnrStudentId)
	spnrStudentId_ItemClick(0, spnrStudentId.GetItem(0))
End Sub

Sub ShowTableInWebView 'ignore
	WebView1.Visible = True
	'[First Name] || ' ' || [Last Name] As Name => 
	'Creates a column named Name which is made of the First Name AND Last Name fields (with a space between them).
	
	'date(birthday / 1000, 'unixepoch', 'localtime') =>
	'Create a column named Birthday. This method converts the stored B4A time (milliseconds since 1/1/1970) to a string.
	WebView1.LoadHtml(DBUtils.ExecuteHtml(Starter.SQL, _
		"SELECT Id, [First Name] || ' ' || [Last Name] As Name, date(birthday / 1000, 'unixepoch', 'localtime') As Birthday FROM Students" _
			, Null, 0, True))
End Sub

Sub WebView1_OverrideUrl (Url As String) As Boolean
	'parse the row and column numbers from the URL
	Dim values() As String
	values = Regex.Split("[.]", Url.SubString(7))
	Dim col, row As Int
	col = values(0)
	row = values(1)
	ToastMessageShow("User pressed on column: " & col & " and row: " & row, False)
	Return True 'Don't try to navigate to this URL
End Sub

Sub ExportToJSON 'ignore
	Dim gen As JSONGenerator
	gen.Initialize(DBUtils.ExecuteJSON(Starter.SQL, "SELECT Id, [Last Name], Birthday FROM Students", Null, _
		0, Array As String(DBUtils.DB_TEXT, DBUtils.DB_TEXT, DBUtils.DB_INTEGER)))
	Dim JSONString As String
	JSONString = gen.ToPrettyString(4)
	Msgbox(JSONString, "")
End Sub

Sub spnrStudentId_ItemClick (Position As Int, Value As Object)
	Dim m As Map
	m = DBUtils.ExecuteMap(Starter.SQL, "SELECT Id, [First Name], [Last Name], Birthday FROM students WHERE id = ?", _
		Array As String(Value))
	If m = Null Or m.IsInitialized = False Then 'Null will return if there is no match
		lblStudentName.Text = "N/A"
		lblBirthday.Text = ""
	Else
		lblStudentName.Text = m.Get("first name") & " " & m.Get("last name") 'keys are lower cased!
		lblBirthday.Text = DateTime.Date(m.Get("birthday"))
	End If
	'Get the tests for this specific student (currently it is all tests).
	DBUtils.ExecuteSpinner(Starter.SQL, "SELECT test FROM Grades WHERE id = ?", _
		Array As String(Value), 0, spnrTests)
	spnrTests.SelectedIndex = 0
	spnrTests_ItemClick(0, spnrTests.GetItem(0))
	FindFailedTests(Value)
End Sub

Sub spnrTests_ItemClick (Position As Int, Value As Object)
	'Show the grade of this test
	Dim m As Map = DBUtils.ExecuteMap(Starter.SQL, "SELECT Grade FROM Grades WHERE id = ? AND test = ?", _
		Array As String(spnrStudentId.SelectedItem, Value))
	If m = Null Or m.IsInitialized = False Then
		txtGrade.Text = "N/A"
	Else
		txtGrade.Text = m.Get("grade")
	End If
End Sub

Sub FindFailedTests(StudentId As String)
	'Find all tests of this student with grade lower than 55.
	'Note that we use SQLite concatenation operator to add 'Grade: ' before each grade.
	DBUtils.ExecuteListView(Starter.SQL, "SELECT test, 'Grade: ' || grade FROM Grades WHERE id = ? AND grade <= 55", _
		Array As String(StudentId), 0, lstFailedTest, True)
End Sub

Sub txtGrade_EnterPressed
	btnSetGrade_Click
End Sub

Sub btnSetGrade_Click
	'check that the value is valid
	If IsNumber(txtGrade.Text) = False Or txtGrade.Text > 100 Or txtGrade.Text < 0 Then
		ToastMessageShow("Invalid value. Value should be between 0 to 100.", True)
		Return
	End If
	'set the grade of the record with the correct id and test values.
	Dim WhereFields As Map
	WhereFields.Initialize
	WhereFields.Put("id", spnrStudentId.SelectedItem)
	WhereFields.Put("test", spnrTests.SelectedItem)
	DBUtils.UpdateRecord(Starter.SQL, "Grades", "Grade", txtGrade.Text, WhereFields)
	'Refresh the failed tests list
	FindFailedTests(spnrStudentId.SelectedItem)
End Sub

Sub lstFailedTest_ItemClick (Position As Int, Value As Object)
	'Value is an array of strings
	Dim values() As String = Value
	Dim testName As String = values(0)
	'find the index of this test in spnrTests and set it.
	For i = 0 To spnrTests.Size - 1
		If testName = spnrTests.GetItem(i) Then
			spnrTests.SelectedIndex = i
			spnrTests_ItemClick(i, spnrTests.GetItem(i))
			Exit
		End If
	Next
	txtGrade.SelectAll
End Sub

类模块DBUtils

'DBUtils
' Version 1.20
Sub Process_Globals
	Public DB_REAL, DB_INTEGER, DB_BLOB, DB_TEXT As String
	DB_REAL = "REAL"
	DB_INTEGER = "INTEGER"
	DB_BLOB = "BLOB"
	DB_TEXT = "TEXT"
	Dim HtmlCSS As String
	HtmlCSS = $"
		table {width: 100%;border: 1px solid #cef;text-align: left; }
		th { font-weight: bold;	background-color: #acf;	border-bottom: 1px solid #cef; }
		td,th {	padding: 4px 5px; }
		.odd {background-color: #def; } 
		.odd td {border-bottom: 1px solid #cef; }
		a { text-decoration:none; color: #000;}"$
End Sub

'Returns the path to a folder where you can create a database, preferably on the secondary storage.
Public Sub GetDBFolder As String
	Dim rp As RuntimePermissions
	If File.ExternalWritable Then Return rp.GetSafeDirDefaultExternal("") Else Return File.DirInternal
End Sub

'Copies a database file that was added in the Files tab. The database must be copied to a writable location.
'This method copies the database to the storage card. If the storage card is not available the file is copied to the internal folder.
'The target folder is returned.
'If the database file already exists then no copying is done.
Public Sub CopyDBFromAssets (FileName As String) As String
	Dim TargetDir As String = GetDBFolder
	
	If File.Exists(TargetDir, FileName) = False Then
		File.Copy(File.DirAssets, FileName, TargetDir, FileName)
	End If
	Return TargetDir
End Sub

'Creates a new table with the given name.
'FieldsAndTypes - A map with the fields names as keys and the types as values.
'You can use the DB_... constants for the types.
'PrimaryKey - The column that will be the primary key. Pass empty string if not needed.
Public Sub CreateTable(SQL As SQL, TableName As String, FieldsAndTypes As Map, PrimaryKey As String)
	Dim sb As StringBuilder
	sb.Initialize
	sb.Append("(")
	For i = 0 To FieldsAndTypes.Size - 1
		Dim field, ftype As String
		field = FieldsAndTypes.GetKeyAt(i)
		ftype = FieldsAndTypes.GetValueAt(i)
		If i > 0 Then sb.Append(", ")
		sb.Append("[").Append(field).Append("] ").Append(ftype)
		If field = PrimaryKey Then sb.Append(" PRIMARY KEY")
	Next
	sb.Append(")")
	Dim query As String
	query = "CREATE TABLE IF NOT EXISTS [" & TableName & "] " & sb.ToString
	Log("CreateTable: " & query)
	SQL.ExecNonQuery(query)
End Sub

'Deletes the given table.
Public Sub DropTable(SQL As SQL, TableName As String)
	Dim query As String
	query = "DROP TABLE IF EXISTS [" & TableName & "]"
	Log("DropTable: " & query)
	SQL.ExecNonQuery(query)
End Sub

'Inserts the data to the table.
'ListOfMaps - A list with maps as items. Each map represents a record where the map keys are the columns names
'and the maps values are the values.
'Note that you should create a new map for each record (this can be done by calling Dim to redim the map).
Public Sub InsertMaps(SQL As SQL, TableName As String, ListOfMaps As List)
	Dim sb, columns, values As StringBuilder
	'Small check for a common error where the same map is used in a loop
	If ListOfMaps.Size > 1 And ListOfMaps.Get(0) = ListOfMaps.Get(1) Then
		Log("Same Map found twice in list. Each item in the list should include a different map object.")
		Return
	End If
	SQL.BeginTransaction
	Try
		For i1 = 0 To ListOfMaps.Size - 1
			sb.Initialize
			columns.Initialize
			values.Initialize
			Dim listOfValues As List
			listOfValues.Initialize
			sb.Append("INSERT INTO [" & TableName & "] (")
			Dim m As Map
			m = ListOfMaps.Get(i1)
			For i2 = 0 To m.Size - 1
				Dim col As String
				Dim value As Object	
				col = m.GetKeyAt(i2)
				value = m.GetValueAt(i2)
				If i2 > 0 Then
					columns.Append(", ")
					values.Append(", ")
				End If
				columns.Append("[").Append(col).Append("]")
				values.Append("?")
				listOfValues.Add(value)
			Next
			sb.Append(columns.ToString).Append(") VALUES (").Append(values.ToString).Append(")")
			If i1 = 0 Then Log("InsertMaps (first query out of " & ListOfMaps.Size & "): " & sb.ToString)
			SQL.ExecNonQuery2(sb.ToString, listOfValues)
		Next
		SQL.TransactionSuccessful
	Catch
		ToastMessageShow(LastException.Message, True)
		Log(LastException)
	End Try
	SQL.EndTransaction
End Sub

' updates a single field in a record
' Field is the column name
Public Sub UpdateRecord(SQL As SQL, TableName As String, Field As String, NewValue As Object, _
	WhereFieldEquals As Map)
	Dim sb As StringBuilder
	sb.Initialize
	sb.Append("UPDATE [").Append(TableName).Append("] SET [").Append(Field).Append("] = ? WHERE ")
	If WhereFieldEquals.Size = 0 Then
		Log("WhereFieldEquals map empty!")
		Return
	End If
	Dim args As List
	args.Initialize
	args.Add(NewValue)
	For i = 0 To WhereFieldEquals.Size - 1
		If i > 0 Then sb.Append(" AND ")
		sb.Append("[").Append(WhereFieldEquals.GetKeyAt(i)).Append("] = ?")
		args.Add(WhereFieldEquals.GetValueAt(i))
	Next
	Log("UpdateRecord: " & sb.ToString)
	SQL.ExecNonQuery2(sb.ToString, args)
End Sub

' updates multiple fields in a record
' in the Fields map the keys are the column names
Public Sub UpdateRecord2(SQL As SQL, TableName As String, Fields As Map, WhereFieldEquals As Map)
	If WhereFieldEquals.Size = 0 Then
		Log("WhereFieldEquals map empty!")
		Return
	End If
	If Fields.Size = 0 Then
		Log("Fields empty")
		Return
	End If
	Dim sb As StringBuilder
	sb.Initialize
	sb.Append("UPDATE [").Append(TableName).Append("] SET ")
	Dim args As List
	args.Initialize
	For i=0 To Fields.Size-1
		If i<>Fields.Size-1 Then
			sb.Append("[").Append(Fields.GetKeyAt(i)).Append("]=?,")
		Else
			sb.Append("[").Append(Fields.GetKeyAt(i)).Append("]=?")
		End If
		args.Add(Fields.GetValueAt(i))
	Next
    
	sb.Append(" WHERE ")
	For i = 0 To WhereFieldEquals.Size - 1
		If i > 0 Then 
			sb.Append(" AND ")
		End If
		sb.Append("[").Append(WhereFieldEquals.GetKeyAt(i)).Append("] = ?")
		args.Add(WhereFieldEquals.GetValueAt(i))
	Next
	Log("UpdateRecord: " & sb.ToString)
	SQL.ExecNonQuery2(sb.ToString, args)
End Sub

'Executes the query and returns the result as a list of arrays.
'Each item in the list is a strings array.
'StringArgs - Values to replace question marks in the query. Pass Null if not needed.
'Limit - Limits the results. Pass 0 for all results.
Public Sub ExecuteMemoryTable(SQL As SQL, Query As String, StringArgs() As String, Limit As Int) As List
	Dim cur As Cursor
	If StringArgs <> Null Then 
		cur = SQL.ExecQuery2(Query, StringArgs)
	Else
		cur = SQL.ExecQuery(Query)
	End If
	Log("ExecuteMemoryTable: " & Query)
	Dim table As List
	table.Initialize
	If Limit > 0 Then Limit = Min(Limit, cur.RowCount) Else Limit = cur.RowCount
	For row = 0 To Limit - 1
		cur.Position = row
		Dim values(cur.ColumnCount) As String
		For col = 0 To cur.ColumnCount - 1
			values(col) = cur.GetString2(col)
		Next
		table.Add(values)
	Next
	cur.Close
	Return table
End Sub

'Executes the query and returns a Map with the column names as the keys 
'and the first record values As the entries values.
'The keys are lower cased.
'Returns Null if no results found.
Public Sub ExecuteMap(SQL As SQL, Query As String, StringArgs() As String) As Map
	Dim cur As Cursor
	If StringArgs <> Null Then 
		cur = SQL.ExecQuery2(Query, StringArgs)
	Else
		cur = SQL.ExecQuery(Query)
	End If
	Log("ExecuteMap: " & Query)
	If cur.RowCount = 0 Then
		Log("No records found.")
		Return Null
	End If
	Dim res As Map
	res.Initialize
	cur.Position = 0
	For i = 0 To cur.ColumnCount - 1
		res.Put(cur.GetColumnName(i).ToLowerCase, cur.GetString2(i))
	Next
	cur.Close
	Return res
End Sub

'Executes the query and fills the Spinner with the values in the first column
Sub ExecuteSpinner(SQL As SQL, Query As String, StringArgs() As String, Limit As Int, Spinner1 As Spinner)
	Spinner1.Clear
	Dim Table As List
	Table = ExecuteMemoryTable(SQL, Query, StringArgs, Limit)
	Dim Cols() As String
	For i = 0 To Table.Size - 1
		Cols = Table.Get(i)
		Spinner1.Add(Cols(0))
	Next
End Sub

'Executes the query and fills the ListView with the value.
'If TwoLines is true then the first column is mapped to the first line and the second column is mapped
'to the second line.
'In both cases the value set to the row is the array with all the records values.
Public Sub ExecuteListView(SQL As SQL, Query As String, StringArgs() As String, Limit As Int, ListView1 As ListView, _
	TwoLines As Boolean)
	ListView1.Clear
	Dim Table As List
	Table = ExecuteMemoryTable(SQL, Query, StringArgs, Limit)
	Dim Cols() As String
	For i = 0 To Table.Size - 1
		Cols = Table.Get(i)
		If TwoLines Then
			ListView1.AddTwoLines2(Cols(0), Cols(1), Cols)
		Else
			ListView1.AddSingleLine2(Cols(0), Cols)
		End If
	Next
End Sub

'Executes the given query and creates a Map that you can pass to JSONGenerator and generate JSON text.
'DBTypes - Lists the type of each column in the result set.
'Usage example: (don't forget to add a reference to the JSON library)
'	Dim gen As JSONGenerator
'	gen.Initialize(DBUtils.ExecuteJSON(SQL, "SELECT Id, Birthday FROM Students", Null, _
'		0, Array As String(DBUtils.DB_TEXT, DBUtils.DB_INTEGER)))
'	Dim JSONString As String
'	JSONString = gen.ToPrettyString(4)
'	Msgbox(JSONString, "")
Public Sub ExecuteJSON (SQL As SQL, Query As String, StringArgs() As String, Limit As Int, DBTypes As List) As Map
	Dim table As List
	Dim cur As Cursor
	If StringArgs <> Null Then 
		cur = SQL.ExecQuery2(Query, StringArgs)
	Else
		cur = SQL.ExecQuery(Query)
	End If
	Log("ExecuteJSON: " & Query)
	Dim table As List
	table.Initialize
	If Limit > 0 Then Limit = Min(Limit, cur.RowCount) Else Limit = cur.RowCount
	For row = 0 To Limit - 1
		cur.Position = row
		Dim m As Map
		m.Initialize
		For i = 0 To cur.ColumnCount - 1
			Select DBTypes.Get(i)
				Case DB_TEXT
					m.Put(cur.GetColumnName(i), cur.GetString2(i))
				Case DB_INTEGER
					m.Put(cur.GetColumnName(i), cur.GetLong2(i))
				Case DB_REAL
					m.Put(cur.GetColumnName(i), cur.GetDouble2(i))
				Case Else
					Log("Invalid type: " & DBTypes.Get(i))
			End Select
		Next
		table.Add(m)
	Next
	cur.Close
	Dim root As Map
	root.Initialize
	root.Put("root", table)
	Return root
End Sub

'Creates a html text that displays the data in a table.
'The style of the table can be changed by modifying HtmlCSS variable.
Public Sub ExecuteHtml(SQL As SQL, Query As String, StringArgs() As String, Limit As Int, Clickable As Boolean) As String
	Dim cur As Cursor
	If StringArgs <> Null Then 
		cur = SQL.ExecQuery2(Query, StringArgs)
	Else
		cur = SQL.ExecQuery(Query)
	End If
	Log("ExecuteHtml: " & Query)
	If Limit > 0 Then Limit = Min(Limit, cur.RowCount) Else Limit = cur.RowCount
	Dim sb As StringBuilder
	sb.Initialize
	sb.Append("<html><body>").Append(CRLF)
	sb.Append("<style type='text/css'>").Append(HtmlCSS).Append("</style>").Append(CRLF)
	sb.Append("<table><tr>").Append(CRLF)
	For i = 0 To cur.ColumnCount - 1
		sb.Append("<th>").Append(cur.GetColumnName(i)).Append("</th>")
	Next
	
'	For i = 0 To cur.ColumnCount - 1
'		If i = 1 Then
'			sb.Append("<th style='width:200px;'>").Append(cur.GetColumnName(i)).Append("</th>")
'		Else
'			sb.Append("<th>").Append(cur.GetColumnName(i)).Append("</th>")
'		End If
'	Next
		
	sb.Append("</tr>").Append(CRLF)
	For row = 0 To Limit - 1
		cur.Position = row
		If row Mod 2 = 0 Then
			sb.Append("<tr>")
		Else
			sb.Append("<tr class='odd'>")
		End If
		For i = 0 To cur.ColumnCount - 1
			sb.Append("<td>")
			If Clickable Then
				sb.Append("<a href='http://").Append(i).Append(".")
				sb.Append(row)
				sb.Append(".com'>").Append(cur.GetString2(i)).Append("</a>")
			Else
				sb.Append(cur.GetString2(i))
			End If
			sb.Append("</td>")
		Next
		sb.Append("</tr>").Append(CRLF)
	Next
	cur.Close
	sb.Append("</table></body></html>")
	Return sb.ToString
End Sub

'Gets the current version of the database. If the DBVersion table does not exist it is created and the current
'version is set to version 1.
Public Sub GetDBVersion (SQL As SQL) As Int
	Dim count, version As Int
	count = SQL.ExecQuerySingleResult("SELECT count(*) FROM sqlite_master WHERE Type='table' AND name='DBVersion'")
	If count > 0 Then
		version = SQL.ExecQuerySingleResult("SELECT version FROM DBVersion")
	Else
		'Create the versions table.
		Dim m As Map
		m.Initialize
		m.Put("version", DB_INTEGER)
		CreateTable(SQL, "DBVersion", m, "version")
		
		SQL.ExecNonQuery("INSERT INTO DBVersion VALUES (1)")
		
		version = 1
	End If
	
	Return version
End Sub

'Sets the database version to the given version number.
Public Sub SetDBVersion (SQL As SQL, Version As Int)
	SQL.ExecNonQuery2("UPDATE DBVersion set version = ?", Array As Object(Version))
End Sub

' deletes a record
Public Sub DeleteRecord(SQL As SQL, TableName As String, WhereFieldEquals As Map)
    Dim sb As StringBuilder
    sb.Initialize
    sb.Append("DELETE FROM [").Append(TableName).Append("] WHERE ")
    If WhereFieldEquals.Size = 0 Then
        Log("WhereFieldEquals map empty!")
        Return
    End If
    Dim args As List
    args.Initialize
    For i = 0 To WhereFieldEquals.Size - 1
        If i > 0 Then sb.Append(" AND ")
        sb.Append("[").Append(WhereFieldEquals.GetKeyAt(i)).Append("] = ?")
        args.Add(WhereFieldEquals.GetValueAt(i))
    Next
    Log("DeleteRecord: " & sb.ToString)
    SQL.ExecNonQuery2(sb.ToString, args)
End Sub