sqlite.inc

Powerbasic 源码 这是对Sqlite这种数据库的操作.

#IF NOT %DEF(%SQLITE_INC)
%SQLITE_INC = 1
'ver 46.7
'   SQLite 3 databases
'   no dependencies
'   just needs latest sqlite3.dll - http://www.sqlite.org/download.html
'
'   written with PBCC 4.0/PBWin 8.1
'
'   Thanks to Terence McDonnell, Don Dickinson, Eric Cochran
'   public domain - use at your own risk
'   This code is public domain, but the concept of Deep SQL is NOT
'   May be freely used with SQLite databases (sqlite.org)
'   7/27/06 - Added support for Deep SQL - opening SQLite databases stored inside parent DB
'           sqlDeepOpen() & sqlDeepClose()
'   6/17/06 - Added - Binary In/Out - store Word document, icons - whatever
'   6/18/06 - Added sqlColTypeOf() - test to see if a field contains a BLOB
'   6/18/06 - sqlQuoteToBin() was way too slow - fixed
'   7/4/06  - sqlBlobGet() & sqlBlobSet() offer an easier way to get/set a single row/column blob
'   7/4/06  - stmntAddBlob() - add a blob value to the INSERT statement for stmntGetInsert() set of functions
'
'    =================================================================
'    A little tongue-in-cheek: If indeed SQLight
'    (http://www.sqlight.com/) is the first application to support SQL
'    databases within SQL databases, down to any level, then let
'    SQLight serve as prior art to the concept and a letter patent.
'    The driver library SQLight uses has DeepOpen() and DeepClose() to
'    support deep queries. Let it serve as prior art and a letter
'    patent to the concept of Deep SQL. Permissions granted for free
'    use with SQLite databases. What's this statement worth? Probably
'    nothing. If someone does move forward with the concept - throw me
'    a bone.
'    =================================================================
'
'
'
'
%PRAGMA_default_cache_size = 20000   'default = 2000
%PRAGMA_temp_store         = 2       '0=default, 1=file, 2=memory
'
GLOBAL TheSqlStmnt__Cols()   AS STRING
GLOBAL TheSqlStmnt__Values() AS STRING
GLOBAL TheSqlStmnt__Table    AS STRING
'
TYPE sqlRecSetType
    pDBh        AS LONG   PTR   ' pointer to database handle
    pTable      AS LONG   PTR   ' ptr to SQLite Table Array
    pCols       AS STRING PTR   ' column names
    ColCount    AS LONG         ' column count
    RowCount    AS LONG         ' row count
    RowNo       AS LONG         ' current row ~ 1 to RowCount
    FirstColNdx AS LONG         ' first column based on RowNo
    IsEof       AS LONG         ' end of record set - Ndx > RowCount
    IsBof       AS LONG         ' beginning of record set - Ndx < 1
END TYPE
    '
    '   !!! Must call before using a RecordSet !!!
    '
    '   GLOBAL tRS AS sqlRecSetType
    '   LOCAL  tRS AS sqlRecSetType
    '   !!! call sqlFree(tRS) when to free SQLight DLL memory !!!
MACRO sqlRecSetNew(tRS, hDB, GlobalOrLocal)
    MACROTEMP Cols
    GlobalOrLocal Cols() AS STRING  : REDIM Cols()
    '
    tRS.pDBh        = VARPTR(hDB)
    tRS.pCols       = VARPTR(Cols())
    tRS.ColCount    = 0
    tRS.RowCount    = 0
    tRS.RowNo       = 0
    tRS.FirstColNdx = 0
    tRS.IsEof       = -1
    tRS.IsBof       = -1
END MACRO
    '   create local recordset without declaring it
    '   !!! call sqlFree(tRS) when to free SQLight DLL memory !!!
MACRO sqlRecSetLocal(tRS, hDB)
    MACROTEMP Cols
    LOCAL Cols() AS STRING  : REDIM Cols()
    LOCAL tRS AS sqlRecSetType
    '
    tRS.pDBh        = VARPTR(hDB)
    tRS.pCols       = VARPTR(Cols())
    tRS.ColCount    = 0
    tRS.RowCount    = 0
    tRS.RowNo       = 0
    tRS.FirstColNdx = 0
    tRS.IsEof       = -1
    tRS.IsBof       = -1
