Testing if Fredrick gets email alerts.
https://sqlitening.planetsquires.com/index.php?topic=9778.msg26718;topicseen#msg26718
https://sqlitening.planetsquires.com/index.php?topic=9778.msg26718;topicseen#msg26718
Welcome to the SQLitening support forums!
This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.
Show posts Menu#INCLUDE "sqlitening.inc"
GLOBAL gs AS STRING
FUNCTION PBMAIN AS LONG
slOpen "junk.db3"
slexe "drop table if exists parts"
slexe "create table if not exists parts(price integer)"
slexe "insert into parts values(1995),(1300),(4995),(101),(703)"
'if AS is used with same name as column with printf the order by will be alpha
rs "select printf('%.2f',price*.01) AS price from parts order by price"
'these order numerically
rs "select printf('%.2f',price*.01) from parts order by price" 'no AS
rs "select printf('%.2f',price*.01) AS price from parts order by parts.price" 'use table.column
rs "select printf('%.2f',price*.01) AS XYZ from parts order by price" 'AS different
? gs
END FUNCTION
FUNCTION rs(sql AS STRING) AS STRING
LOCAL sArray() AS STRING
IF ISFALSE(slSelAry(sql,sArray(),"Q9 E2")) THEN
gs+= JOIN$(sArray(),$CR) + $CR + $CR
ELSE
gs = "error:" + $CR + sql + $CR + $CR
END IF
END FUNCTION
#PBFORMS CREATED V2.01
#COMPILE EXE 'Save as "Modeless.bas" PBFORMS with Jose Roca includes
#DIM ALL
%UNICODE = 1
#INCLUDE ONCE "Windows.inc"
#INCLUDE ONCE "sqlitening.inc"
'------------------------------------------------------------------------------
#PBFORMS BEGIN INCLUDES
#RESOURCE "modeless.pbr"
#PBFORMS END INCLUDES
GLOBAL ghDlg AS DWORD
'------------------------------------------------------------------------------
#PBFORMS BEGIN CONSTANTS
%IDD_DIALOG1 = 101
%LABEL1 = 1001
%TEXTBOX1 = 2001
%BTN_BUTTON1 = 3001
%TEXTBOX2 = 3002
#PBFORMS END CONSTANTS
#PBFORMS DECLARATIONS
FUNCTION PBMAIN()
ShowDIALOG1 %HWND_DESKTOP
END FUNCTION
'------------------------------------------------------------------------------
CALLBACK FUNCTION ShowDIALOG1Proc()
SELECT CASE AS LONG CB.MSG
CASE %WM_INITDIALOG
ghDlg = CB.HNDL
CASE %WM_NCACTIVATE
STATIC hWndSaveFocus AS DWORD
IF ISFALSE CB.WPARAM THEN
' Save control focus
hWndSaveFocus = GetFocus()
ELSEIF hWndSaveFocus THEN
' Restore control focus
SetFocus(hWndSaveFocus)
hWndSaveFocus = 0
END IF
CASE %WM_COMMAND
' Process control notifications
SELECT CASE AS LONG CB.CTL
CASE %BTN_BUTTON1
IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
LOCAL hThread AS LONG
THREAD CREATE SQLitening(0) TO hThread
THREAD CLOSE hThread TO hThread
END IF
END SELECT
CASE %WM_DESTROY
PostQuitMessage 0 'required with modeless Jose Roca message pump
EXIT FUNCTION
END SELECT
END FUNCTION
'------------------------------------------------------------------------------
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
LOCAL hFont2 AS DWORD
DIALOG NEW hParent, "", 72, 138, 919, 380, %WS_POPUP OR %WS_BORDER OR _
%WS_DLGFRAME OR %WS_THICKFRAME OR %WS_CAPTION OR %WS_SYSMENU OR _
%WS_MINIMIZEBOX OR %WS_MAXIMIZEBOX 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 BUTTON, hDlg, %BTN_BUTTON1, "Execute", 5, 360, 50, 15
CONTROL ADD TEXTBOX, hDlg, %TEXTBOX1, "", 5, 25, 910, 265, %WS_CHILD OR _
%WS_VISIBLE OR %WS_HSCROLL OR %WS_VSCROLL OR %ES_LEFT OR %ES_MULTILINE _
OR %ES_AUTOHSCROLL OR %ES_AUTOVSCROLL, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT _
OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
CONTROL ADD LABEL, hDlg, %LABEL1, "Modeless DDT with Jose Roca includes", _
387, 5, 230, 20, %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, %WS_EX_LEFT OR _
%WS_EX_LTRREADING
CONTROL ADD TEXTBOX, hDlg, %TEXTBOX2, "select rowid,* from parts", 5, 300, _
725, 55, %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %WS_HSCROLL OR _
%WS_VSCROLL OR %ES_LEFT OR %ES_MULTILINE OR %ES_AUTOHSCROLL OR _
%ES_AUTOVSCROLL OR %ES_WANTRETURN, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT OR _
%WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
FONT NEW "MS Sans Serif", 10, 1, %ANSI_CHARSET TO hFont1
FONT NEW "Courier New", 12, 0, %ANSI_CHARSET TO hFont2
CONTROL SET FONT hDlg, %LABEL1, hFont1
CONTROL SET FONT hDlg, %TEXTBOX2, hFont2
#PBFORMS END DIALOG
DIALOG SHOW MODELESS hDlg, CALL ShowDIALOG1Proc TO lRslt
LOCAL uMsg AS tagMsg
WHILE GetMessage(uMsg, %NULL, 0, 0)
IF IsDialogMessage(hDlg, uMsg) = 0 THEN
TranslateMessage uMsg
DispatchMessage uMsg
END IF
WEND '---------- End Jose Roca message pump
#PBFORMS BEGIN CLEANUP %IDD_DIALOG1
FONT END hFont1
FONT END hFont2
#PBFORMS END CLEANUP
FUNCTION = lRslt
END FUNCTION
THREAD FUNCTION sqlitening(BYVAL x AS LONG) AS LONG
LOCAL s,sql,sdata2,sdata3,sArray() AS STRING
CONTROL SET TEXT ghDlg,%TEXTBOX1,s
slOpen "sample.db3","C"
CONTROL GET TEXT ghDlg,%TEXTBOX2 TO sql
IF sql = "select rowid,* from parts" THEN
sql = "select rowid as ROW,MANUF,REDREF,PRODUCT,LANGUAGE,CPU_OS,MEDIA,TYPE,PGROUP,printf('%.2f',price*.01) AS PRICE from parts"
END IF
slSelAry sql,sArray(),"Q9 E2 "
REDIM lTabStop(1 TO 9) AS LONG
lTabStop(1) = 22 'manuf
lTabStop(2) = 160 'redref
lTabStop(3) = 200 'product
lTabStop(4) = 440 'language
lTabStop(5) = 500 'cpu_os
lTabStop(6) = 540 'media
lTabstop(7) = 590 'type
lTabstop(8) = 640 'pgroup
lTabstop(9) = 820 'price
CONTROL SEND ghDlg,%TEXTBOX1,%EM_SETTABSTOPS,UBOUND(lTabStop), VARPTR(lTabStop(1))
s = JOIN$(sArray(),$CRLF)
LockWindow
CONTROL SET TEXT ghDlg,%TEXTBOX1,s 'fill textbox
REM CONTROL SEND ghDlg,%TEXTBOX1,%WM_VSCROLL,%SB_BOTTOM,0 'scroll to bottom of textbox
UnlockWindow
END FUNCTION
'_______________________________________________________________________________________________
FUNCTION rs(sql AS STRING) AS STRING
LOCAL sArray() AS STRING
IF slSelAry(sql,sArray(),"Q9 E2 c") THEN
? sql + $CR + slGetError,%MB_SYSTEMMODAL OR %MB_ICONERROR,"Recordset"
ELSE
FUNCTION=JOIN$(sArray(),$CR)
END IF
END FUNCTION
'_______________________________________________________________________________________________
FUNCTION LockWindow AS LONG
CONTROL SEND ghDlg, %TEXTBOX1,%WM_SETREDRAW,0,0
END FUNCTION
FUNCTION UnlockWindow AS LONG
CONTROL SEND ghDlg,%TEXTBOX1,%WM_SETREDRAW,1,0
END FUNCTION
FUNCTION slOpen ALIAS "slOpen ...
IF thDab THEN EXIT FUNCTION '<--- add line in SQLitening.Bas and compile
Rather than test every program ever written, make above 1-line change to SQLitening.Bas
This is not an error in SQLitening, but a programming error not checking if database was open.
Calling slOpen will now just return if database is open and not create new handle and leak previous handle.
#INCLUDE "sqlitening.inc" 'test new sqlitening.dll with 3 open methods
SUB Test(sdatabase AS STRING)
LOCAL h AS LONG
slOpen sdatabase
h = slgethandle
slOpen sdatabase
IF h <> slGetHandle THEN ? "Memory leak"
END SUB
FUNCTION PBMAIN () AS LONG
Test "temp.tmp" 'test database file
Test ":memory:" 'test in-memory database
Test "" 'test temp database
? "Done"
END FUNCTION
Quote from: undefinedslGetHandle ([rsModChars String, rlSetNumber Long]) Dword
Returns the requested handle. ModChars will determine which handle is returned. The database handle may be used to call SQLite directly or can be passed to a different thread to be used in slOpen. The set handle may only be used to call SQLite directly and then only if in local mode. A %SQLitening_InvalidStringOrRequest error will occur if you try to get a set handle in remote mode.
ModChars:
· D = Return the open database handle. This is the default.
· S = Return the open set handle for set number passed in SetNumber.
Returns zero if an error occurs and the global return errors flag is on.
GLOBAL gs AS STRING
#INCLUDE "sqlitening.inc"
FUNCTION PBMAIN () AS LONG
slSetProcessMods "E2"
LOCAL x AS LONG
Logit "Open database only if not open"
FOR x = 1 TO 5
IF ISFALSE(slIsOpen) THEN slopen "junk.tmp","C": Logit USING$("handle #",slGetHandle)
NEXT
slClose
KILL "junk.tmp"
Logit ERROR$(ERR) + " killing junk.tmp"
[b]'Now show how to incorrectly use slOpen[/b]
Logit ""
Logit "Open database without testing if already open"
FOR x = 1 TO 5
slopen "junk.tmp","C"
Logit USING$("handle #",slGetHandle)
NEXT
slClose
KILL "junk.tmp"
LOGIT ERROR$(ERR) + " killing junk.tmp"
? gs
END FUNCTION
SUB LogIt(s AS STRING)
gs = gs + s + $CR
END SUB