sqlite.inc

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

    '   X'"+sqlBinToHex(sIcon)+"'  - sIcon is a binary file loaded into a string
    '   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    '   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    '
    sBlob = REPEAT$(LEN(sBin) , "  ")
    lAtHere = 1
    lLenBin = LEN(sBin)
    FOR i=1 TO lLenBin
        sOneChar = MID$(sBin, i, 1)
        bByte = CVBYT(sOneChar)
        sHex = HEX$(bByte,2)
        MID$(sBlob, lAtHere, 2) = sHex
        INCR lAtHere
        INCR lAtHere
    NEXT i
    FUNCTION = sBlob
END FUNCTION
' --------------------------------------------------
' --------------------------------------------------
FUNCTION sqlQuoteToBin( BYVAL sQuote AS STRING ) AS STRING
    LOCAL i, lLong, lAtHere AS LONG
    LOCAL s, sTwoChar AS STRING
    LOCAL lLenQuote, x AS LONG '7/20/06
    '
    '   see sqlBlobGet() & sqlBlobSet() for an easy wrapper around this
    '
    '   converts the HEX value returned by SQLite's quote() function
    '   IMPORTANT!!! - little different form of HEX string = "X'FFFF'"
    '
    '   "SELECT quote(BlobCol) AS TheBlob FROM MyTable WHERE rowid=1"
    '   sBlob = sqlQuoteToBin(sqlGet(rs, "TheBlob"))
    '
    '   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    '       quote()
    '   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    '   you have to use the SQLite function !!! quote() !!!
    '   the returned value is HEX with an X in front, enclosed in single quotes
    '   this function removes the "X" and single quotes
    '   and converts the rest to binary
    '
    '   if you don't use quote() - you'll get a weird string
    '
    '   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    '   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    '
    lAtHere = 1
    s = REPEAT$(LEN(sQuote)/2, " ")
    lLenQuote = LEN(sQuote)
    x = lLenQuote - 1
    FOR i=3 TO x STEP 2
        sTwoChar = MID$(sQuote, i, 2)
        lLong = VAL("&H"+sTwoChar)
        MID$(s, lAtHere, 1) = CHR$(lLong)
        INCR lAtHere
    NEXT i
    FUNCTION = s
END FUNCTION
' --------------------------------------------------
' --------------------------------------------------
FUNCTION sqlBlobGet( BYVAL hDB AS LONG, BYVAL sTable AS STRING, BYVAL sBlobColumn AS STRING, BYVAL lRowID AS LONG, BYREF sBlobValue AS STRING ) AS LONG
    LOCAL sSql AS STRING
    LOCAL rs AS sqlRecSetType

    '    sqlBlobGet & sqlBlobSet offer an easier way to get/set a single row/column blob
    '    get blob value from sTable/sBlobColumn/lRowID
    '    sBlobValue will contain blob - if no errors
    '    function will be false if error occurred
    '    this is a wrapper around using SQLite quote() function to extract a blob

    sqlRecSetNew(rs, hDB, LOCAL)

    sSql = "SELECT quote(["+sBlobColumn+"]) AS TheBlob FROM ["+sTable+"] WHERE rowid=" + STR$(lRowID)
    IF ISFALSE sqlSelect(rs, sSql) THEN GOTO HERE '>>>
    IF rs.RowCount THEN
        sqlMoveFirst rs
        sBlobValue = sqlQuoteToBin(sqlGetAt(rs, 1))
        FUNCTION = -1
    END IF

    HERE:
    sqlFree rs
END FUNCTION
' --------------------------------------------------
' --------------------------------------------------
FUNCTION sqlBlobSet( BYVAL hDB AS LONG, BYVAL sTable AS STRING, BYVAL sBlobColumn AS STRING, BYVAL lRowID AS LONG, BYVAL sBlobValue AS STRING ) AS LONG
    LOCAL sSql AS STRING

    '    sqlBlobGet & sqlBlobSet offer an easier way to get/set a single row/column blob
    '    set blob value at sTable/sBlobColumn/lRowID with sBlobValue - if no errors
    '    function will be false if error occurred
    '    this a wrapper around SQLite syntax X'' - setting a column to a HEX value

    sSql = "UPDATE ["+sTable+"] SET ["+sBlobColumn+"]=X'"+sqlBinToHex(sBlobValue)+"' WHERE rowid=" + STR$(lRowID)
    IF sqlExe(hDB, sSql) THEN FUNCTION = -1