END MACRO
'
DECLARE FUNCTION sqlOpen( BYVAL sFileSpec AS STRING, BYREF hDB AS LONG ) AS LONG
DECLARE SUB sqlClose( BYREF hDB AS LONG )
DECLARE FUNCTION sqlErrMsg( BYVAL hDB AS LONG ) AS STRING
DECLARE SUB sqlFree( tRS AS sqlRecSetType )
DECLARE FUNCTION sqlSelect( tRS AS sqlRecSetType, sSql AS STRING ) AS LONG
DECLARE FUNCTION sqlSelectGet( BYVAL hDB AS LONG, sSql AS STRING, sReturnValue AS STRING ) AS LONG
DECLARE FUNCTION sqlExe( BYVAL hDB AS LONG, sSql AS STRING ) AS LONG
DECLARE FUNCTION sqlRowCount( tRS AS sqlRecSetType ) AS LONG
DECLARE FUNCTION sqlColCount( tRS AS sqlRecSetType ) AS LONG
DECLARE FUNCTION sqlEOF( tRS AS sqlRecSetType ) AS LONG
DECLARE FUNCTION sqlBOF( tRS AS sqlRecSetType ) AS LONG
DECLARE SUB sqlMoveTo( tRS AS sqlRecSetType, BYVAL lMoveTo AS LONG )
DECLARE SUB sqlMoveFirst( tRS AS sqlRecSetType )
DECLARE SUB sqlMoveNext( tRS AS sqlRecSetType )
DECLARE SUB sqlMovePrev( tRS AS sqlRecSetType )
DECLARE SUB sqlMoveLast( tRS AS sqlRecSetType )
DECLARE FUNCTION sqlGet( tRS AS sqlRecSetType, BYVAL sColName AS STRING ) AS STRING
DECLARE FUNCTION sqlGetPZ( tRS AS sqlRecSetType, BYVAL sColName AS STRING ) AS LONG
DECLARE FUNCTION sqlGetAt( tRS AS sqlRecSetType, BYVAL lColNo AS LONG ) AS STRING
DECLARE FUNCTION sqlGetAtPZ( tRS AS sqlRecSetType, BYVAL lColNo AS LONG ) AS LONG
DECLARE FUNCTION sqlColNo( tRS AS sqlRecSetType, BYVAL sColName AS STRING ) AS LONG
DECLARE FUNCTION sqlColName( tRS AS sqlRecSetType, BYVAL lColNo AS LONG ) AS STRING
DECLARE FUNCTION sqlColTypeOf( BYVAL hDB AS LONG, BYVAL sTable AS STRING, BYVAL sColName AS STRING, BYVAL lRowID AS LONG ) AS STRING
DECLARE SUB sqlTableList( BYVAL hDB AS LONG, saTableList() AS STRING )
DECLARE FUNCTION sqlTableExist( BYVAL hDB AS LONG, BYVAL sTable AS STRING ) AS LONG
DECLARE SUB sqlColList( BYVAL hDB AS LONG, BYVAL sTable AS STRING, saColList() AS STRING )
DECLARE FUNCTION sqlPrimKeyCol( BYVAL hDB AS LONG, BYVAL sTable AS STRING) AS STRING
DECLARE SUB sqlIndexList( BYVAL hDB AS LONG, BYVAL sTable AS STRING, saIndexList() AS STRING )
DECLARE FUNCTION sqlGetColCreateSQL( BYVAL hDB AS LONG, BYVAL sTable AS STRING, BYVAL ColID AS LONG ) AS STRING
DECLARE FUNCTION sqlFix( BYVAL sString AS STRING) AS STRING
DECLARE FUNCTION sqlDate( BYVAL sDate AS STRING ) AS STRING
DECLARE FUNCTION sqlTimeStamp() AS STRING
DECLARE FUNCTION sqlBinToHex( BYVAL sBin AS STRING ) AS STRING
DECLARE FUNCTION sqlQuoteToBin( BYVAL sQuote AS STRING ) AS STRING
DECLARE FUNCTION sqlBlobGet( BYVAL hDB AS LONG, BYVAL sTable AS STRING, BYVAL sBlobColumn AS STRING, BYVAL lRowID AS LONG, BYREF sBlobValue AS STRING ) AS LONG
DECLARE FUNCTION sqlBlobSet( BYVAL hDB AS LONG, BYVAL sTable AS STRING, BYVAL sBlobColumn AS STRING, BYVAL lRowID AS LONG, BYVAL sBlobValue AS STRING ) AS LONG
DECLARE FUNCTION sqlBlobToFile( BYVAL hDB AS LONG, BYVAL sTable AS STRING, BYVAL sBlobColumn AS STRING, BYVAL lRowID AS LONG, BYVAL sFileSpec AS STRING ) AS LONG
DECLARE FUNCTION sqlFileToBlob( BYVAL hDB AS LONG, BYVAL sTable AS STRING, BYVAL sBlobColumn AS STRING, BYVAL lRowID AS LONG, BYVAL sFileSpec AS STRING ) AS LONG
DECLARE FUNCTION sqlDeepOpen( BYVAL hDB AS LONG, BYVAL sTable AS STRING, BYVAL sCol AS STRING, BYVAL lRowID AS LONG, BYREF hDeepDB AS LONG, BYREF sDeepFileSpec AS STRING ) AS LONG
DECLARE FUNCTION sqlDeepClose( BYVAL hDB AS LONG, BYVAL sTable AS STRING, BYVAL sCol AS STRING, BYVAL lRowID AS LONG, BYVAL hDeepDB AS LONG, BYVAL sDeepFileSpec AS STRING ) AS LONG
DECLARE FUNCTION sqlTextColToFile( BYVAL hDB AS LONG, BYVAL sTable AS STRING, BYVAL sCol AS STRING, BYVAL lRowID AS LONG, BYVAL sFileSpec AS STRING ) AS LONG
DECLARE FUNCTION sqlFileToTextCol( BYVAL hDB AS LONG, BYVAL sTable AS STRING, BYVAL sCol AS STRING, BYVAL lRowID AS LONG, BYVAL sFileSpec AS STRING ) AS LONG
DECLARE FUNCTION sqlParam( BYVAL sSql AS STRING , saParam() AS STRING ) AS STRING
DECLARE SUB stmntReset( BYVAL ThisTable AS STRING )
DECLARE SUB stmntAddCol( BYVAL ThisCol AS STRING, BYVAL ThisStrValue AS STRING )
DECLARE SUB stmntAddBlob( BYVAL ThisCol AS STRING, BYVAL sThisBlob AS STRING )
DECLARE SUB stmntAddNumber( BYVAL ThisCol AS STRING, BYVAL ThisNumValue AS STRING )
DECLARE FUNCTION stmntGetInsert() AS STRING
DECLARE FUNCTION sqlKeyWordCheck( BYVAL sWord AS STRING ) AS LONG
'internal use
DECLARE SUB sql_internal_StrArryPtr_ReDim( BYREF These() AS STRING, ThisDim& )
DECLARE SUB sql_internal_StrArryPtr_Set( BYREF These() AS STRING, AtHere&, BYVAL ThisValue AS STRING )
DECLARE FUNCTION sql_internal_StrArryPtr_Get( BYREF These() AS STRING, AtHere& ) AS STRING
DECLARE FUNCTION sql_internal_StrArryPtr_ScanNoCase( BYREF These() AS STRING, BYVAL ForThis AS STRING ) AS LONG
DECLARE SUB sql_internal_strArryPtr_Erase( BYREF Arry() AS STRING )
'internal use - sqlite3.dll
DECLARE FUNCTION sqlite3_open CDECL LIB "sqlite3.dll" ALIAS "sqlite3_open" (zFilename AS ASCIIZ, hDB AS LONG) AS LONG
DECLARE SUB      sqlite3_close CDECL LIB "sqlite3.dll" ALIAS "sqlite3_close" (BYVAL hDB AS LONG)
DECLARE FUNCTION sqlite_get_table CDECL LIB "sqlite3.dll" ALIAS "sqlite3_get_table" (BYVAL hDB AS LONG, szSql AS ASCIIZ, lpTable AS LONG, nRow AS LONG, nColumn AS LONG, lpErrMsg AS LONG) AS LONG
DECLARE FUNCTION sqlite_free_table CDECL LIB "sqlite3.dll" ALIAS "sqlite3_free_table" (BYVAL lpTable AS LONG PTR) AS LONG
DECLARE FUNCTION sqlite3_errmsg CDECL LIB "sqlite3.dll" ALIAS "sqlite3_errmsg" (BYVAL hDB AS LONG) AS LONG
'
' --------------------------------------------------
' --------------------------------------------------
FUNCTION sqlOpen( BYVAL sFileSpec AS STRING, BYREF hDB AS LONG ) AS LONG
    LOCAL szFileSpec AS ASCIIZ * 400
    ' Create or Open database
    ' set database handle
    ' success=-1 / error=0
    szFileSpec = sFileSpec
    FUNCTION   = IIF&( sqlite3_open( szFileSpec, hDB )=0, -1, 0 )
    IF hDB THEN
        sqlExe( hDB, "PRAGMA default_cache_size =" + STR$(%PRAGMA_default_cache_size) )
        sqlExe( hDB, "PRAGMA temp_store =" + STR$(%PRAGMA_temp_store) )
    END IF
