Option Explicit

' from https://github.com/ReneNyffenegger/winsqlite3.dll-4-VBA
' A lot of changes by me, George Karras

Public Const SQLITE_OK = 0 ' Successful result
Public Const SQLITE_ERROR = 1 ' Generic Error
Public Const SQLITE_BUSY = 5 ' The database file is locked
Public Const SQLITE_TOOBIG = 18 ' String or BLOB exceeds size limit
Public Const SQLITE_MISUSE = 21 ' Library used incorrectly
Public Const SQLITE_ROW = 100 ' sqlite3_step() has another row ready
Public Const SQLITE_DONE = 101 ' sqlite3_step() has finished executing

Private Const SQLITE_STATIC = 0

Public Const SQLITE_INTEGER = 1
Public Const SQLITE_FLOAT = 2
Public Const SQLITE_TEXT = 3
Public Const SQLITE_BLOB = 4
Public Const SQLITE_NULL = 5

Private Const CP_UTF8 = 65001
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)


Declare Function sqlite3_open Lib "winsqlite3.dll" ( _
ByVal zFilename As String, _
ByRef ppDB As Long _
) As Long
Declare Function sqlite3_close Lib "winsqlite3.dll" ( _
ByVal db As Long _
) As Long
' sqlite3_free
Declare Function sqlite3_free Lib "winsqlite3.dll" (ByVal FreeThis As Long) As Long
Declare Function sqlite3_exec Lib "winsqlite3.dll" ( _
ByVal db As Any, _
ByVal sql As Long, _
ByVal callback As Long, _
ByVal argument_1 As Long, _
ByRef errmsg As Long _
) As Long ' }


Declare Function sqlite3_prepare_v2 Lib "winsqlite3.dll" ( _
ByVal db As Any, _
ByVal zSql As Long, _
ByVal nByte As Long, _
ByRef ppStatement As Long, _
ByRef pzTail As Long _
) As Long ' }


Declare Function sqlite3_finalize Lib "winsqlite3.dll" ( _
ByVal stmt As Long _
) As Long ' }

Declare Function sqlite3_bind_int Lib "winsqlite3.dll" ( _
ByVal stmt As Long, _
ByVal pos As Long, _
ByVal val As Long _
) As Long ' }

Declare Function sqlite3_bind_text_ Lib "winsqlite3.dll" Alias "sqlite3_bind_text" ( _
ByVal stmt As Long, _
ByVal pos As Long, _
ByVal val As Long, _
ByVal len_ As Long, _
ByVal ZeroAlways As Long _
) As Long ' }

Declare Function sqlite3_bind_blob_ Lib "winsqlite3.dll" Alias "sqlite3_bind_blob" ( _
ByVal stmt As Long, _
ByVal pos As Long, _
ByVal val As Long, _
ByVal len_ As Long, _
ByVal ZeroAlways As Long _
) As Long ' }

Declare Function sqlite3_bind_null Lib "winsqlite3.dll" ( _
ByVal stmt As Long, _
ByVal pos As Long _
) As Long

Declare Function sqlite3_step Lib "winsqlite3.dll" ( _
ByVal stmt As Long _
) As Long ' }

Declare Function sqlite3_reset Lib "winsqlite3.dll" ( _
ByVal stmt As Long _
) As Long ' }


Declare Function sqlite3_column_double Lib "winsqlite3.dll" ( _
ByVal stmt As Long, _
ByVal iCol As Long _
) As Double

Declare Function sqlite3_column_int Lib "winsqlite3.dll" ( _
ByVal stmt As Long, _
ByVal iCol As Long _
) As Long

Declare Function sqlite3_column_text_ Lib "winsqlite3.dll" Alias "sqlite3_column_text" ( _
ByVal stmt As Long, _
ByVal iCol As Long _
) As Long

Declare Function sqlite3_column_blob_ Lib "winsqlite3.dll" Alias "sqlite3_column_blob" ( _
ByVal stmt As Long, _
ByVal iCol As Long _
) As Long

Declare Function sqlite3_column_bytes Lib "winsqlite3.dll" ( _
ByVal stmt As Long, _
ByVal iCol As Long _
) As Long

Declare Function sqlite3_column_type Lib "winsqlite3.dll" ( _
ByVal stmt As Long, _
ByVal iCol As Long _
) As Long

Private Declare Function MultiByteToWideChar Lib "kernel32" ( _
ByVal CodePage As Long, _
ByVal dwFlags As Long, _
ByVal lpMultiByteStr As Long, _
ByVal cbMultiByte As Long, _
ByVal lpWideCharStr As Long, _
ByVal cchWideChar As Long _
) As Long

Private Declare Function WideCharToMultiByte Lib "kernel32" ( _
ByVal CodePage As Long, _
ByVal dwFlags As Long, _
ByVal lpWideCharStr As Long, _
ByVal cchWideChar As Long, _
ByVal lpMultiByteStr As Long, _
ByVal cchMultiByte As Long, _
ByVal lpDefaultChar As Long, _
ByVal lpUsedDefaultChar As Long _
) As Long ' }

Function utf8ptrToString(pUtf8String As Long) As String ' {
Dim buf As String
Dim cSize As Long
Dim retVal As Long

cSize = MultiByteToWideChar(CP_UTF8, 0, pUtf8String, -1, 0, 0)

If cSize <= 1 Then
utf8ptrToString = ""
Exit Function
End If

utf8ptrToString = String(cSize - 1, "*")

retVal = MultiByteToWideChar(CP_UTF8, 0, pUtf8String, -1, StrPtr(utf8ptrToString), cSize)
If retVal = 0 Then
Err.Raise 6000, "utf8ptrToString", "Utf8ptrToString error: " & Err.LastDllError
Exit Function
End If

