Skip to content

Commit d088fe8

Browse files
pchemguypchemguy
committed
Refactoring, demo, cleanup
1 parent fc219ac commit d088fe8

13 files changed

+492
-44
lines changed

‎Project/Common/Guard/Guard.cls

+5-5
Original file line numberDiff line numberDiff line change
@@ -56,21 +56,21 @@ End Property
5656

5757

5858
'@Description("Raises a run-time error if the specified string is empty.")
59-
Public Sub EmptyString(ByVal Text As Variant)
59+
Public Sub EmptyString(ByVal TEXT As Variant)
6060
Attribute EmptyString.VB_Description = "Raises a run-time error if the specified string is empty."
6161
Dim errorDetails As TError
6262
With errorDetails
63-
.Trapped = (VarType(Text) <> vbString)
63+
.Trapped = (VarType(TEXT) <> vbString)
6464
If .Trapped Then
6565
.Name = "TypeMismatchErr"
6666
.Number = ErrNo.TypeMismatchErr
67-
.Source = TypeName(Text) & " type"
67+
.Source = TypeName(TEXT) & " type"
6868
.Message = "String required"
69-
.Description = "Variable type: " & TypeName(Text) & ". String required."
69+
.Description = "Variable type: " & TypeName(TEXT) & ". String required."
7070
RaiseError errorDetails
7171
End If
7272

73-
.Trapped = (Text = vbNullString)
73+
.Trapped = (TEXT = vbNullString)
7474
If .Trapped Then
7575
.Name = "EmptyStringErr"
7676
.Number = ErrNo.EmptyStringErr

‎Project/SQLite/AADemo/SQLiteCAdoDemo.bas