END FUNCTION
' --------------------------------------------------
' --------------------------------------------------
SUB sqlClose( BYREF hDB AS LONG )
    ' close database
    ' do a 'commit' if database still alive
    IF ISTRUE hDB THEN
        sqlExe(hDB, "commit")
        sqlite3_close(hDB)
        hDB = 0
    END IF
END SUB
' --------------------------------------------------
' --------------------------------------------------
FUNCTION sqlErrMsg( BYVAL hDB AS LONG ) AS STRING
    'Thanks to Don Dickinson
    LOCAL pzErr AS ASCIIZ PTR
    LOCAL sErr AS STRING
    '    get the SQLite error message
    '    ? sqlErrMsg(hDB)
    pzErr = sqlite3_errmsg(hDB)
    IF pzErr = 0 THEN
        FUNCTION = ""
    ELSE
        FUNCTION = @pzErr
    END IF
END FUNCTION
' --------------------------------------------------
' --------------------------------------------------
    ''''''''''''''''''''''''''''''''''''''''''''''''
    ''''''''''''''''''''''''''''''''''''''''''''''''
    ''''''''''''''''''''''''''''''''''''''''''''''''
    ' kill every recordset when done with it
    '
    ' Must call sqlFree() to free SQLight DLL table memory
    ''''''''''''''''''''''''''''''''''''''''''''''''
    ''''''''''''''''''''''''''''''''''''''''''''''''
    ''''''''''''''''''''''''''''''''''''''''''''''''
