Listview demo updated to display EXPLAIN and PRAGMA recordsets

[mikedoty]

It has some touches like not allowing program to terminate connection while still working.
Pragma and Explain now supported.  Lower case statements weren't working.
Requires PB9 to compile LISTVIEW.

Code Select Expand


#PBFORMS CREATED V1.51

#COMPILE EXE       'Mike Doty 10/16/08  use at your own risk   SQLitening with ListView
#DIM ALL           'Modified  10/17/08  to return PRAGMA and EXPLAIN using slSel
                   'UCASE of SQL statement was missing so select didn't equal SELECT
#PBFORMS BEGIN INCLUDES
%USEMACROS = 1
#IF NOT %DEF(%WINAPI)
    #INCLUDE "WIN32API.INC"
#ENDIF
#IF NOT %DEF(%COMMCTRL_INC)
    #INCLUDE "COMMCTRL.INC"
#ENDIF
#INCLUDE "PBForms.INC"
#PBFORMS END INCLUDES

#INCLUDE "sqlitening.inc"

#PBFORMS BEGIN CONSTANTS
%IDD_DIALOG1      =  101
%LBL_LABEL1       = 1001
%LISTVIEW         = 2001
%TXT_IP           = 3001
%TXT_Database     = 3002
%TXT_EXECUTE      = 3003
%BTN_CONNECT      = 4005
%BTN_OPENDATABASE = 4006
%BTN_EXECUTE      = 4007
%BTN_DISCONNECT   = 4008
%Test             = 4010
%IDC_FRAME1       = 4011
%IDC_FRAME2       = 4012
#PBFORMS END CONSTANTS

GLOBAL gConnected      AS LONG
GLOBAL gWorking        AS LONG
GLOBAL gRequestCounter AS DWORD

DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG

#PBFORMS DECLARATIONS
'------------------------------------------------------------------------------
DECLARE SUB Message(hDlg AS DWORD, sText AS STRING)
DECLARE FUNCTION DisplayRecordSet(hDlg AS DWORD) AS DWORD 'returns number of rows

FUNCTION PBMAIN()
    PBFormsInitComCtls (%ICC_WIN95_CLASSES OR %ICC_DATE_CLASSES OR %ICC_INTERNET_CLASSES)

    slSetProcessMods "E0"
    ShowDIALOG1 %HWND_DESKTOP
END FUNCTION