+153
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,153 @@
1+
Attribute VB_Name = "SQLiteCAdoDemo"
2+
Attribute VB_Description = "Illustrates typical workflows for SQLiteCAdo"
3+
'@Folder "SQLite.AADemo"
4+
'@ModuleDescription "Illustrates typical workflows for SQLiteCAdo"
5+
'@IgnoreModule
6+
Option Explicit
7+
Option Private Module
8+
9+
Private Const LITE_LIB As String = "SQLiteCAdo"
10+
Private Const PATH_SEP As String = "\"
11+
Private Const LITE_RPREFIX As String = "Library" & PATH_SEP & LITE_LIB & PATH_SEP
12+
13+
Private Type TSQLiteCAdoDemo
14+
DbPathName As String
15+
dbmC As SQLiteC
16+
dbmADO As LiteMan
17+
dbs As SQLiteCStatement
18+
dbq As ILiteADO
19+
End Type
20+
Private this As TSQLiteCAdoDemo
21+
22+
23+
Private Sub CleanUp()
24+
With this
25+
Set .dbq = Nothing
26+
Set .dbs = Nothing
27+
Set .dbmADO = Nothing
28+
Set .dbmC = Nothing
29+
End With
30+
End Sub
31+
32+
33+
Private Sub MainC()
34+
this.DbPathName = FixObjAdo.RandomTempFileName
35+
InitDBQC
36+
Debug.Print "Created blank db: " & this.dbq.MainDB
37+
38+
DemoDBQ "C"
39+
40+
CleanUp
41+
End Sub
42+
43+
44+
Private Sub MainADO()
45+
this.DbPathName = FixObjAdo.RandomTempFileName
46+
Set this.dbmADO = LiteMan(this.DbPathName, True)
47+
Set this.dbq = this.dbmADO.ExecADO
48+
Debug.Print "Created blank db: " & this.dbq.MainDB
49+
50+
DemoDBQ "ADO"
51+
52+
CleanUp
53+
End Sub
54+
55+
56+
Private Sub DemoDBQ(Optional ByVal Subpackage As String = "C")
57+
Dim dbq As ILiteADO
58+
Set dbq = this.dbq
59+
60+
Dim SQLQuery As String
61+
Dim AffectedRows As Long
62+
63+
SQLQuery = FixSQLFunc.Create
64+
AffectedRows = dbq.ExecuteNonQuery(SQLQuery)
65+
SQLQuery = FixSQLFunc.InsertData
66+
AffectedRows = dbq.ExecuteNonQuery(SQLQuery)
67+
68+
Debug.Print "Number of inserted rows: " & CStr(AffectedRows)
69+
70+
Dim QueryParams As Scripting.Dictionary
71+
If Subpackage = "C" Then
72+
SQLQuery = FixSQLFunc.SelectFilteredParamName
73+
Set QueryParams = FixSQLFunc.SelectFilteredParamNameValues
74+
Else
75+
SQLQuery = FixSQLFunc.SelectFilteredPlain
76+
Set QueryParams = Nothing
77+
End If
78+
79+
Dim AdoRecordset As ADODB.Recordset
80+
Set AdoRecordset = dbq.GetAdoRecordset(SQLQuery, QueryParams)
81+
82+
Dim RowSet2D As Variant
83+
RowSet2D = ArrayLib.TransposeArray(AdoRecordset.GetRows)
84+
85+
86+
Debug.Print "Number of selected records: " & CStr(AdoRecordset.RecordCount)
87+
End Sub
88+
89+
90+
Private Sub InitDBQC()
91+
'------------------------'
92+
'===== INIT MANAGER ====='
93+
'------------------------'
94+
Dim DllPath As String
95+
DllPath = LITE_RPREFIX & "dll\" & ARCH
96+
Dim DllNames As Variant
97+
#If Win64 Then
98+
DllNames = "sqlite3.dll"
99+
#Else
100+
DllNames = Array("icudt68.dll", "icuuc68.dll", "icuin68.dll", _
101+
"icuio68.dll", "icutu68.dll", "sqlite3.dll")
102+
#End If
103+
Dim dbm As SQLiteC
104+
'@Ignore IndexedDefaultMemberAccess
105+
Set dbm = SQLiteC(DllPath, DllNames)
106+
If dbm Is Nothing Then
107+
Err.Raise ErrNo.UnknownClassErr, "SQLiteCExamples", _
108+
"Failed to create an SQLiteC instance."
109+
Else
110+
Debug.Print "Database manager instance (SQLiteC class) is ready"
111+
End If
112+
113+
'''' Test SQLite3.dll
114+
If Replace(dbm.Version(False), ".", "0") & "0" = CStr(dbm.Version) Then
115+
Debug.Print "Database engine version functionality test passed."
116+
Else
117+
Debug.Print "Database engine version functionality test failed."
118+
End If
119+
Set this.dbmC = dbm
120+
121+
'---------------------------'
122+
'===== INIT CONNECTION ====='
123+
'---------------------------'
124+
Dim dbc As SQLiteCConnection
125+
Set dbc = dbm.CreateConnection(this.DbPathName, AllowNonExistent:=True)
126+
If dbc Is Nothing Then
127+
Err.Raise ErrNo.UnknownClassErr, "SQLiteCExamples", _
128+
"Failed to create an SQLiteCConnection instance."
129+
Else
130+
Debug.Print "Database SQLiteCConnection instance is ready."
131+
End If
132+
133+
'--------------------------'
134+
'===== INIT STATEMENT ====='
135+
'--------------------------'
136+
Dim DbStmtName As String
137+
DbStmtName = vbNullString
138+
Dim dbs As SQLiteCStatement
139+
Set dbs = dbc.CreateStatement(DbStmtName)
140+
Set this.dbs = dbs
141+
Dim dbq As ILiteADO
142+
Set dbq = dbs
143+
If dbq Is Nothing Then
144+
Err.Raise ErrNo.UnknownClassErr, "SQLiteCExamples", _
145+
"Failed to create an SQLiteCStatement instance."
146+
Else
147+
Debug.Print "Database SQLiteCStatement instance is ready."
148+
End If
149+
'''' Maximum capapacity of 100x10 = 1000 rows
150+
dbs.DbExecutor.PageCount = 10
151+
dbs.DbExecutor.PageSize = 100
152+
Set this.dbq = dbq
153+
End Sub

‎Project/SQLite/ADO/ADemo/LiteExamples.bas