' --------------------------------------------------
' --------------------------------------------------
SUB sqlFree( tRS AS sqlRecSetType )
    '    kill every recordset when down with it
    '    Must call to free SQLight DLL table memory
    sql_internal_strArryPtr_Erase BYVAL tRS.pCols
    IF tRS.RowCount THEN
        sqlite_free_table tRS.pTable
    END IF
    tRS.pTable      = 0
    tRS.ColCount    = 0
    tRS.RowCount    = 0
    tRS.RowNo       = 0
    tRS.FirstColNdx = 0
    tRS.IsEof       = -1
    tRS.IsBof       = -1
END SUB
' --------------------------------------------------
' --------------------------------------------------
FUNCTION sqlSelect( tRS AS sqlRecSetType, sSql AS STRING ) AS LONG
    ' thanks to Terence McDonnell
    LOCAL i, x       AS LONG
    LOCAL lpErrorSz  AS LONG         ' Error msg
    LOCAL pzField    AS ASCIIZ PTR   ' Field return from get_table (element in tRS.pTable array)
    LOCAL lRow, lCol AS LONG
    ' execute query and return record set
    ' success = -1 / error=0
    '
    ' number coulmns = tRS.ColCount
    ' number rows    = tRS.RowCount
    ' current row #  = tRS.RowNo = 1 to tRS.RowCount
    sqlFree tRS
    IF ISFALSE tRS.@pDBh THEN EXIT FUNCTION
    IF sqlite_get_table(tRS.@pDBh, BYVAL STRPTR(sSQL), tRS.pTable, tRS.RowCount, tRS.ColCount, lpErrorSz)<>0 THEN
        'error
        FUNCTION = 0
    ELSEIF tRS.RowCount=0 THEN
        'no error - no results
        FUNCTION = -1
        sqlite_free_table tRS.pTable
    ELSE
        'column names
        sql_internal_StrArryPtr_ReDim BYVAL tRS.pCols, tRS.ColCount
        FOR i=1 TO tRS.ColCount
            pzField = tRS.@pTable[i-1]
            sql_internal_StrArryPtr_Set BYVAL tRS.pCols, i, @pzField
        NEXT i
        FUNCTION = -1
    END IF
