when using SQLite databases.
Also shows how to map the SQLITE results set directly onto a listview
No dependencies except for the SQLITE3.dll from www.sqlite.org and the latest PB translation of the SQLITE3.inc wrappers from http://www.jose.it-berater.org.
Code:
' ' a little DDT program to show how to interrupt long running queries ' when using SQLite databases. ' Also shows how to map the SQLITE results set directly onto a listview ' ' Chris Holbrook May 2008. Use at your own risk!. ' Pl3ase post f33dback in PB forums or 3mail m3: [email protected] ' ' #COMPILE EXE #DIM ALL #INCLUDE "WIN32API.INC" #INCLUDE "COMMCTRL.INC" ' get the DLL from http://www.sqlite.org/download.html, tested with v3.5.7 ' members of the Jose Roca software forums can get the 3.5.6 include file ' from http://www.jose.it-berater.org/smfforum/index.php?topic=1604.msg5547 #INCLUDE "sqlite3.inc" ' #INCLUDE "commctrl.inc" #INCLUDE "comdlg32.inc" %IDD_DIALOG1 = 101 %IDC_BUTTON1 = 1001 %IDC_BUTTON2 = 1002 %IDC_TEXTBOX1 = 1003 %IDC_LV1 = 1006 %DEFAULT_LV_STYLES = %ws_child OR %WS_TABSTOP OR %WS_VISIBLE OR %LVS_SHOWSELALWAYS OR %LVS_REPORT %DEFAULT_LV_EX_STYLES = %WS_EX_CLIENTEDGE OR %LVS_EX_GRIDLINES OR %WS_EX_LEFT OR %WS_EX_RIGHTSCROLLBAR GLOBAL ghDB AS DWORD ' mustn't call sqlite3_close on a closed DB, hence this Global: GLOBAL gDBOPEN AS LONG ' 0 = closed 1 = open '------------------------------------------------------------------------------- ' the thread function can receieve only a single dword so put SQLite calling ' params in a UDT and send its address. ' TYPE sqliteExecParms hDB AS DWORD ' database handle psSQL AS ASCIZ PTR ' pointer to string containing SQL statement pSQLiteResults AS LONG PTR ' pointer to SQLite's results array hD AS DWORD ' dialog handle lCtl AS LONG ' control id for listview control pzerms AS ASCIZ PTR ' pointer to error msg populated by sqlite rows AS LONG ' row count returned by sqlite cols AS LONG ' column count returned by sqlite END TYPE GLOBAL gptable() AS LONG PTR' raw results table pointer to map the query results ' in a way that PB can handle. GLOBAL SEP AS SQLiteExecParms '------------------------------------------------------------------------------------ FUNCTION MakeFont(BYVAL fName AS STRING, BYVAL ptSize AS LONG, _ OPT BYVAL attr AS STRING) AS DWORD '-------------------------------------------------------------------- ' Create a desired font and return its handle. ' attr = "biu" for bold, italic, and underlined (any order) '-------------------------------------------------------------------- LOCAL hDC AS DWORD, CharSet AS LONG, CyPixels AS LONG LOCAL bold, italic, uLine AS LONG IF LEN(attr) THEN IF INSTR(LCASE$(attr), "b") THEN bold = %FW_BOLD IF INSTR(LCASE$(attr), "i") THEN italic = 1 IF INSTR(LCASE$(attr), "u") THEN uLine = 1 END IF hDC = GetDC(%HWND_DESKTOP) CyPixels = GetDeviceCaps(hDC, %LOGPIXELSY) ReleaseDC %HWND_DESKTOP, hDC PtSize = 0 - (ptSize * CyPixels) \ 72 FUNCTION = CreateFont(ptSize, 0, 0, 0, bold, italic, uLine, _ %FALSE, CharSet, %OUT_TT_PRECIS, _ %CLIP_DEFAULT_PRECIS, %DEFAULT_QUALITY, _ %FF_DONTCARE , BYCOPY fName) END FUNCTION '-------------------------------------------------------------- FUNCTION SelDBFile (hD AS DWORD) AS STRING LOCAL buf, spath, sfile AS STRING LOCAL dwstyle AS DWORD LOCAL hFile AS LONG '------------------------ get database file dwStyle = %OFN_EXPLORER OR %OFN_FILEMUSTEXIST OR %OFN_HIDEREADONLY Buf = "Database files (*.SDB)|*.SDB|Database files (*.DB3)|*.DB3|" IF OpenFileDialog (hD, "Locate SDB file ", sfile, spath, buf, "SDB", dwstyle) = 0 THEN EXIT FUNCTION ' returning null END IF FUNCTION = sfile END FUNCTION '------------------------------------------------------------------------------ ' open database SUB Open_Database ( hd AS DWORD ) LOCAL sz AS ASCIZ * 512 LOCAL lresult AS LONG ' can only call sqlite3_close once! IF gDBOPEN = 1 THEN sqlite3_close(ghDB) ' in case one is already open ' choose a DB sz = SelDBFile(hD) IF sqlite3_open( sz, BYREF ghDB) <> %SQLITE_OK THEN ? "unable to open database", %mb_applmodal,"Warning" gDBOPEN = 0 EXIT SUB END IF gDBOPEN = 1 END SUB ' -------------------------------------------------- FUNCTION sqlErrMsg( BYVAL hDB AS LONG ) AS STRING 'Thanks to Don Dickinson DIM pzErr AS ASCIIZ PTR ' get the SQLite error message ' ? sqlErrMsg(hDB) pzErr = sqlite3_errmsg(hDB) IF pzErr = 0 THEN FUNCTION = "" ELSE FUNCTION = @pzErr END IF END FUNCTION '--------------------------------------------------------------------------------- 'FUNCTION q2lv(ghDB AS DWORD, BYVAL hDlg AS DWORD, BYVAL lLVID AS LONG, lERMS AS LONG, sql AS STRING ) AS LONG FUNCTION q2lvthread ( BYVAL dwSEP AS DWORD PTR) AS LONG LOCAL i, j, lresult, n, nmaxrows, nmaxcols AS LONG LOCAL pSEP AS SqliteEXecParms PTR LOCAL p AS DWORD LOCAL pcols, ps AS STRING PTR LOCAL pzfield AS ASCIZ PTR LOCAL hCtl AS DWORD LOCAL tLVC AS LV_COLUMN LOCAL tLVI AS LV_ITEM LOCAL lStyle AS LONG LOCAL pzerms AS ASCIZ PTR pSEP = dwSEP FUNCTION = -1 ' Get ListView Handle CONTROL HANDLE @pSEP.hD, @pSEP.lCtl TO hCtl ' clear down any existing columns DO WHILE ListView_DeleteColumn(hCtl, 0) LOOP Listview_DeleteAllItems(hCtl) ps = @pSEP.psSQL lresult = SQLite3_Get_Table( ghDB, BYVAL @pSEP.psSQL, p, nMaxRows, nMaxCols, BYVAL pzerms ) IF lresult <> 0 THEN ? "SQLite error! :" + sqlErrMsg(@pSEP.hDB) EXIT FUNCTION END IF REDIM gptable ( 0 TO nmaxcols * nmaxrows ) AT p @pSEP.rows = nMaxRows @pSEP.cols = nMaxCols @pSEP.pSQLiteResults = p 'Load column headers. tLVC.mask = %LVCF_FMT OR %LVCF_TEXT OR %LVCF_SUBITEM OR %LVCF_WIDTH tLVC.fmt = %LVCFMT_LEFT 'redim preserve ptable(0 to nmaxcols * nmaxrows) FOR i = 0 TO nmaxcols -1 tLVC.pszText = gptable(i) tLVC.isubitem = i ListView_InsertColumn(hCtl, i , tLVC) NEXT listview_setItemCount ( hCtl, nmaxrows) FOR i = 0 TO nmaxcols - 1 ListView_SetColumnWidth(hCtl, i, %LVSCW_AUTOSIZE_USEHEADER ) NEXT FUNCTION = nmaxrows END FUNCTION '------------------------------------------------------------ ' execute query and show recset in listview ' params: database handle, dialog handle, LV ctl id, Error Msg Ctl id, SQL text ' returns -1 in the event of failure, rowcount if sucessful ' caller passes in a pointer to a SQLiteExecParms structure which is populated ' in order to pass parameters in to threaded function running the query ' and to contain the query results - a pointer to sqlite's results table, ' the row and column counts. ' ' NB the query and populating the LV will not be synchronised with the main thread ' so the main thread can issue a sqlite3_interrupt to abandon the query! ' FUNCTION Q2Lv (ghDB AS DWORD, BYVAL hDlg AS DWORD, BYVAL lLVID AS LONG, lERMS AS LONG, BYVAL psql AS ASCIZ PTR) AS LONG LOCAL lresult AS LONG SEP.hDB = ghdb SEP.psSQL = psql SEP.pSQLiteResults = 0 ' returned by SQLITE and must be freed using sqlite3_free_table() SEP.hd = hDlg SEP.lCtl = %IDC_LV1 SEP.pzerms = 0 ' returned by SQLITE THREAD CREATE q2lvthread(BYVAL VARPTR (SEP)) TO lresult FUNCTION = lresult END FUNCTION '------------------------------------------------------------------------------ FUNCTION QLVCustomDraw ( BYVAL ptlvcd AS NMLVCUSTOMDRAW PTR ) AS LONG LOCAL szItem AS ASCIIZ * %MAX_PATH ' item text LOCAL trcItem AS RECT ' bounding rectangle of item/subitem LOCAL tlv_item AS LV_ITEM ' listview item information LOCAL tlb AS LOGBRUSH ' specifies information used to create background brush LOCAL hWndHdr AS DWORD ' handle of header child control LOCAL hBrush AS DWORD LOCAL hBrushOld AS DWORD LOCAL hPenOld AS DWORD LOCAL dwBackColor AS DWORD LOCAL nBkModeOld AS INTEGER LOCAL hwin AS DWORD LOCAL lresult AS LONG ' Get the item or subitem info tlv_item.mask = %LVIF_TEXT OR %LVIF_IMAGE OR %LVIF_STATE tlv_item.stateMask = %LVIS_FOCUSED OR %LVIS_SELECTED tlv_item.iItem = @ptlvcd.nmcd.dwItemSpec tlv_item.iSubItem = @ptlvcd.iSubItem tlv_item.pszText = VARPTR(szItem) tlv_item.cchTextMax = %MAX_PATH SendMessage @ptlvcd.nmcd.hdr.hwndFrom, %LVM_GETITEM, 0, BYVAL VARPTR(tlv_item) ' Get the bounding rectangle of the subitem(cell) trcItem.nLeft = %LVIR_BOUNDS trcItem.nTop = @ptlvcd.iSubItem lresult = SendMessage( @ptlvcd.nmcd.hdr.hwndFrom, %LVM_GETSUBITEMRECT, @ptlvcd.nmcd.dwItemSpec, BYVAL VARPTR(trcItem)) ' Color the background IF @ptlvcd.nmcd.dwItemSpec MOD 2 = 0 THEN dwBackColor = RGB(255,127,127) ' background ELSE dwBackColor = %WHITE ' white background END IF tlb.lbStyle = %BS_SOLID tlb.lbColor = dwBackColor tlb.lbHatch = 0 hBrush = CreateBrushIndirect(tlb) FillRect @ptlvcd.nmcd.hdc, trcItem, hBrush DeleteObject hBrush ' Draw the text nBkModeOld = SetBkMode(@ptlvcd.nmcd.hdc, %TRANSPARENT) DrawTextEx @ptlvcd.nmcd.hdc, szItem, LEN(szItem), trcItem, %DT_SINGLELINE OR %DT_LEFT OR %DT_VCENTER OR %DT_END_ELLIPSIS, BYVAL %NULL SetBkMode @ptlvcd.nmcd.hdc, nBkModeOld FUNCTION = %CDRF_SKIPDEFAULT END FUNCTION '------------------------------------------------------------------------------- CALLBACK FUNCTION ShowDIALOG1Proc() LOCAL sSQL AS STRING LOCAL lcols, lresult, n AS LONG LOCAL pzerms AS ASCIZ PTR STATIC hwthread AS LONG LOCAL sz AS ASCIZ * 512 LOCAL pnmh AS NMHDR PTR LOCAL pnm AS NMLVCUSTOMDRAW PTR LOCAL p AS POINTAPI LOCAL lpLVDispInfo AS LV_DISPINFO PTR LOCAL lpia AS NMITEMACTIVATE PTR SELECT CASE AS LONG CBMSG CASE %WM_INITDIALOG open_database(CBHNDL) CASE %WM_NOTIFY pnmh = CBLPARAM SELECT CASE @pnmh.code IF LOWRD(CBWPARAM) <> %IDC_lv1 THEN EXIT SELECT lpia=CBLPARAM CASE %NM_CUSTOMDRAW ' Here you can specify font and color. pnm = CBLPARAM SELECT CASE @pnm.nmcd.dwDrawStage CASE %CDDS_PREPAINT ' The following statement ensures that the relevant ' messages are coming back to Windows, so Windows ' can respond appropriately. ' The following statement makes Windows happy: SetWindowLong CBHNDL,%DWL_MSGRESULT,%CDRF_NOTIFYITEMDRAW ' This statement makes the DDT engine happy: FUNCTION = 1: EXIT FUNCTION CASE %CDDS_ITEMPREPAINT SetWindowLong CBHNDL,%DWL_MSGRESULT,%CDRF_NOTIFYSUBITEMDRAW FUNCTION = 1: EXIT FUNCTION CASE %CDDS_SUBITEM OR %CDDS_ITEMPREPAINT FUNCTION = QLVCustomDraw(BYVAL pnm) EXIT FUNCTION END SELECT CASE %LVN_GETDISPINFO 'Virtual ListView ask for Item text lpLVDispInfo = CBLPARAM @lpLVDispInfo.item.pszText = VARPTR(sz) IF (@lpLVDispInfo.item.mask AND %LVIF_TEXT) THEN @lpLVDispInfo.item.pszText = _ gptable(((@lpLVDispInfo.item.iitem + 1)* sep.cols) + @lpLVDispInfo.item.iSubItem) END IF END SELECT CASE %WM_COMMAND SELECT CASE AS LONG CBCTL CASE %IDC_BUTTON1 IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN listview_deleteAllItems(getdlgitem(CBHNDL,%IDC_LV1)) sqlite3_free_table(SEP.pSqliteResults) ' clear last sqlite results if any CONTROL GET TEXT CBHNDL, %IDC_TEXTBOX1 TO sSQL q2lv(ghDB, CBHNDL, %IDC_LV1, 0, BYVAL STRPTR (sSQL)) END IF CASE %IDC_BUTTON2 IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN sqlite3_interrupt(ghdb) THREAD CLOSE hwthread TO lresult listview_deleteAllItems(getdlgitem(CBHNDL,%IDC_LV1)) sqlite3_free_table(SEP.pSqliteResults) END IF END SELECT CASE %WM_DESTROY THREAD CLOSE hwthread TO lresult sqlite3_free_table(SEP.pSqliteResults) listview_deleteAllItems(getdlgitem(CBHNDL,%IDC_LV1)) sqlite3_close(ghDB) END SELECT END FUNCTION '----------------------------------------------------------------------- FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG LOCAL lRslt AS LONG LOCAL hDlg AS DWORD DIALOG NEW hParent, "SQLITE3 example - interruptable query using threads", 175, 118, 305, 252, %WS_POPUP OR %WS_BORDER OR _ %WS_DLGFRAME OR %WS_SYSMENU OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE OR _ %DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg CONTROL ADD BUTTON, hDlg, %IDC_BUTTON1, "Start Query", 5, 230, 65, 15 CONTROL ADD BUTTON, hDlg, %IDC_BUTTON2, "Stop Query", 80, 230, 65, 15 CONTROL ADD TEXTBOX, hDlg, %IDC_TEXTBOX1, "Enter query here", 5, 5, 295, 60, %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR _ %ES_LEFT OR %ES_MULTILINE OR %ES_AUTOHSCROLL OR %ES_WANTRETURN, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR _ %WS_EX_RIGHTSCROLLBAR CONTROL ADD "SysListView32", hDlg, %IDC_LV1, "SysListView32_1", 5, 70, 295, 155, _ %DEFAULT_LV_STYLES OR %LVS_OWNERDATA, %DEFAULT_LV_EX_STYLES 'OR %LVS_OWNERDATA DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt FUNCTION = lRslt END FUNCTION '============================================================================ FUNCTION PBMAIN() InitCommonControls ShowDIALOG1 %HWND_DESKTOP END FUNCTION