' ########################################################################################
' File: cCTSQLite.inc
' Contents: FreeBasic Windows SQLite class support.
' Version: 1.00
' Compiler: FreeBasic 32 & 64-bit Windows
' Copyright (c) 2017 Rick Kelly
' Released into the public domain for private and public use without restriction
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

#Pragma Once

#Include Once "windows.bi"

Namespace cCTSQLiteClass

Private Const SQLITE_OK                  = &h00000000
Private Const SQLITE_TRUE                = &h00000001
Private Const SQLITE_OPEN_READONLY       = &h00000001  
Private Const SQLITE_OPEN_READWRITE      = &h00000002  
Private Const SQLITE_OPEN_CREATE         = &h00000004  
Private Const SQLITE_OPEN_URI            = &h00000040  
Private Const SQLITE_OPEN_MEMORY         = &h00000080  
Private Const SQLITE_OPEN_NOMUTEX        = &h00008000  
Private Const SQLITE_OPEN_FULLMUTEX      = &h00010000  
Private Const SQLITE_OPEN_SHAREDCACHE    = &h00020000  
Private Const SQLITE_OPEN_PRIVATECACHE   = &h00040000  
Private Const SQLITE_OPEN_WAL            = &h00080000
Private Const SQLITE_CONFIG_LOG          = 16

End Namespace

' ########################################################################################
' cCTSQLite Class
' ########################################################################################

Type cCTSQLite Extends Object

Dim pSQLite          as Any Ptr
Dim lStartUp         as BOOLEAN = False
Dim iInitialize      as Long
Dim sStartUpError    as String = ""
Dim sSQLite3Version  as String = ""
   

' SQLite API's

' Recommendations from SQLite documentation

' For maximum portability, it is recommended that applications always invoke sqlite3_initialize()
' directly prior to using any other SQLite interface. Future releases of SQLite may require this.
' When all connections are closed sqlite3_shutdown() is needed to release all sqlite3_initialize()
' resources allocated.

' Shared cache is disabled by default. But this might change in future releases of SQLite.
' Applications that care about shared cache setting should set it explicitly. 


Dim sqlite3_libversion as Function() as Const ZString Ptr
Dim sqlite3_initialize as Function() as Long
Dim sqlite3_shutdown as Function() as Long
Dim sqlite3_enable_shared_cache as Function(ByVal as Long) as Long
Dim sqlite3_open_v2 as Function(ByRef filename as ZString, ByRef hDbc as DWORD, ByVal flags as Long, ByVal zVfs as ZString Ptr) as Long
Dim sqlite3_close as Function(ByVal hDbc as DWORD) as Long
Dim sqlite3_get_table as Function(ByVal hDbc as DWORD, ByRef szSql as ZString, ByRef pazResult as ZString Ptr Ptr, ByRef pnRow as Long, _
                                  ByRef pnColumn as Long, ByRef pzErrmsg as ZString Ptr) as Long
Dim sqlite3_free as Sub(ByVal as Any Ptr)
Dim sqlite3_free_table as Sub(ByVal result as ZString Ptr Ptr)
Dim sqlite3_extended_result_codes as Function(ByVal hDbc as DWORD, ByVal onoff as Long) as Long
Dim sqlite3_extended_errcode as Function(ByVal hDbc as DWORD) as Long
Dim sqlite3_errmsg as Function(ByVal hDbc as DWORD) as Const ZString Ptr 

    Private:

    Public:

    Declare Function StartupStatus(ByRef sStartUpErrorDescription as String) as BOOLEAN
    Declare Property Version() as String
    Declare Function OpenDatabase(ByRef zDatabaseName as ZString, _
                                  ByRef hDbc as DWORD, _
                                  ByRef iErrorCode as Long, _
                                  ByVal iOpenOptions as Long) as BOOLEAN
    Declare Function CloseDatabase(ByVal hDbc as DWORD, _
                                   ByRef iErrorCode as Long) as BOOLEAN
    Declare Function SQLExec(ByVal hDbc as DWORD, _
                             ByRef szSQL as ZString, _
                             arResults() as String, _                                    
                             ByRef iCols as Long, _
                             ByRef iRows as Long, _
                             ByRef iErrorCode as Long, _
                             ByRef sErrorDescription as String) as BOOLEAN
    Declare Function DatabaseVersion(ByVal hDbc as DWORD) as Long
    Declare Function SQLExtendedErrorDescription(ByVal hDbc as DWORD, _
                                                 ByRef iExtendedError as Long) as String
                                       
    Declare Constructor
    Declare Destructor

End Type

