As usual, use it if you like it, don't bother me if you don't. Not as well commented as I would like but it's free. And I get very tired these days. Play with it, update it, fix it, whatever you like. Read the top of the code for dependancies and change library path in datasection.
Code: Select all
;==============================================================================================================================
; Please note that all the SQLite direct database code I found in the PureBasic forum, done by El_Chonie, not by me.
;
; *NOTE* There is no syntax checking on database statements, I simply don't have that sort of time on my hands, nor the
; experience needed. This should be enough for most people.
;
; If you like it, say thanks to El_Choni and (me too maybe???). If you don't like it, I don't want to know. Fang.
;
; DEPENDANCIES
;
; Purevision gadgets library. I will fix this in a future version.
; SQLite v3.x DLL I'm using the UPX'ed version. Check this code.
; PBOSL LoadDLLFromMemory. Very useful stuff
;
;==============================================================================================================================
; Any procedural declarations for out-of-order procedure processing
;==============================================================================================================================
Declare.s AddDateSuffix(Date.s) ; Add the abbreviated date suffix
Declare GetDayOfWeek(Gadget.l) ; Get the day of the week in name form
Declare AddToDisplay(Gadget.l, Text.s, IconItem.l) ; Add icons to addrecord and editrecord forms
Declare CountRecords() ; Return the number of records in a database
Declare Display() ; Shorten the amount of typing we have to do in a ListIconGadget
Declare FlushEvents() ; Prevent forms from greying out
Declare LastLine(Gadget.l) ; Always go to the last line of a list object
Declare SetDate(Windowid.l) ; Set the current date in the title bar
Declare SetStat(Field.l, Message.s) ; Shortcut to setting text on the status bar
Declare GetAllChildHandles(Winhandle) ; Get the status bar handle
Declare.s RepQuote(Instring.s) ; Properly replace single quotes with double for SQL passing
Declare.s KillQuote(Instring.s) ; Kill double quotes in strings for display purposes
;==============================================================================================================================
; El_Choni's sqlite 3 code
;==============================================================================================================================
Declare.l SQL3GetTable(sSQLQuery.s, *Rows, *Cols, lDataBaseHandle.l) ; Return data from an SQLite table to a linked list
;============================================================================================================================
; Visual designer created
;============================================================================================================================
Global BubbleTipStyle.l
;============================================================================================================================
; Visual designer created
;============================================================================================================================
BubbleTipStyle = 0
;============================================================================================================================
; Visual designer created
;============================================================================================================================
Enumeration 1
#Window_mysqlitetest
EndEnumeration
#WindowIndex = #PB_Compiler_EnumerationValue
Enumeration 1
#Gadget_mysqlitetest_fmain
#Gadget_mysqlitetest_datalist
#Gadget_mysqlitetest_fquery
#Gadget_mysqlitetest_lquery
#Gadget_mysqlitetest_query
#Gadget_mysqlitetest_cbquery
#Gadget_mysqlitetest_fcontrol
#Gadget_mysqlitetest_bgetdatabase
#Gadget_mysqlitetest_ltables
#Gadget_mysqlitetest_tables
#Gadget_mysqlitetest_lcolumns
#Gadget_mysqlitetest_columns
#Gadget_mysqlitetest_bload
#Gadget_mysqlitetest_bsave
#Gadget_mysqlitetest_fother
#Gadget_mysqlitetest_helpbutton
#Gadget_mysqlitetest_exitbutton
EndEnumeration
#GadgetIndex = #PB_Compiler_EnumerationValue
Enumeration 1
#StatusBar_mysqlitetest
#StatusBar_mysqlitetest_messages = 0
EndEnumeration
#StatusBarIndex = #PB_Compiler_EnumerationValue
;============================================================================================================================
; Visual designer created
;============================================================================================================================
Procedure.l Window_mysqlitetest()
If OpenWindow(#Window_mysqlitetest,48,74,800,575,#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_ScreenCentered|#PB_Window_Invisible,"SQLite - ")
Brush.LOGBRUSH\lbColor=16625764
SetClassLong_(WindowID(#Window_mysqlitetest),#GCL_HBRBACKGROUND,CreateBrushIndirect_(Brush))
If CreateGadgetList(WindowID(#Window_mysqlitetest))
Frame3DGadget(#Gadget_mysqlitetest_fmain,0,0,640,510,"")
ListIconGadget(#Gadget_mysqlitetest_datalist,5,10,630,495,"itemslist",1000,#PB_ListIcon_GridLines|#PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection)
SendMessage_(GadgetID(#Gadget_mysqlitetest_datalist),#LVM_SETBKCOLOR,0,16625764)
SendMessage_(GadgetID(#Gadget_mysqlitetest_datalist),#LVM_SETTEXTBKCOLOR,0,16625764)
PVGadgets_BubbleTip(#Window_mysqlitetest,#Gadget_mysqlitetest_datalist,"All items returned from a properly formatted SQL query will end up in this list and be cleared in the next call",BubbleTipStyle)
Frame3DGadget(#Gadget_mysqlitetest_fquery,0,510,640,45,"")
TextGadget(#Gadget_mysqlitetest_lquery,10,530,60,15,"Query ",#PB_Text_Right)
PVDynamic_AddColorGadget(#Gadget_mysqlitetest_lquery,0,16625764)
StringGadget(#Gadget_mysqlitetest_query,70,525,470,20,"")
PVDynamic_AddColorGadget(#Gadget_mysqlitetest_query,0,16625764)
PVGadgets_BubbleTip(#Window_mysqlitetest,#Gadget_mysqlitetest_query,"Type in a properly formatted SQL query in here and press ENTER/RETURN to execute it",BubbleTipStyle)
CheckBoxGadget(#Gadget_mysqlitetest_cbquery,550,530,80,15,"Clear list")
PVDynamic_AddColorGadget(#Gadget_mysqlitetest_cbquery,0,16625764)
PVGadgets_BubbleTip(#Window_mysqlitetest,#Gadget_mysqlitetest_cbquery,"Select this button to clear the list before the next SQL query",BubbleTipStyle)
Frame3DGadget(#Gadget_mysqlitetest_fcontrol,645,0,155,510,"")
ButtonGadget(#Gadget_mysqlitetest_bgetdatabase,655,15,135,20,"Open Database")
PVGadgets_BubbleTip(#Window_mysqlitetest,#Gadget_mysqlitetest_bgetdatabase,"press this button to dump the results of the query to a disk file",BubbleTipStyle)
TextGadget(#Gadget_mysqlitetest_ltables,655,45,135,15,"Table names in database",#PB_Text_Center)
PVDynamic_AddColorGadget(#Gadget_mysqlitetest_ltables,0,16625764)
ListViewGadget(#Gadget_mysqlitetest_tables,655,60,135,280)
PVDynamic_AddColorGadget(#Gadget_mysqlitetest_tables,0,16625764)
TextGadget(#Gadget_mysqlitetest_lcolumns,655,345,135,15,"Columns names in table",#PB_Text_Center)
PVDynamic_AddColorGadget(#Gadget_mysqlitetest_lcolumns,0,16625764)
ListViewGadget(#Gadget_mysqlitetest_columns,655,360,135,95)
PVDynamic_AddColorGadget(#Gadget_mysqlitetest_columns,0,16625764)
ButtonGadget(#Gadget_mysqlitetest_bload,655,460,135,20,"Load saved sql dump")
PVGadgets_BubbleTip(#Window_mysqlitetest,#Gadget_mysqlitetest_bload,"press this button to dump the results of the query to a disk file",BubbleTipStyle)
ButtonGadget(#Gadget_mysqlitetest_bsave,655,480,135,20,"Save sql dump to disk")
PVGadgets_BubbleTip(#Window_mysqlitetest,#Gadget_mysqlitetest_bsave,"press this button to dump the results of the query to a disk file",BubbleTipStyle)
Frame3DGadget(#Gadget_mysqlitetest_fother,645,510,155,45,"")
ButtonGadget(#Gadget_mysqlitetest_helpbutton,655,525,60,20,"Help")
PVGadgets_BubbleTip(#Window_mysqlitetest,#Gadget_mysqlitetest_helpbutton,"press this button to show any help file linked to this program",BubbleTipStyle)
ButtonGadget(#Gadget_mysqlitetest_exitbutton,730,525,60,20,"Exit")
PVGadgets_BubbleTip(#Window_mysqlitetest,#Gadget_mysqlitetest_exitbutton,"press this button to exit this program immediately",BubbleTipStyle)
PVDynamic_AddStatusBar(#Window_mysqlitetest,#StatusBar_mysqlitetest,CreateStatusBar(#StatusBar_mysqlitetest,WindowID(#Window_mysqlitetest)),1)
AddStatusBarField(800)
PVDynamic_AddLockWindow(#Window_mysqlitetest,#StatusBar_mysqlitetest,1,3)
PVDynamic_AddGadget(#Window_mysqlitetest,#Gadget_mysqlitetest_fmain,3)
PVDynamic_AddGadget(#Window_mysqlitetest,#Gadget_mysqlitetest_datalist,3)
PVDynamic_AddGadget(#Window_mysqlitetest,#Gadget_mysqlitetest_fquery,6)
PVDynamic_AddGadget(#Window_mysqlitetest,#Gadget_mysqlitetest_lquery,4)
PVDynamic_AddGadget(#Window_mysqlitetest,#Gadget_mysqlitetest_query,6)
PVDynamic_AddGadget(#Window_mysqlitetest,#Gadget_mysqlitetest_cbquery,12)
PVDynamic_AddGadget(#Window_mysqlitetest,#Gadget_mysqlitetest_fcontrol,9)
PVDynamic_AddGadget(#Window_mysqlitetest,#Gadget_mysqlitetest_bgetdatabase,8)
PVDynamic_AddGadget(#Window_mysqlitetest,#Gadget_mysqlitetest_ltables,8)
PVDynamic_AddGadget(#Window_mysqlitetest,#Gadget_mysqlitetest_tables,9)
PVDynamic_AddGadget(#Window_mysqlitetest,#Gadget_mysqlitetest_lcolumns,12)
PVDynamic_AddGadget(#Window_mysqlitetest,#Gadget_mysqlitetest_columns,12)
PVDynamic_AddGadget(#Window_mysqlitetest,#Gadget_mysqlitetest_bload,12)
PVDynamic_AddGadget(#Window_mysqlitetest,#Gadget_mysqlitetest_bsave,12)
PVDynamic_AddGadget(#Window_mysqlitetest,#Gadget_mysqlitetest_fother,12)
PVDynamic_AddGadget(#Window_mysqlitetest,#Gadget_mysqlitetest_helpbutton,12)
PVDynamic_AddGadget(#Window_mysqlitetest,#Gadget_mysqlitetest_exitbutton,12)
HideWindow(#Window_mysqlitetest,0)
ProcedureReturn WindowID()
EndIf
EndIf
EndProcedure
;==============================================================================================================================
; SQLite 3 related found by El_Choni
;==============================================================================================================================
#SQLITE3_OK = 0 ; Successful Result
#SQLITE3_ERROR = 1 ; SQL error Or missing database
#SQLITE3_INTERNAL = 2 ; An internal logic error in SQLite
#SQLITE3_PERM = 3 ; Access permission denied
#SQLITE3_ABORT = 4 ; Callback routine requested An abort
#SQLITE3_BUSY = 5 ; The database file is locked
#SQLITE3_LOCKED = 6 ; A table in The database is locked
#SQLITE3_NOMEM = 7 ; A malloc() failed
#SQLITE3_READONLY = 8 ; Attempt To write A readonly database
#SQLITE3_INTERRUPT = 9 ; Operation terminated by SQLite_Interrupt()
#SQLITE3_IOERR = 10 ; Some kind of disk I/O error occurred
#SQLITE3_CORRUPT = 11 ; The database disk image is malformed
#SQLITE3_NOTFOUND = 12 ; (internal Only) table Or record not found
#SQLITE3_FULL = 13 ; Insertion failed because database is full
#SQLITE3_CANTOPEN = 14 ; Unable To open The database file
#SQLITE3_PROTOCOL = 15 ; database lock protocol error
#SQLITE3_EMPTY = 16 ; (internal Only) database table is empty
#SQLITE3_SCHEMA = 17 ; The database schema changed
#SQLITE3_TOOBIG = 18 ; Too much Data For one Row of A table
#SQLITE3_CONStraint = 19 ; abort due To contraint violation
#SQLITE3_MISMATCH = 20 ; Data type mismatch
#SQLITE3_MISUSE = 21 ; Library used incorrectly
#SQLITE3_NOLFS = 22 ; Uses OS features not supported on host
#SQLITE3_AUTH = 23 ; Authorization denied
#SQLITE3_ROW = 100 ; sqlite_step() has another Row ready
#SQLITE3_DONE = 101 ; sqlite_step() has finished executing
;============================================================================================================================
; API date gadget date selection selection
;============================================================================================================================
#DTM_FIRST = $1000
#DTM_SETFORMAT = $1005
#DTS_SHOWNONE = $2
#MCM_GETCURSEL = $1001
#MCM_SETCURSEL = $1002
#GDT_NONE = $1
#DTM_SETSYSTEMTIME = #DTM_FIRST + 2
#DTM_GETSYSTEMTIME = #DTN_FIRST + 1
;============================================================================================================================
; My personal constants
;============================================================================================================================
#Version = "v0.00" ; Program version
#CopyRight = "<°)))o><²³ SQLite data test(c) " + #Version ; Copyright string
#Eol = Chr(10) + Chr(13) ; End of line marker
;==============================================================================================================================
; My personal constants
;==============================================================================================================================
Enumeration #GadgetIndex
#Gadget_mysqlitetest_return
EndEnumeration
;==============================================================================================================================
; Common controls structure size
;==============================================================================================================================
dt.INITCOMMONCONTROLSEX\dwSize = SizeOf(INITCOMMONCONTROLSEX)
dt\dwICC = $100
InitCommonControlsEx_(@dt)
;==============================================================================================================================
; Constants for statusbar handling
;==============================================================================================================================
#SB_SETBKCOLOR = $2001 ; Statusbar colour constant
Colour = RGB($E9, $DA, $87)
;============================================================================================================================
; Object colouring in the callback (used later when visual designer library isn't used)
;============================================================================================================================
;Colour = RGB($FF,$FF,$AA)
Yellow = CreateSolidBrush_($70DCFC)
Green = CreateSolidBrush_($7BDF84)
Blue = CreateSolidBrush_($E5B91A)
;============================================================================================================================
; Custom date routine structure
;==============================================================================================================================
Structure DateStructure ; Custom date routine
Year.w
Month.w
DayOfWeek.w
Day.w
Hour.w
Minute.w
Second.w
Milliseconds.w
EndStructure
;==============================================================================================================================
; Window data structure
;==============================================================================================================================
Structure windowdata ; Window structure data
winhandle.l ; Main window handle
statushandle.l ; Status bar handle
newstatwidth.l ; New status bar width
oldstatwidth.l ; Old status bar width
EndStructure
;==============================================================================================================================
; Program data structure
;==============================================================================================================================
Structure programdata ; Program data structure
curdir.s ; Current program startup directory
progname.s ; Program name for base filename saves
libfile.s ; SQLite dll file, in current directory
dbhandle.l ; Handle to the currently open database
dbname.s ; Name of the database to open
dbopen.l ; Is the database open or not
query.s ; Current sql query string
progquit.l ; User quit the program, so set the quit value to allow program to end repeat loop
numitems.l ; Always the true number of items in the database
curline.l ; Always the current line in the list object
record.s ; Program record pointer to true database record number
daynum.l ; Numerical day of the week mapped to word format
inifile.s ; Name and path of the options file
weekday.s ; Day of the week in name form
column.s ; Name of the highlighted column
table.s ; Name of the highlighted table
colnum.l ; Number of columns in the returned query
EndStructure
;==============================================================================================================================
; New list to hold returned sqlite data
;==============================================================================================================================
NewList SqlData.s()
;==============================================================================================================================
; All global variables
;==============================================================================================================================
Global program.programdata, form.windowdata
Global sqlite3_open.l,sqlite3_exec.l, sqlite3_close.l, sqlite3_errmsg.l, sqlite3_get_table.l, sqlite3_free_table.l
Global sqlite3_changes, sqlite3_last_insert_rowid, sqlite3_free
;==============================================================================================================================
; Get current direectory and store it for later
;==============================================================================================================================
program\curdir = Space(512) ; Give the variable enough space
If GetCurrentDirectory_(Len(program\curdir), @program\curdir) <> 0 ; Get the current directory
If Right(program\curdir, 1) <> "\" ; Each O/S does it differently so check for backspace
program\curdir + "\"
EndIf
EndIf
;==============================================================================================================================
; Create local picture and icon directory variables
;==============================================================================================================================
program\progname = "Sqlite Data Test" ; Constant program name
program\libfile = program\curdir + "sqlite3upx.dll" ; SQLite 3 dll file
program\inifile = program\curdir + "Sqlite Data Test.ini" ; The name and path of the program options file
;==============================================================================================================================
; Setup day and month literal names
;==============================================================================================================================
Dim NameOfDay.s(7) ; Fill an array with the names of the days (Terry Hough I think)
NameOfDay(0) = "Sunday"
NameOfDay(1) = "Monday"
NameOfDay(2) = "Tuesday"
NameOfDay(3) = "Wednesday"
NameOfDay(4) = "Thursday"
NameOfDay(5) = "Friday"
NameOfDay(6) = "Saturday"
Dim DaysPerMonth(12) ; Fill an array on how many days per month there are
For X = 0 To 11
DaysPerMonth(X) = 31
Next
DaysPerMonth(1) = 28
DaysPerMonth(3) = 30
DaysPerMonth(5) = 30
DaysPerMonth(8) = 30
DaysPerMonth(10) = 30
Dim NameOfMonth.s(12) ; fill an array with the names of the months
NameOfMonth(0) = "January"
NameOfMonth(1) = "February"
NameOfMonth(2) = "March"
NameOfMonth(3) = "April"
NameOfMonth(4) = "May"
NameOfMonth(5) = "June"
NameOfMonth(6) = "July"
NameOfMonth(7) = "August"
NameOfMonth(8) = "September"
NameOfMonth(9) = "October"
NameOfMonth(10) = "November"
NameOfMonth(11) = "December"
Dim Years.s(7) ; fill an array with the years
Years(0) = "2002"
Years(1) = "2003"
Years(2) = "2004"
Years(3) = "2005"
Years(4) = "2006"
Years(5) = "2007"
Years(6) = "2008"
;==============================================================================================================================
; Any included data in the final exe
;==============================================================================================================================
DataSection
sqlite3_dll : IncludeBinary "Libraries\sqlite3upx.dll"
EndDataSection
;============================================================================================================================
; Adds a suffix To the End of a <= 31 numeral 'date'
;============================================================================================================================
Procedure.s AddDateSuffix(Date.s)
If Date = "1" Or Date = "21" Or Date = "31"
Date = Date + "st"
ElseIf Date = "2" Or Date = "22"
Date = Date + "nd"
ElseIf Date = "3" Or Date = "23"
Date = Date + "rd"
Else
Date = Date + "th"
EndIf
ProcedureReturn Date
EndProcedure
;============================================================================================================================
; Get the current date and the day of the week in word form
;============================================================================================================================
Procedure GetDayOfWeek(Gadget.l)
program\daynum = DayOfWeek(ParseDate("%dd/%mm/%yyyy", GetGadgetText(Gadget.l)))
Select program\daynum
Case 0 : program\weekday = "Sunday"
Case 1 : program\weekday = "Monday"
Case 2 : program\weekday = "Tuesday"
Case 3 : program\weekday = "Wednesday"
Case 4 : program\weekday = "Thursday"
Case 5 : program\weekday = "Friday"
Case 6 : program\weekday = "Saturday"
EndSelect
EndProcedure
;============================================================================================================================
; Add an item to the end of any ListIconGadget display
;============================================================================================================================
Procedure AddToDisplay(Gadget.l, Text.s, IconItem.l)
AddGadgetItem(Gadget.l, -1, Text.s, UseImage(iconItem))
EndProcedure
;============================================================================================================================
; Count the number of records in an SQLite database
;============================================================================================================================
Procedure CountRecords()
If SQL3GetTable("Select Count(record) AS totalrecs FROM addresses", @myRows, @myCols, program\dbhandle)
If CountList(SqlData.s()) <> 0
LastElement(SqlData.s())
ProcedureReturn Val(StringField(SqlData.s(), 1, "|"))
EndIf
Else
SetStat(#StatusBar_mysqlitetest_messages, "Error: Could not get the number of records in the database")
ProcedureReturn 0
EndIf
EndProcedure
;============================================================================================================================
; Clear the windows event buffer to avoid greying out of forms
;============================================================================================================================
Procedure FlushEvents()
While WindowEvent()
Wend
EndProcedure
;============================================================================================================================
; Set the last line of a ListIconGadget
;============================================================================================================================
Procedure LastLine(Gadget.l)
SendMessage_(GadgetID(Gadget.l), #LVM_ENSUREVISIBLE, CountGadgetItems(Gadget.l) -1,0) ; Make sure the current line is visible
EndProcedure
;============================================================================================================================
; Sort out the date and display it
;============================================================================================================================
Procedure SetDate(Windowid.l)
newDate.dateStructure
GetSystemTime_(@newDate)
WeekDay.b = newDate\DayOfWeek
Day.b = newDate\Day
Month.b = newDate\Month
Year.w = newDate\Year
CurrentDate.s = NameOfDay(WeekDay) + ", " + AddDateSuffix(Str(Day)) + ", " + NameOfMonth(Month - 1) + ", " + Str(Year)
SetWindowTitle(Windowid.l, #CopyRight + " -- Today is " + CurrentDate.s)
EndProcedure
;============================================================================================================================
; Custom statusbar routine
;============================================================================================================================
Procedure SetStat(Field.l, Message.s)
StatusBarText(#StatusBar_mysqlitetest, Field.l, Message.s, 0)
EndProcedure
;============================================================================================================================
; Get data back from an SQLite database table and stuff it into a concatenated linked list
;============================================================================================================================
Procedure.l SQL3GetTable(sSQLQuery.s, *Rows, *Cols, lDataBaseHandle.l)
ClearList(SqlData.s())
If CallCFunctionFast(sqlite3_get_table, lDataBaseHandle, sSQLQuery, @LResultsPtr, @LRows, @LCols, @ReturnValue) = #SQLITE3_OK
PokeL(*Rows, LRows) ; return number of rows/columns
PokeL(*Cols, LCols)
If LRows > -1 And LCols > 0
Address.l = LResultsPtr ; copy data into array
For Row.l = 1 To LRows
For Col.l = 0 To LCols - 1
tempdata.s + PeekS(PeekL(Address + (((Row * LCols) + Col) * 4))) + "|"
Next
AddElement(SqlData.s())
SqlData.s() = tempdata
tempdata.s = ""
Next
EndIf
CallCFunctionFast(sqlite3_free_table, LResultsPtr) ; free table memory
ProcedureReturn #True
Else
CallCFunctionFast(sqlite3_errmsg, @ReturnValue)
Debug PeekS(ReturnValue)
ProcedureReturn #False
EndIf
EndProcedure
;============================================================================================================================
; Find the handle to a specific child on a window. In this case, the status bar.
;============================================================================================================================
Procedure GetAllChildHandles(Winhandle)
Childhandle = GetWindow_(Winhandle, #GW_CHILD)
Repeat
Namespace.s = Space(999)
GetClassName_(Childhandle, Namespace.s, 999)
If Namespace.s = "msctls_statusbar32"
Form\Statushandle = Childhandle
EndIf
Childhandle = GetWindow_(Childhandle, #GW_HWNDNEXT)
Until Childhandle = 0
EndProcedure
;============================================================================================================================
; Simplify the creation of API calendar gadgets
;============================================================================================================================
Procedure DateInputGadget(x, y, width_, height_)
hCal = CreateWindowEx_(0, "SysDateTimePick32", "DateTime", #WS_CHILD | #WS_VISIBLE |#WS_BORDER | #DTS_SHOWNONE, x, y, width_, height_, WindowID(), 0, GetModuleHandle_(0), 0)
SetWindowLong_(hCal, #GWL_STYLE, GetWindowLong_(hCal, #GWL_STYLE) | #WS_TABSTOP)
ProcedureReturn hCal
EndProcedure
;============================================================================================================================
; Uncle Berikco's routine to properly replace single quotes with double for SQL passing
;============================================================================================================================
Procedure.s RepQuote(Instring.s)
For i = 1 To Len(Instring.s)
If Mid(Instring.s, i, 1) = "'"
tmp.s = tmp.s + "''"
Else
tmp.s = tmp.s + Mid(Instring.s, i, 1)
EndIf
Next i
ProcedureReturn tmp.s
EndProcedure
;============================================================================================================================
; Kill double quotes in strings for display purposes
;============================================================================================================================
Procedure.s KillQuote(Instring.s)
ProcedureReturn ReplaceString(Instring.s, "''", "'", 1, 1)
EndProcedure
;============================================================================================================================
; Initialise the SQLite dll, create the datebase and the table if they don't exist
;============================================================================================================================
sqlite3_lib = LoadLibraryM(?sqlite3_dll) ; Load the library from memory, don't write to disk
If sqlite3_lib
sqlite3_open = GetProcAddressM(sqlite3_lib, "sqlite3_open")
sqlite3_exec = GetProcAddressM(sqlite3_lib, "sqlite3_exec")
sqlite3_close = GetProcAddressM(sqlite3_lib, "sqlite3_close")
sqlite3_errmsg = GetProcAddressM(sqlite3_lib, "sqlite3_errmsg")
sqlite3_get_table = GetProcAddressM(sqlite3_lib, "sqlite3_get_table")
sqlite3_free_table = GetProcAddressM(sqlite3_lib, "sqlite3_free_table")
sqlite3_changes = GetProcAddressM(sqlite3_lib, "sqlite3_sqlite3_changes")
sqlite3_last_insert_rowid = GetProcAddressM(sqlite3_lib, "sqlite3_last_insert_rowid")
sqlite3_free = GetProcAddressM(sqlite3_lib, "sqlite3_free")
Else
MessageRequester("SQLite3 Error", "Could not initialise the sqlite3upx.dll library file, can't find it or load it")
End
EndIf
;============================================================================================================================
; Visual designer created
;============================================================================================================================
Procedure WindowCallback(WindowID, Message, wParam, lParam)
ReturnValue = #PB_ProcessPureBasicEvents
If Message = #WM_GETMINMAXINFO
ReturnValue = PVDynamic_LockWindow(WindowID, lParam)
EndIf
If Message = #WM_SIZE
ReturnValue = PVDynamic_Resize(WindowID)
EndIf
If Message = #WM_CTLCOLORSTATIC Or Message = #WM_CTLCOLOREDIT Or Message = #WM_CTLCOLORLISTBOX
ReturnValue = PVDynamic_ColorGadget(lParam, wParam)
EndIf
ProcedureReturn ReturnValue
EndProcedure
;============================================================================================================================
; Main event handler for the window
;============================================================================================================================
If Window_mysqlitetest()
;----------------------------------------------------------------------------------------------------------
; Add a return keyboard shortcut to enter queries
;----------------------------------------------------------------------------------------------------------
AddKeyboardShortcut(#Window_mysqlitetest, #PB_Shortcut_Return, #Gadget_mysqlitetest_return)
;----------------------------------------------------------------------------------------------------------
; Standard windows callback made by visual designer for resizing, colouring etc
;----------------------------------------------------------------------------------------------------------
SetWindowCallback(@WindowCallback())
;----------------------------------------------------------------------------------------------------------
; Get windows handle for tray hiding and other functions
;----------------------------------------------------------------------------------------------------------
form\winhandle = WindowID(#Window_mysqlitetest)
;----------------------------------------------------------------------------------------------------------
; Find status bar handle and save it to Form\Statushandle
;----------------------------------------------------------------------------------------------------------
GetAllChildHandles(form\winhandle)
;----------------------------------------------------------------------------------------------------------
; Change the status bar colour to whatever we want now that we have found the handle to it
;----------------------------------------------------------------------------------------------------------
SendMessage_(form\statushandle, #SB_SETBKCOLOR, 0, Colour)
;----------------------------------------------------------------------------------------------------------
;Set the program day and date in the title bar
;----------------------------------------------------------------------------------------------------------
SetDate(#Window_mysqlitetest) ; Set current date on form title
;----------------------------------------------------------------------------------------------------------
; Let the user know that the database is open via the status bar
;----------------------------------------------------------------------------------------------------------
SetStat(#StatusBar_mysqlitetest_messages, "Information: The sqlite3upx.dll library file was loaded, The SQLite 3.x environment is ready to go")
;----------------------------------------------------------------------------------------------------------
; Set initial quit value to 0 so that program doesn't accidentally close
;----------------------------------------------------------------------------------------------------------
program\progquit = 0
Repeat
EventID = WaitWindowEvent()
MenuID = EventMenuID()
GadgetID = EventGadgetID()
WindowID = EventWindowID()
Select EventID
Case #PB_Event_CloseWindow
If WindowID = #Window_mysqlitetest
program\progquit = 1
EndIf
Case #PB_Event_Menu
Select MenuID
Case #Gadget_mysqlitetest_return : Gosub CheckEnterKey ; See if ENTER was pressed in query box
EndSelect
Case #PB_Event_Gadget
Select GadgetID
Case #Gadget_mysqlitetest_bgetdatabase : Gosub OpenADatabase ; Open a database to process
Case #Gadget_mysqlitetest_tables : Gosub GetColumnName ; Get the columns of the highlighted table
Case #Gadget_mysqlitetest_bload : Gosub LoadListFromDisk ; Load the last sql dump from disk
Case #Gadget_mysqlitetest_bsave : Gosub SaveListToDisk ; Save the sql dump to disk
Case #Gadget_mysqlitetest_helpbutton : Gosub HelpWanted ; Show a help screen to the user
Case #Gadget_mysqlitetest_exitbutton : program\progquit = 1 ; Set the quit flag
EndSelect
EndSelect
Until program\progquit
CloseWindow(#Window_mysqlitetest)
EndIf
End
;============================================================================================================================
OpenADatabase: ; Open a database to process
;============================================================================================================================
program\dbname = OpenFileRequester("Database to open", "", "Database file (*.*)|*.*", 0)
If CallCFunctionFast(sqlite3_open, program\dbname, @program\dbhandle) = #SQLITE3_OK
program\dbopen = 1
SetStat(#StatusBar_mysqlitetest_messages, "Information: The database " + program\dbname + " was opened successfully, program ready")
Gosub GetTableNames
Else
SetStat(#StatusBar_mysqlitetest_messages, "Error: The database " + program\dbname + " could not be opened")
EndIf
Return
;============================================================================================================================
GetTableNames: ; Get a list of the table names in the current database
;============================================================================================================================
program\query = "Select name FROM sqlite_master WHERE type='table' ORDER BY name"
If SQL3GetTable(program\query, @myRows, @myCols, program\dbhandle)
If CountList(SqlData.s()) <> 0
ForEach SqlData.s()
AddGadgetItem(#Gadget_mysqlitetest_tables, -1, RemoveString(SqlData.s(), "|", 0))
Next
Else
SetStat(#StatusBar_mysqlitetest_messages, "Error: There is no data returned by the query, database has no tables")
EndIf
Else
SetStat(#StatusBar_mysqlitetest_messages, "Error: The table information could not be retrieved")
EndIf
Return
;============================================================================================================================
GetColumnName:
;============================================================================================================================
program\table = GetGadgetItemText(#Gadget_mysqlitetest_tables, GetGadgetState(#Gadget_mysqlitetest_tables), 0)
program\query = "PRAGMA table_info(" + program\table + ")"
If SQL3GetTable(program\query, @myRows, @myCols, program\dbhandle)
If CountList(SqlData.s()) <> 0
ClearGadgetItemList(#Gadget_mysqlitetest_columns)
ForEach SqlData.s()
AddGadgetItem(#Gadget_mysqlitetest_columns, -1, StringField(SqlData.s(), 2, "|"))
Next
Else
SetStat(#StatusBar_mysqlitetest_messages, "Error: There is no data returned by the query, database has no columns")
EndIf
Else
SetStat(#StatusBar_mysqlitetest_messages, "Error: The column information could not be retrieved")
EndIf
Return
;============================================================================================================================
CheckEnterKey: ; See if ENTER was pressed in query box
;============================================================================================================================
FocusID = GetFocus_() ; Get the id of the window/object that has focus
Select FocusID ; Use the id in a gadget selection
Case GadgetID(#Gadget_mysqlitetest_query) ; Gadget is the barcode box
program\query = GetGadgetText(#Gadget_mysqlitetest_query) ; Get the text from the query box
Gosub RunDatabaseQuery ; Reusable data return routine
EndSelect ; End the selection
Return
;============================================================================================================================
LoadListFromDisk: ; Load the last sql dump from disk
;============================================================================================================================
Return
;============================================================================================================================
SaveListToDisk: ; Save the sql dump to disk
;============================================================================================================================
If CreateFile(0, SaveFileRequester("Save returned query", "QueryDump.txt", "Text (*.txt)|*.txt|All files (*.*)|*.*", 0)) <> 0
For ListItems = 0 To CountGadgetItems(#Gadget_mysqlitetest_datalist) - 1
For TotalColumns = 0 To program\colnum - 1
OutString.s + GetGadgetItemText(#Gadget_mysqlitetest_datalist, ListItems, TotalColumns) + ";"
Next TotalColumns
WriteStringN(OutString.s)
OutString.s = ""
Next ListItems
CloseFile(0)
Else
SetWindowTitle(#Window_mysqltest, #MainTitle + "Cannot save the list to disk, something went wrong")
EndIf
Return
;============================================================================================================================
RunDatabaseQuery:
;============================================================================================================================
program\query = GetGadgetText(#Gadget_mysqlitetest_query)
If program\colnum <> 0 ; Remove columns from previous query
For colremove = 1 To program\colnum - 1
RemoveGadgetColumn(#Gadget_mysqlitetest_datalist, 1)
Next colremove
program\colnum = 0
EndIf
If SQL3GetTable(program\query, @myRows, @myCols, program\dbhandle)
If CountList(SqlData.s()) <> 0
ClearGadgetItemList(#Gadget_mysqlitetest_datalist)
SelectElement(SqlData.s(), 0)
program\colnum = CountString(SqlData.s(), "|")
For coladd = 1 To program\colnum - 1 ; Add number of columns = to no of fields
AddGadgetColumn(#Gadget_mysqlitetest_datalist, 1, "Data", 100)
Next coladd
ForEach SqlData.s()
FlushEvents()
AddGadgetItem(#Gadget_mysqlitetest_datalist, -1, ReplaceString(SqlData.s(), "|", Chr(10), 1, 1))
Next
Else
SetStat(#StatusBar_mysqlitetest_messages, "Error: There is no data returned by the query, database has no data")
EndIf
Else
SetStat(#StatusBar_mysqlitetest_messages, "Error: The database information could not be retrieved")
EndIf
For WidthSet = 0 To program\colnum - 1 ; Auto set the field widths to biggest field
SendMessage_(GadgetID(#Gadget_mysqlitetest_datalist), #LVM_SETCOLUMNWIDTH, WidthSet, #LVSCW_AUTOSIZE)
Next WidthSet
Return
;============================================================================================================================
HelpWanted: ; Show a help screen to the user
;============================================================================================================================
Return