CALLBACK FUNCTION ShowDIALOG1Proc()
  LOCAL s      AS STRING
  LOCAL result AS LONG
  LOCAL rows   AS LONG

    SELECT CASE AS LONG CBMSG
        CASE %WM_INITDIALOG
            ' Initialization handler
            CONTROL DISABLE CBHNDL, %BTN_OPENDATABASE
            CONTROL DISABLE CBHNDL, %BTN_EXECUTE
            CONTROL DISABLE CBHNDL, %BTN_DISCONNECT
            CONTROL DISABLE CBHNDL, %TXT_DATABASE

        CASE %WM_NCACTIVATE
            STATIC hWndSaveFocus AS DWORD
            IF ISFALSE CBWPARAM THEN
                ' Save control focus
                hWndSaveFocus = GetFocus()
            ELSEIF hWndSaveFocus THEN
                ' Restore control focus
                SetFocus(hWndSaveFocus)
                hWndSaveFocus = 0
            END IF

        CASE %WM_SYSCOMMAND
          IF (CBWPARAM AND &HFFF0) = %SC_CLOSE THEN
             PostMessage CBHNDL, %WM_USER + 2048, 0, 0
            FUNCTION = 1
           END IF

        CASE %WM_USER + 2048   'User clicked close, ALT/F4
            IF gWorking  = 0 THEN
              'done working so go ahead and end
              DIALOG END CBHNDL
            ELSE
              Message CBHNDL, "Still busy"
              BEEP
            END IF


        CASE %WM_QUERYENDSESSION

              IF gWorking THEN
                PostQuitMessage 0   'not ready to end
                FUNCTION = 1
              END IF

        CASE %WM_COMMAND
            ' Process control notifications
            SELECT CASE AS LONG CBCTL
             
                CASE %TEST
                    IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                        TEST CBHNDL
                    END IF

                CASE %BTN_CONNECT
                  IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                      MOUSEPTR 11
                      gWorking = 1
                      CONTROL DISABLE CBHNDL, %BTN_CONNECT
                      CONTROL GET TEXT CBHNDL, %TXT_IP TO s
                      result = 0
                      IF LEN(s) THEN
                        result = slConnect(s,0, "E0")
                      END IF
                      IF result = 0 THEN
                        IF LEN(s) THEN
                         s = "Connected to " + s
                        ELSE
                          s = "Connected local"
                        END IF
                        gConnected = 1
                        CONTROL DISABLE CBHNDL, %BTN_CONNECT
                        CONTROL DISABLE CBHNDL, %TXT_IP
                        CONTROL ENABLE  CBHNDL, %BTN_OPENDATABASE
                        CONTROL ENABLE  CBHNDL, %TXT_DATABASE
                        CONTROL ENABLE  CBHNDL, %BTN_DISCONNECT
                      ELSE
                         s = "Connection failed, error" + STR$(result)
                         CONTROL ENABLE CBHNDL, %BTN_CONNECT
                      END IF
                      Message CBHNDL, s
                      MOUSEPTR 1
                      gWorking = 0
                    END IF

                CASE %BTN_OPENDATABASE
                    IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                      IF gConnected = 0 THEN
                        Message CBHNDL, "Not connected"
                        EXIT FUNCTION
                      END IF
                      CONTROL GET TEXT CBHNDL, %TXT_DataBase TO s
                      's = "sample.db3"   'good example to use
                      result = slOpen(s, "C")
                      IF result = 0 THEN
                        s =  "Opened " + s
                        CONTROL DISABLE CBHNDL, %BTN_OPENDATABASE
                        CONTROL DISABLE CBHNDL, %TXT_DATABASE
                        CONTROL ENABLE  CBHNDL, %BTN_EXECUTE
                        CONTROL ENABLE  CBHNDL, %BTN_DISCONNECT
                      ELSE
                        s = slGetError
                      END IF
                      Message CBHNDL, s

                    END IF

                CASE %BTN_EXECUTE
                    IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                      CONTROL DISABLE CBHNDL, %BTN_EXECUTE
                      CONTROL DISABLE CBHNDL, %BTN_DISCONNECT
                      IF gConnected = 0 THEN   'not connected
                        Message CBHNDL, "Not connected"
                      ELSEIF gWorking THEN     'already working
                        BEEP
                      ELSE
                        MOUSEPTR 11
                        gWorking = 1   'processing request
                        INCR gRequestCounter
                        CONTROL GET TEXT CBHNDL, %TXT_EXECUTE TO s
                        s = UCASE$(LTRIM$(RTRIM$(s)))
                        'modified 10/17/2008  1:26 AM CST
                        IF LEFT$(s$,7) = "SELECT " OR LEFT$(s$, 8) = "EXPLAIN " OR LEFT$(s$,7) = "PRAGMA " THEN
                          result = slSel(s,0,"E0")      'only 1 recordset is supported (may do multiples later)
                        ELSE
                          result = slEXE(s,"E0")
                        END IF
                        Message CBHNDL, slGetError
                        IF RESULT = 0 THEN
                          Message CBHNDL, "Request" + STR$(gRequestCounter) + " data received, filling display."
                          rows = DisplayRecordSet(CBHNDL)
                          Message CBHNDL, "Rows" + STR$(rows)
                        END IF

                        CONTROL ENABLE CBHNDL, %BTN_EXECUTE  'enable ourself
                        CONTROL ENABLE CBHNDL, %BTN_DISCONNECT
                        gWorking = 0
                        MOUSEPTR 1
                      END IF

                    END IF

                CASE %BTN_DISCONNECT
                    IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN

                       IF gWorking THEN
                          BEEP
                       ELSEIF gConnected = 0 THEN
                          Message CBHNDL, "Already disconnected"
                       ELSE
                          slDisconnect
                          gConnected = 0
                          Message CBHNDL, "Disconnected"
                          CONTROL DISABLE CBHNDL, %BTN_DISCONNECT
                          CONTROL DISABLE CBHNDL, %BTN_OPENDATABASE
                          CONTROL DISABLE CBHNDL, %BTN_EXECUTE
                          CONTROL ENABLE  CBHNDL, %BTN_CONNECT
                          CONTROL ENABLE  CBHNDL, %TXT_IP
                       END IF
                    END IF
      FUNCTION = 1

            END SELECT
    END SELECT