END FUNCTION
' --------------------------------------------------
' --------------------------------------------------
FUNCTION sqlBlobToFile( BYVAL hDB AS LONG, BYVAL sTable AS STRING, BYVAL sBlobColumn AS STRING, BYVAL lRowID AS LONG, BYVAL sFileSpec AS STRING ) AS LONG
    LOCAL ff, lOK AS LONG
    LOCAL sTheBlob AS STRING
    LOCAL rs AS sqlRecSetType
    '   get the BLOB from sBlobColumn and BINARY PUT$ to sFileSpec
    '   lRowID = Integer Primary Key for Row containing the BLOB
    '   success=-1 : failure=0
    '
    '   it could fail with an SQLite error or a File error

    sqlRecSetNew(rs, hDB, LOCAL)
    ff = FREEFILE
    lOK = -1

    IF ISFALSE hDB THEN
        lOK = 0
    ELSE
        IF ISFALSE sqlSelect(rs, "select quote(["+sBlobColumn+"]) as b from ["+sTable+"] where rowid="+STR$(lRowID)) THEN
            lOK = 0
        ELSE
            IF ISFALSE rs.RowCount THEN
                lOK = 0
            ELSE
                sqlMoveFirst rs
                sTheBlob = sqlQuoteToBin(sqlGet(rs, "b"))
                TRY
                    OPEN sFileSpec FOR BINARY AS #ff
                    PUT$ #ff, sTheBlob
                CATCH
                    lOK = 0
                FINALLY
                    CLOSE #ff
                END TRY
            END IF
        END IF
    END IF

    sqlFree rs
    FUNCTION = lOK
END FUNCTION
' --------------------------------------------------
' --------------------------------------------------
FUNCTION sqlFileToBlob( BYVAL hDB AS LONG, BYVAL sTable AS STRING, BYVAL sBlobColumn AS STRING, BYVAL lRowID AS LONG, BYVAL sFileSpec AS STRING ) AS LONG
    LOCAL ff, lOK AS LONG
    LOCAL sTheBlob AS STRING
    '   load any kind of file and store in sBlobColumn at Row lRowID

    lOK = 1
    ff = FREEFILE

    IF ISFALSE hDB THEN
        lOK = 0
    ELSE
        TRY
            OPEN sFileSpec FOR BINARY AS #ff
            GET$ #ff, LOF(ff), sTheBlob
            IF ISFALSE sqlExe( hDB, "update ["+sTable+"] set ["+sBlobColumn+"]=X'"+sqlBinToHex(sTheBlob)+"' where rowid="+STR$(lRowID) ) THEN
                lOK = 0
            END IF
        CATCH
            lOK = 0
        FINALLY
            CLOSE #ff
        END TRY
    END IF

    FUNCTION = lOK
END FUNCTION
' --------------------------------------------------
' --------------------------------------------------
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
    '   save SQLite database stored as BLOB in another SQLite database
    '   to a temp file and open for use
    '   hDB = parent database
    '   sTable, sCol, lRowID = Table/Column/rowid stored
    '   hDeepDB = handle for temp SQLite database
    '
    '   hDeepDB can be used to access the database as any SQLite database
    '   use sqlDeepClose() to close the database

    IF hDB THEN
        sDeepFileSpec = "Temp_" + DATE$ +"_"+ TIME$
        REPLACE ":" WITH "-" IN sDeepFileSpec
        sDeepFileSpec = sDeepFileSpec + "." + "sqlite"
        IF sqlBlobToFile(hDB, sTable, sCol, lRowID, sDeepFileSpec) THEN
            IF sqlOpen(sDeepFileSpec, hDeepDB) THEN
                FUNCTION = 1
            END IF
        END IF
    END IF
END FUNCTION
' --------------------------------------------------
' --------------------------------------------------
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
    '   restore temp SQLite database back in parent database as a BLOB
    '   close the handle
    '   delete the temp file
    '   hDB = parent database
    '   sTable, sCol, lRowID = Table/Column/rowid stored
    '   hDeepDB = handle for temp SQLite database
    '   sDeepFileSpec = set by sqlDeepOpen()
    IF hDeepDB THEN sqlClose hDeepDB
    IF sqlFileToBlob(hDB, sTable, sCol, lRowID, sDeepFileSpec) THEN
        FUNCTION = 1
    END IF
    TRY
        KILL sDeepFileSpec
    CATCH
    END TRY
END FUNCTION
' --------------------------------------------------
' --------------------------------------------------
FUNCTION sqlTextColToFile( BYVAL hDB AS LONG, BYVAL sTable AS STRING, BYVAL sCol AS STRING, BYVAL lRowID AS LONG, BYVAL sFileSpec AS STRING ) AS LONG
    LOCAL ff, lOK AS LONG
    LOCAL sTextValue AS STRING
    LOCAL rs AS sqlRecSetType
    '   get text value from sCol and save to sFileSpec
    '   lRowID = Integer Primary Key for the Row
    '   success=-1 : failure=0
    '
    '   it could fail with an SQLite error or a File error

    sqlRecSetNew(rs, hDB, LOCAL)
    ff = FREEFILE
    lOK = -1

    IF ISFALSE hDB THEN
        lOK = 0
    ELSE
        IF ISFALSE sqlSelect(rs, "select ["+sCol+"] as b from ["+sTable+"] where rowid="+STR$(lRowID)) THEN
            lOK = 0
        ELSE
            IF ISFALSE rs.RowCount THEN
                lOK = 0
            ELSE
                sqlMoveFirst rs
                sTextValue = sqlGet(rs, "b")
                IF RIGHT$(sTextValue,2) = $CRLF THEN sTextValue = LEFT$(sTextValue, LEN(sTextValue)-2)
                TRY
                    OPEN sFileSpec FOR BINARY AS #ff
                    'print #ff, sTextValue
                    PUT$ #ff, sTextValue
                CATCH
                    lOK = 0
                FINALLY
                    CLOSE #ff
                END TRY
            END IF
        END IF
    END IF

    sqlFree rs
    FUNCTION = lOK