END FUNCTION
' --------------------------------------------------
' --------------------------------------------------
FUNCTION sqlSelectGet( BYVAL hDB AS LONG, sSql AS STRING, sReturnValue AS STRING ) AS LONG
    LOCAL rs AS sqlRecSetType
    ' select shortcut
    ' return a value from an SQL statement that will have only one return item
    ' function will be positive if success
    '
    ' sReturnValue = the first column in first row of the recordset
    sqlRecSetNew(rs, hDB, LOCAL)
    IF sqlSelect(rs,sSql) THEN
        IF sqlRowCount(rs) THEN
            sqlMoveFirst rs
            sReturnValue = sqlGetAt(rs, 1)
            FUNCTION = sqlRowCount(rs)
        END IF
    END IF
    sqlFree rs
END FUNCTION
' --------------------------------------------------
' --------------------------------------------------
FUNCTION sqlExe( BYVAL hDB AS LONG, sSql AS STRING ) AS LONG
    LOCAL lpTable    AS LONG PTR
    LOCAL lpErrorSz  AS LONG
    LOCAL RowCount&, ColCount&
    ' execute no return SQL statement
    ' success=-1 / error=0
    ' ? sqlErrMsg(hDB)
    FUNCTION = IIF&( sqlite_get_table(hDB, BYVAL STRPTR(sSQL), lpTable, RowCount&, ColCount&, lpErrorSz)=0, -1, 0 )
    sqlite_free_table lpTable
END FUNCTION
' --------------------------------------------------
' --------------------------------------------------
FUNCTION sqlRowCount( tRS AS sqlRecSetType ) AS LONG
    FUNCTION = tRS.RowCount
END FUNCTION
' --------------------------------------------------
' --------------------------------------------------
FUNCTION sqlColCount( tRS AS sqlRecSetType ) AS LONG
    FUNCTION = tRS.ColCount
END FUNCTION
' --------------------------------------------------
' --------------------------------------------------
FUNCTION sqlEOF( tRS AS sqlRecSetType ) AS LONG
    ' check if moved beyond last row
    FUNCTION = tRS.IsEof
END FUNCTION
' --------------------------------------------------
' --------------------------------------------------
FUNCTION sqlBOF( tRS AS sqlRecSetType ) AS LONG
    ' check if moved before first row
    FUNCTION = tRS.IsBof
END FUNCTION
' --------------------------------------------------
' --------------------------------------------------
SUB sqlMoveTo( tRS AS sqlRecSetType, BYVAL lMoveTo AS LONG )
    ' move to lMoveTo
    '
    '   for i=1 to sqlRowCount(rs)
    '       sqlMoveTo rs, i
    '       'do stuff
    '   next i
    '
    tRS.RowNo = lMoveTo
    tRS.IsBof = 0
    tRS.IsEof = 0
    IF tRS.RowCount<1 THEN
        tRS.IsBof = -1
        tRS.IsEof = -1
    ELSEIF tRS.RowNo<1 THEN
        tRS.IsBof = -1
    ELSEIF tRS.RowNo>tRS.RowCount THEN
        tRS.IsEof = -1
    END IF
    tRS.FirstColNdx = tRS.RowNo * tRS.ColCount
END SUB
' --------------------------------------------------
' --------------------------------------------------
    '   sqlMoveFirst rs
    '   while isfalse sqlEOF(rs)
    '       'do stuff
    '       sqlMoveNext rs
    '   wend
' --------------------------------------------------
' --------------------------------------------------
SUB sqlMoveFirst( tRS AS sqlRecSetType )
    ' move first row
    tRS.RowNo = 1
    tRS.IsBof = 0
    tRS.IsEof = 0
    IF tRS.RowCount<1 THEN
        tRS.IsBof = -1
        tRS.IsEof = -1