SQLitening Support Forum

SQLitening Support => You've got Questions? We've got Answers! => Topic started by: mikedoty on October 16, 2008, 08:17:19 PM

Title: Listview demo updated to display EXPLAIN and PRAGMA recordsets
Post by: mikedoty on October 16, 2008, 08:17:19 PM
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.



#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