Constructor cCTSQLite()

     This.pSQLite = DyLibLoad("sqlite3.dll")
     
     If This.pSQLite = 0 Then
     
        This.sStartupError = "Library sqlite3.dll not found."
        
     Else
     
        This.sqlite3_initialize = DyLibSymbol(This.pSQLite,"sqlite3_initialize")
        If This.sqlite3_initialize = 0 Then
           This.sStartupError = "API sqlite3_initialize is missing."
           Exit Constructor
        Else
           iInitialize = This.sqlite3_initialize()
           If iInitialize <> cCTSQLiteClass.SQLITE_OK Then
              This.sStartupError = Str(iInitialize) + " - Library sqlite3.dll could not be initialized."
              Exit Constructor
           End If        
        End If
        
        This.sqlite3_shutdown = DyLibSymbol(This.pSQLite,"sqlite3_shutdown")
        If This.sqlite3_shutdown = 0 Then
           This.sStartupError = "API sqlite3_shutdown is missing."
           Exit Constructor
        End If
        
        This.sqlite3_enable_shared_cache = DyLibSymbol(This.pSQLite,"sqlite3_enable_shared_cache")
        If This.sqlite3_enable_shared_cache = 0 Then
           This.sStartupError = "API sqlite3_enable_shared_cache is missing."
           Exit Constructor
        Else
           iInitialize = This.sqlite3_enable_shared_cache(cCTSQLiteClass.SQLITE_TRUE)
           If iInitialize <> cCTSQLiteClass.SQLITE_OK Then
              This.sStartupError = Str(iInitialize) + " - Enable shared cache failed."
              Exit Constructor
           End If        
        End If
        
        This.sqlite3_open_v2 = DyLibSymbol(This.pSQLite,"sqlite3_open_v2")
        If This.sqlite3_open_v2 = 0 Then
           This.sStartupError = "API sqlite3_open_v2 is missing."
           Exit Constructor
        End If
        
        This.sqlite3_close = DyLibSymbol(This.pSQLite,"sqlite3_close")
        If This.sqlite3_close = 0 Then
           This.sStartupError = "API sqlite3_close is missing."
           Exit Constructor
        End If
        
        This.sqlite3_get_table = DyLibSymbol(This.pSQLite,"sqlite3_get_table")
        If This.sqlite3_get_table = 0 Then
           This.sStartupError = "API sqlite3_get_table is missing."
           Exit Constructor
        End If
        
        This.sqlite3_free = DyLibSymbol(This.pSQLite,"sqlite3_free")
        If This.sqlite3_free = 0 Then
           This.sStartupError = "API sqlite3_free is missing."
           Exit Constructor
        End If
        
        This.sqlite3_free_table = DyLibSymbol(This.pSQLite,"sqlite3_free_table")
        If This.sqlite3_free_table = 0 Then
           This.sStartupError = "API sqlite3_free_table is missing."
           Exit Constructor
        End If
        
        This.sqlite3_extended_result_codes = DyLibSymbol(This.pSQLite,"sqlite3_extended_result_codes")
        If This.sqlite3_extended_result_codes = 0 Then
           This.sStartupError = "API sqlite3_extended_result_codes is missing."
           Exit Constructor
        End If
        
        This.sqlite3_extended_errcode = DyLibSymbol(This.pSQLite,"sqlite3_extended_errcode")
        If This.sqlite3_extended_errcode = 0 Then
           This.sStartupError = "API sqlite3_extended_errcode is missing."
           Exit Constructor
        End If
        
        This.sqlite3_errmsg = DyLibSymbol(This.pSQLite,"sqlite3_errmsg")
        If This.sqlite3_errmsg = 0 Then
           This.sStartupError = "API sqlite3_errmsg is missing."
           Exit Constructor
        End If
     
        This.sqlite3_libversion = DyLibSymbol(This.pSQLite,"sqlite3_libversion")
        If This.sqlite3_libversion = 0 Then
           This.sStartupError = "API sqlite3_libversion is missing."
           Exit Constructor
        Else
           This.sSQLite3Version = *Cast(ZString Ptr,This.sqlite3_libversion())
        End If 
    
        lStartUp = True
        
     End If
        

End Constructor
Destructor cCTSQLite()

         If This.pSQLite <> 0 Then
         
            If This.sqlite3_initialize <> 0 Then
            
               This.sqlite3_shutdown()
            
            End If
         
            DyLibFree This.pSQLite
            
         End If

End Destructor

' =====================================================================================
' Get Database User Version
' =====================================================================================
Private Function cCTSQLite.DatabaseVersion (ByVal hDbc as DWORD) as Long

Dim szSQL                    as ZString * 21 = "PRAGMA USER_VERSION;"
Dim arResults()              as String
Dim iCols                    as Long
Dim iRows                    as Long
Dim sErrorDescription        as String
Dim iDBVersion               as Long = 0
Dim iErrorCode               as Long

    If SQLExec(hDbc,szSQL,arResults(),iCols,iRows,iErrorCode,sErrorDescription) = True Then
    
       If UBound(arResults) > 0 Then
       
          iDBVersion = Val(arResults(1))
       
       End If

    End If

    Function = iDBVersion
    