END FUNCTION

'------------------------------------------------------------------------------
'   ** Dialogs **
'------------------------------------------------------------------------------
FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
    LOCAL lRslt AS LONG

#PBFORMS BEGIN DIALOG %IDD_DIALOG1->->
    LOCAL hDlg   AS DWORD
    LOCAL hFont1 AS DWORD

    DIALOG NEW hParent, "SQLitening (defaults to using sample.db3)", 97, 77, _
        510, 385, %WS_POPUP OR %WS_BORDER OR %WS_DLGFRAME OR %WS_THICKFRAME _
        OR %WS_SYSMENU OR %WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX OR _
        %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_CENTER 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 LABEL,   hDlg, %LBL_LABEL1, "", 0, 0, 510, 12
    CONTROL SET COLOR    hDlg, %LBL_LABEL1, %BLACK, %WHITE
    CONTROL ADD "SysListView32", hDlg, %LISTVIEW, "SysListView32_1", 0, 15, _
        510, 247, %WS_CHILD OR %WS_VISIBLE OR %LVS_REPORT OR _
        %LVS_NOSORTHEADER, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT OR _
        %WS_EX_RIGHTSCROLLBAR
    CONTROL ADD TEXTBOX, hDlg, %TXT_IP, "", 53, 358, 83, 14
    CONTROL ADD TEXTBOX, hDlg, %TXT_Database, "sample.db3", 220, 358, 96, 14
    CONTROL ADD TEXTBOX, hDlg, %TXT_EXECUTE, "SELECT ROWID,* FROM PARTS ", 0, _
        264, 510, 62, %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %ES_LEFT OR _
        %ES_MULTILINE OR %ES_AUTOHSCROLL OR %ES_WANTRETURN, %WS_EX_LEFT OR _
        %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
    CONTROL ADD BUTTON,  hDlg, %BTN_CONNECT, "Connect", 8, 358, 40, 14
    CONTROL ADD BUTTON,  hDlg, %BTN_OPENDATABASE, "Open", 178, 358, 40, 14
    CONTROL ADD BUTTON,  hDlg, %BTN_EXECUTE, "Execute", 2, 330, 50, 14
    CONTROL ADD BUTTON,  hDlg, %BTN_DISCONNECT, "Disconnect", 360, 365, 49, _
        13
    CONTROL ADD BUTTON,  hDlg, %Test, "Test", 460, 365, 40, 13
    CONTROL ADD FRAME,   hDlg, %IDC_FRAME1, " Database ", 173, 345, 149, 33, _
        %WS_CHILD OR %WS_VISIBLE OR %BS_CENTER OR %BS_TOP OR %BS_GROUPBOX, _
        %WS_EX_LEFT OR %WS_EX_LTRREADING
    CONTROL ADD FRAME,   hDlg, %IDC_FRAME2, "------------------------  " + _
        "Connect to server ?????????", 3, 345, 140, 33

    hFont1 = PBFormsMakeFont("Arial", 10, 700, %FALSE, %FALSE, %FALSE, _
        %ANSI_CHARSET)

    CONTROL SEND hDlg, %LBL_LABEL1, %WM_SETFONT, hFont1, 0