+70-1
Original file line numberDiff line numberDiff line change
@@ -55,8 +55,9 @@ End Sub
5555
Private Sub DemoHostFreezeWithBusyDb()
5656
Const PROC_NAME As String = "DemoHostFreezeWithBusyDb"
5757
Dim dbm As LiteMan
58-
Set dbm = LiteMan(":tmp:")
58+
Set dbm = LiteMan(":tmp:", , "StepAPI=True;Timeout=10000;SyncPragma=NORMAL;FKSupport=True;")
5959
Debug.Print dbm.ExecADO.MainDB
60+
dbm.ExecADO.ExecuteNonQuery FixSQLFunc.CreateWithData
6061

6162
Dim dbAdo As LiteADO
6263
Set dbAdo = dbm.ExecADO
@@ -76,3 +77,71 @@ Private Sub DemoHostFreezeWithBusyDb()
7677
Debug.Print PROC_NAME & ":" & " App has been locked due to busy db for " & _
7778
Delta & " s."
7879
End Sub
80+
81+
Private Sub ConnectSQLiteAdoCommandSourceFreezeWithBusyDb()
82+
Dim Driver As String
83+
Driver = "SQLite3 ODBC Driver"
84+
Dim Database As String
85+
Database = Environ("Temp") & "\" & CStr(Format(Now, "yyyy-mm-dd_hh-mm-ss.")) _
86+
& CStr((Timer * 10000) Mod 10000) & CStr(Round(Rnd * 10000, 0)) & ".db"
87+
Debug.Print Database
88+
Dim Options As String
89+
Options = "JournalMode=DELETE;SyncPragma=NORMAL;FKSupport=True;"
90+
91+
Dim AdoConnStr As String
92+
AdoConnStr = "Driver=" & Driver & ";" & "Database=" & Database & ";" & Options
93+
94+
Dim SQLQuery As String
95+
Dim RecordsAffected As Long: RecordsAffected = 0 '''' RD workaround
96+
Dim AdoCommand As ADODB.Command
97+
Set AdoCommand = New ADODB.Command
98+
With AdoCommand
99+
.CommandType = adCmdText
100+
.ActiveConnection = AdoConnStr
101+
.ActiveConnection.CursorLocation = adUseClient
102+
End With
103+
104+
'''' ===== Create Functions table ===== ''''
105+
SQLQuery = Join(Array( _
106+
"CREATE TABLE functions(", _
107+
" name TEXT COLLATE NOCASE NOT NULL,", _
108+
" builtin INTEGER NOT NULL,", _
109+
" type TEXT COLLATE NOCASE NOT NULL,", _
110+
" enc TEXT COLLATE NOCASE NOT NULL,", _
111+
" narg INTEGER NOT NULL,", _
112+
" flags INTEGER NOT NULL", _
113+
")" _
114+
), vbLf)
115+
With AdoCommand
116+
.CommandText = SQLQuery
117+
.Execute RecordsAffected, Options:=adExecuteNoRecords
118+
End With
119+
120+
'''' ===== Insert rows into Functions table ===== ''''
121+
SQLQuery = Join(Array( _
122+
"INSERT INTO functions", _
123+
"SELECT * FROM pragma_function_list" _
124+
), vbLf)
125+
With AdoCommand
126+
.CommandText = SQLQuery
127+
.Execute RecordsAffected, Options:=adExecuteNoRecords
128+
End With
129+
130+
'@Ignore StopKeyword
131+
Stop '''' Lock Db. For example, open in GUI admin tool and start a transaction
132+
'''' ===== Try changing journal mode ===== ''''
133+
On Error Resume Next
134+
With AdoCommand
135+
.CommandText = "PRAGMA journal_mode = 'WAL'"
136+
.Execute RecordsAffected, Options:=adExecuteNoRecords
137+
End With
138+
If Err.Number <> 0 Then
139+
Debug.Print "Error: #" & CStr(Err.Number) & ". " & vbNewLine & _
140+
"Error description: " & Err.Description
141+
End If
142+
'@Ignore StopKeyword
143+
Stop
144+
On Error GoTo 0
145+
146+
AdoCommand.ActiveConnection.Close
147+
End Sub

0 commit comments

Comments
 (0)