End Function
' =====================================================================================
' Open Database
' =====================================================================================
Private Function cCTSQLite.SQLExec (ByVal hDbc as DWORD, _
                                    ByRef szSQL as ZString, _
                                    arResults() as String, _                                    
                                    ByRef iCols as Long, _
                                    ByRef iRows as Long, _
                                    ByRef iErrorCode as Long, _
                                    ByRef sErrorDescription as String) as BOOLEAN

Dim pazResult     as ZString Ptr Ptr
Dim pzErrmsg      as ZString Ptr
Dim iResultSize   as Long
Dim iIndex        as Long

    sErrorDescription = ""
    iCols = 0
    iRows = 0

' Clear array if it has any contents

    Erase arResults
   
' Exec SQL presented

    iErrorCode = This.sqlite3_get_table(hDbc,szSQL,pazResult,iRows,iCols,pzErrmsg)
    
' If there is an error message available, save it and release the memory
                               
    If pzErrmsg <> 0 Then

       sErrorDescription = *Cast(ZString Ptr,pzErrmsg) 
    
       sqlite3_free(pzErrmsg)
    
    End If
   
    If iErrorCode <> cCTSQLiteClass.SQLITE_OK Then

       This.sqlite3_free_table(pazResult)   
       Function = False
       Exit Function
      
    End If
   
' If we have any results, save them

    iResultSize = ((iRows + 1) * iCols) - 1
     
    If iResultSize >= 0 Then
      
       ReDim arResults (0 To iResultSize)
       
       For iIndex = 0 To iResultSize
          
           If pazResult[iIndex] = 0 Then
           
              arResults(iIndex) = ""
              
           Else
           
              arResults(iIndex) = *pazResult[iIndex]
              
           End If
       
       Next 
      
    End If   
      
    This.sqlite3_free_table(pazResult)
       
    Function = True                                    
                                    
End Function
' =====================================================================================
' Open Database
' =====================================================================================
Private Function cCTSQLite.OpenDatabase (ByRef szDatabaseName as ZString, _
                                         ByRef hDbc as DWORD, _
                                         ByRef iErrorCode as Long, _
                                         ByVal iOpenOptions as Long) as BOOLEAN
                                         
Dim lResult                  as BOOLEAN
Dim iCloseError              as Long
Dim szSQL                    as ZString * 260
Dim arResults()              as String
Dim iCols                    as Long
Dim iRows                    as Long
Dim sErrorDescription        as String

    iErrorCode = This.sqlite3_open_v2(szDatabaseName,hDbc,iOpenOptions,0)

    lResult = IIf(iErrorCode = cCTSQLiteClass.SQLITE_OK,True,False)
    
    If lResult = True Then
    
       This.sqlite3_extended_result_codes(hDbc,cCTSQLiteClass.SQLITE_TRUE)
       
       szSQL = "PRAGMA JOURNAL_MODE=WAL; " _
             + "PRAGMA WAL_AUTOCHECKPOINT=500; " _
             + "PRAGMA SECURE_DELETE; " _
             + "PRAGMA SYNCHRONOUS=FULL; " _
             + "PRAGMA THREADS=0;" _
             + "PRAGMA BUSY_TIMEOUT=30000"
             
       SQLExec(hDbc,szSQL,arResults(),iCols,iRows,iCloseError,sErrorDescription)
       
    Else
    
' SQLite Documentation

' A database connection handle is usually returned even if an error occurs. The only exception is that
' if SQLite is unable to allocate memory to hold the connection handle, a NULL will be written

       If hDbc <> 0 Then    
          CloseDatabase(hDbc,iCloseError)
          hDbc = 0
       End If
       
    End If
    
    Function = lResult

End Function
' =====================================================================================
' Close Database
' =====================================================================================
Private Function cCTSQLite.CloseDatabase (ByVal hDbc as DWORD, _
                                          ByRef iErrorCode as Long) as BOOLEAN

    iErrorCode = This.sqlite3_close(hDbc)
    
    Function = IIf(iErrorCode = cCTSQLiteClass.SQLITE_OK,True,False)

End Function
' =====================================================================================
' Get Server Startup Status
' =====================================================================================
Private Function cCTSQLite.StartupStatus (ByRef sStartUpErrorDescription as String) as BOOLEAN

    sStartUpErrorDescription = This.sStartUpError
    
    Function = This.lStartup

End Function
' =====================================================================================
' Get SQLite Library Version
' =====================================================================================
Private Property cCTSQLite.Version () as String
   
    Property = This.sSQLite3Version

End Property
Function cCTSQLite.SQLExtendedErrorDescription(ByVal hDbc as DWORD, _
                                               ByRef iExtendedError as Long) as String

   iExtendedError = This.sqlite3_extended_errcode(hDbc)
   
   Function = *Cast(ZString Ptr,This.sqlite3_errmsg(hDbc))

End Function