#PBFORMS END DIALOG


    DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt

#PBFORMS BEGIN CLEANUP %IDD_DIALOG1
    DeleteObject hFont1
#PBFORMS END CLEANUP

    FUNCTION = lRslt
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION DisplayRecordSet(hDlg AS DWORD) AS DWORD
  LOCAL row AS DWORD, col AS LONG, ColumnCount AS LONG
  LOCAL x AS LONG

'-----------------------------------------------------------------------------------
  'be sure to duplicate this when done (orignal may change)
  CONTROL DISABLE hDlg, %LISTVIEW
  CONTROL KILL hDlg, %LISTVIEW
  CONTROL ADD "SysListView32", hDlg, %LISTVIEW, "SysListView32_1", 0, 15, _
        510, 247, %WS_CHILD OR %WS_VISIBLE OR %LVS_REPORT OR _
        %LVS_NOSORTHEADER, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT OR _
        %WS_EX_RIGHTSCROLLBAR
'------------------------------------------------------------------------------------

  ColumnCount = slGetColumnCount
  IF ColumnCount THEN
    MOUSEPTR 11
    LISTVIEW SET STYLE hDlg, %LISTVIEW, %LVS_EX_GRIDLINES OR %LVS_EX_FULLROWSELECT

    FOR col = 1 TO ColumnCount   'Insert columns with column names
      LISTVIEW INSERT COLUMN hDlg, %LISTVIEW,col,slGetColumnName(col),50,0
    NEXT
  ELSE
    ? "No columns"
    EXIT FUNCTION
  END IF

  DO WHILE slGetRow
    INCR row
    LISTVIEW INSERT ITEM hDlg, %LISTVIEW,row, 0 , slF(1) 'Insert row, 0=no image
    FOR col = 2 TO ColumnCount                               'add text into columns
      LISTVIEW SET TEXT hDlg, %LISTVIEW, row, col,slF(col)
    NEXT

    IF row =30 THEN
      CONTROL REDRAW hDlg, %LISTVIEW
    ELSEIF ROW MOD 1000 = 0  THEN          'refresh screen every so often
      Message hDlg, "Reading row" + STR$(row)
      DOEVENTS4
    END IF
  LOOP

  DOEVENTS4 'about to comsume some time, let others in for a second
  CONTROL SHOW STATE hdlg, %LISTVIEW, %SW_HIDE  'reduce flicker at end
  FOR col = 1 TO ColumnCount   'fit columns
    LISTVIEW FIT CONTENT hDlg, %LISTVIEW, col
    LISTVIEW FIT HEADER  hDlg, %LISTVIEW, col   'already done at startup
    'LISTVIEW SET COLUMN hDlg, %LISTVIEW, col&, -2  'fixed in beta, a little faster
  NEXT
  CONTROL SHOW STATE hDlg, %LISTVIEW, %SW_SHOW  'reduce flicker at end
  DOEVENTS4  'done, give others max timelet others in again
  'Message hDlg, "Rows" + STR$(row)
  MOUSEPTR 1
  FUNCTION = row
  'WHILE PeekMessage($NUL, hDlg, %WM_MOUSEFIRST, %WM_MOUSELAST, %PM_REMOVE):  WEND   'clear message queue
END FUNCTION

SUB Message(hDlg AS DWORD, s AS STRING)
  CONTROL SET TEXT hDlg, %LBL_LABEL1, s
END SUB

SUB DoEvents4
  LOCAL x AS LONG
  FOR x = 1 TO 4
    DIALOG DOEVENTS
  NEXT
END SUB

SUB TEST(hDlg AS DWORD)
  LOCAL NumberOfColumns AS LONG
  LOCAL Result AS LONG
  LOCAL s      AS STRING
  s  = "PRAGMA database_list"
  s  = "PRAGMA table_info(parts)"
  result = slSel(s,0,"E0")
  DisplayRecordSet hDlg
END SUB