END FUNCTION
' --------------------------------------------------
' --------------------------------------------------
FUNCTION sqlFileToTextCol( BYVAL hDB AS LONG, BYVAL sTable AS STRING, BYVAL sCol AS STRING, BYVAL lRowID AS LONG, BYVAL sFileSpec AS STRING ) AS LONG
    LOCAL ff, lOK AS LONG
    LOCAL sTextValue AS STRING
    '   load text file and store in sCol at Row lRowID

    lOK = 1
    ff = FREEFILE

    IF ISFALSE hDB THEN
        lOK = 0
    ELSE
        TRY
            OPEN sFileSpec FOR BINARY AS #ff
            GET$ #ff, LOF(ff), sTextValue
            IF ISFALSE sqlExe( hDB, "update ["+sTable+"] set ["+sCol+"]='"+sqlFix(sTextValue)+"' where rowid="+STR$(lRowID) ) THEN
                lOK = 0
            END IF
        CATCH
            lOK = 0
        FINALLY
            CLOSE #ff
        END TRY
    END IF

    FUNCTION = lOK
END FUNCTION
' --------------------------------------------------
' --------------------------------------------------
FUNCTION sqlParam( BYVAL sSql AS STRING , saParam() AS STRING ) AS STRING
    LOCAL i AS LONG
    LOCAL saSql() AS STRING
    LOCAL s, sParam AS STRING
    '
    ' this is FAKE parameters
    ' it escapes all single quotes
    ' makes it easy to construct a statement
    ' need to put '?' single quote around text column values

    ' redim saParam(1 to 4)
    ' array assign saParam() = "Bob's Best Burgers", "123 First St", "NoWhere, USA", "27"
    ' s = sqlParam( "update tabel set AAA='?', BBB='?', CCC='?' where rowid=?", saParam() )

    ' redim saParam(1 to 7)
    ' array assign saParam() = "MyTable", "AAA", "Bob's Best Burgers", "BBB", "123 First St", "CCC", "NoWhere, USA", "27"
    ' s = sqlParam( "update ? set ?='?', ?='?', ?='?' where rowid=?", saParam() )
    '
    IF INSTR(sSql,"?")<1 THEN
        ? "sqlParam() SQL statement missing '?'"
        EXIT FUNCTION
    END IF

    REDIM saSql( 1 TO PARSECOUNT(sSql,"?") )
    PARSE  sSql, saSql(), "?"
    IF UBOUND(saSql) <> UBOUND(saParam)+1 THEN
        ? "sqlParam() parameter missmatch"
        EXIT FUNCTION
    END IF

    s = saSql(1)
    FOR i=1 TO UBOUND(saParam)
        sParam = saParam(i)
        REPLACE "'" WITH "''" IN sParam
        s = s + sParam + saSql(i+1)
    NEXT i

    FUNCTION = s
END FUNCTION
' --------------------------------------------------
' --------------------------------------------------
'    easy way to insert tables with large number of columns
'    it escapes all " ' "
'
'    sqlExe(hDB,"begin")
'    for i=1 to 5
'        sqlStmntReset "Table4"     'has to be reset every iteration to clear arrays
'
'        sqlStmntAddCol "TextCol", "Table4's TextCol"
'        sqlStmntAddColNumber "IntCol2", format$(i)
'        sqlStmntAddColNumber "DblCol3", format$(i+10.99,"#####.##")
'        sqlExe(hDB, sqlStmntGetInsert())
'    next i
'    sqlExe(hDB,"commit")
' --------------------------------------------------
' --------------------------------------------------
SUB stmntReset( BYVAL ThisTable AS STRING )
    'has to be reset every loop to clear arrays
    REDIM TheSqlStmnt__Cols()
    REDIM TheSqlStmnt__Values()
    TheSqlStmnt__Table = ThisTable
END SUB
' --------------------------------------------------
' --------------------------------------------------
SUB stmntAddCol( BYVAL ThisCol AS STRING, BYVAL ThisStrValue AS STRING )
    LOCAL s$