End Function ' }

Function stringToUtf8bytes(txt As String) As Byte() ' {
'used
Dim bSize As Long
Dim retVal As Long
Dim buf() As Byte

bSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(txt), -1, 0, 0, 0, 0)

If bSize = 0 Then
Exit Function
End If

ReDim buf(bSize)

retVal = WideCharToMultiByte(CP_UTF8, 0, StrPtr(txt), -1, VarPtr(buf(0)), bSize, 0, 0)

If retVal = 0 Then
Err.Raise 6000, "stringToUtf8bytes", "stringToUtf8bytes error: " & Err.LastDllError
Exit Function
End If

stringToUtf8bytes = buf

End Function

Function sqlite3_bind_text(ByVal stmt As Long, ByVal pos As Long, val As String) As Long

Dim ar() As Byte, len_ As Long
ReDim ar(0)
ar = stringToUtf8bytes(val)
len_ = UBound(ar) - LBound(ar) + 1
If len_ = 0 Then
sqlite3_bind_text = sqlite3_bind_text_(stmt, pos, ByVal 0, ByVal 0, ByVal 0)
Else

sqlite3_bind_text = sqlite3_bind_text_(stmt, pos, VarPtr(ar(0)), ByVal len_, ByVal SQLITE_STATIC)
End If
End Function


Function sqlite3_column_text( _
ByVal stmt As Long, _
ByVal iCol As Long _
) As String

sqlite3_column_text = utf8ptrToString(sqlite3_column_text_(stmt, iCol))

End Function

Function sqlite3_bind_blob(ByVal stmt As Long, ByVal pos As Long, ar() As Byte) As Long

Dim len_ As Long
len_ = UBound(ar) - LBound(ar) + 1
If len_ = 0 Then
sqlite3_bind_blob = sqlite3_bind_blob_(stmt, pos, ByVal 0, ByVal 0, ByVal 0)
Else
sqlite3_bind_blob = sqlite3_bind_blob_(stmt, pos, VarPtr(ar(0)), ByVal len_, ByVal SQLITE_STATIC)
End If
End Function

Function sqlite3_column_blob( _
ByVal stmt As Long, _
ByVal iCol As Long _
) As Byte()
Dim len_ As Long, where As Long
'ReDim sqlite3_column_blob(0)
Dim ar() As Byte
ar = vbNullString
sqlite3_column_blob = vbNullString ' now is initialized but empty;
where = sqlite3_column_blob_(stmt, iCol)
len_ = sqlite3_column_bytes(stmt, iCol)
If len_ > 0 Then
ReDim ar(len_ - 1)
CopyMemory ar(0), ByVal where, len_
End If
sqlite3_column_blob = ar
End Function
Function execSQL(db As Long, sql As String, Optional errmsg As String) As Long

Dim ar() As Byte, len_ As Long, one As Long
ReDim ar(0)
sql = Trim$(sql)
If Len(sql) = 0 Then Exit Function
If Right(sql, 1) <> ";" Then sql = sql + ";"
ar = stringToUtf8bytes(sql)
len_ = UBound(ar) - LBound(ar) + 1
one = 1
execSQL = sqlite3_exec(db, VarPtr(ar(0)), 0, 0, one)
If one <> 0 Then
If one <> 1 Then
errmsg = utf8ptrToString(one)
sqlite3_free one
Debug.Print "free ok"
End If
Else
Debug.Print "zero, no free executed"
End If
End Function

Function prepareStmt(db As Long, sql As String) As Long
'used
Dim res As Long
Dim ar() As Byte, len_ As Long, unused As Long
ReDim ar(0)
ar = stringToUtf8bytes(sql)
len_ = UBound(ar) - LBound(ar) + 1
res = sqlite3_prepare_v2(db, VarPtr(ar(0)), len_, prepareStmt, unused)
If res <> SQLITE_OK Then
Err.Raise 6000, "prepareStmt", "sqlite3_prepare failed, res = " & res
End If
unused = unused - VarPtr(ar(0))

' Debug.Print ("stmt = " & prepareStmt), unused, len_

End Function
Function openDB(fileName As String) As Long
'used
Dim res As Long

res = sqlite3_open(fileName, openDB)
If res <> SQLITE_OK Then
Err.Raise 6000, "openDB", "sqlite_open failed, res = " & res
End If

'Debug.Print ("SQLite db opened, db = " & openDB)

End Function

Sub closeDB(db As Long)

Dim res As Long

res = sqlite3_close(db)
If res <> SQLITE_OK Then
Err.Raise 6000, "closeDB", "sqlite_open failed, res = " & res
End If

End Sub ' }

Sub checkBindRetval(retVal As Long)

If retVal = SQLITE_OK Then
Exit Sub
End If

If retVal = SQLITE_TOOBIG Then
Err.Raise 6000, "checkBindRetval", "bind failed: String or BLOB exceeds size limit"
End If

If retVal = SQLITE_MISUSE Then
Err.Raise 6000, "checkBindRetval", "bind failed: Library used incorrectly"
End If

Err.Raise 6000, "checkBindRetval", "bind failed, retVal = " & retVal

End Sub

Sub checkStepRetval(retVal As Long)

If retVal = SQLITE_DONE Then
Exit Sub
End If

Err.Raise 6000, "checkStepRetval", "step failed, retVal = " & retVal

End Sub

Function arraysize(b() As Byte)
arraysize = UBound(b) - LBound(b) + 1
End Function
Function emptyarray() As Byte()
ReDim emptyarray(0)
emptyarray = vbNullString
End Function
Sub testb()
Debug.Print arraysize(emptyarray())
End Sub