Stretched out code so more people can follow it?
Added skin
Added tray hiding
Added error logging
Added return to last opened database directory (INI file)
Create, read from, update INI file
Save as "SQLite Data test.pb"
Code: Select all
;============================================================================================================================
; Please note that all the SQLite direct database code I found in the PureBasic forum, done by El_Choni, 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
;
;============================================================================================================================
; All included startup files
;============================================================================================================================
XIncludeFile "SQLite Data test_MyDeclarations.pb" ; My procedural declarations so procedures can be called out of sequence
XIncludeFile "SQLite Data test_Constants.pb" ; Visual designer created constants file
XIncludeFile "SQLite Data test_Windows.pb" ; Visual designer created windows code
XIncludeFile "SQLite Data test_Myconstants.pb" ; All my personal constants
XIncludeFile "SQLite Data test_Myprocedures.pb" ; All my personal procedures
;============================================================================================================================
; Initialise the SQLite dll, create the database 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 callback for object and form resizing, colouring etc
;============================================================================================================================
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
;============================================================================================================================
If Window_mysqlitetest()
;----------------------------------------------------------------------------------------------------------
; Add a return keyboard shortcut to enter queries and exit the program
;----------------------------------------------------------------------------------------------------------
AddKeyboardShortcut(#Window_mysqlitetest, #PB_Shortcut_Return, #Gadget_mysqlitetest_return)
AddKeyboardShortcut(#Window_mysqlitetest, #PB_Shortcut_Alt | #PB_Shortcut_X, #Gadget_mysqlitetest_exit)
;----------------------------------------------------------------------------------------------------------
; Add the message and record statusbar icons
;----------------------------------------------------------------------------------------------------------
StatusBarIcon(#StatusBar_mysqlitetest, #StatusBar_mysqlitetest_messages, UseImage(#Image_mysqlitetest_messages))
StatusBarIcon(#StatusBar_mysqlitetest, #StatusBar_mysqlitetest_records, UseImage(#Image_mysqlitetest_records))
;----------------------------------------------------------------------------------------------------------
; Standard windows callback 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")
SetStat(#StatusBar_mysqlitetest_records, "Record(s)")
;----------------------------------------------------------------------------------------------------------
; Find the last used database directory in here
;----------------------------------------------------------------------------------------------------------
program\lastdbdir = GetIniKey("Last Dir", "Last Database Dir", "C:\", program\inifile)
;----------------------------------------------------------------------------------------------------------
; Set initial quit value to 0 so that program doesn't accidentally close
;----------------------------------------------------------------------------------------------------------
program\progquit = 0
Repeat
If IsIconic_(Form\winhandle) <> 0 ; The window has been minimized
HideWindow(#Window_mysqlitetest, 1)
AddSysTrayIcon(1, form\winhandle, UseImage(#Image_mysqlitetest_program))
SysTrayIconToolTip(1, "SQLite 3.xx Data retrieval in here!!!")
EndIf
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Select EventWindowID()
Case #Window_mysqlitetest : program\progquit = 1 ; Window close event happned so set quit flag
EndSelect
Case #PB_Event_Menu
Select EventMenuID()
Case #Gadget_mysqlitetest_return : Gosub CheckEnterKey ; See if ENTER was pressed in query box
Case #Gadget_mysqlitetest_exit : program\progquit = 1 ; Set the quit flag
EndSelect
Case #PB_Event_Gadget
Select EventGadgetID()
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_bsave : Gosub SaveListToDisk ; Save the sql dump to disk
Case #Gadget_mysqlitetest_helpbutton : Gosub ShowHelp ; Show a help screen to the user
Case #Gadget_mysqlitetest_exitbutton : program\progquit = 1 ; Set the quit flag
EndSelect
Case #PB_Event_SysTray ; System tray events
If EventType() = #PB_EventType_LeftClick
RemoveSysTrayIcon(1)
HideWindow(#Window_mysqlitetest, 0)
SetForegroundWindow_(Form\winhandle) ; Un-hiding the window brings it to the front
EndIf
EndSelect
Until program\progquit
CloseWindow(#Window_mysqlitetest)
SetIniKey("Last Dir", "Last Database Dir", program\lastdbdir, program\inifile)
EndIf
End
;============================================================================================================================
OpenADatabase: ; Open a database to process
;============================================================================================================================
program\dbname = OpenFileRequester("Database to open", program\lastdbdir, "Database file (*.*)|*.*", 0)
If program\dbname <> ""
program\lastdbdir = GetPathPart(program\dbname)
EndIf
If CallCFunctionFast(sqlite3_open, program\dbname, @program\dbhandle) = #SQLITE3_OK
program\dbopen = 1
SetStat(#StatusBar_mysqlitetest_messages, "Info: The database " + program\dbname + " was opened successfully, program ready")
Gosub GetTableNames ; Get a list of the table names in the current database
Else
SetStat(#StatusBar_mysqlitetest_messages, "Error: The database " + program\dbname + " could not be opened")
program\errorhandle = OpenFile(#PB_Any , program\errorlog) ; Open the error log file
CallCFunctionFast(sqlite3_errmsg, @ReturnValue) ; Get the last sqlite error message
FileSeek(Lof()) ; Seek to the end of the file
WriteStringN("OpenADatabase " + PeekS(ReturnValue)) ; Write the error to the error log plus module name
CloseFile(program\errorhandle) ; Close the error log
program\errorhandle = -1 ; Reset the handle to negative value
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)) ; Get the returned table names
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")
program\errorhandle = OpenFile(#PB_Any , program\errorlog) ; Open the error log file
CallCFunctionFast(sqlite3_errmsg, @ReturnValue) ; Get the last sqlite error message
FileSeek(Lof()) ; Seek to the end of the file
WriteStringN("GetTableNames " + PeekS(ReturnValue)) ; Write the error to the error log plus module name
CloseFile(program\errorhandle) ; Close the error log
program\errorhandle = -1 ; Reset the handle to negative value
EndIf
Return
;============================================================================================================================
GetColumnName: ; Get a list of culumns in the currently highlighted table
;============================================================================================================================
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")
program\errorhandle = OpenFile(#PB_Any , program\errorlog) ; Open the error log file
CallCFunctionFast(sqlite3_errmsg, @ReturnValue) ; Get the last sqlite error message
FileSeek(Lof()) ; Seek to the end of the file
WriteStringN("GetColumnNames " + PeekS(ReturnValue)) ; Write the error to the error log plus module name
CloseFile(program\errorhandle) ; Close the error log
program\errorhandle = -1 ; Reset the handle to negative value
EndIf
Return
;============================================================================================================================
CheckEnterKey: ; See if ENTER was pressed in the query box and then run the query
;============================================================================================================================
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
If program\query <> "" ; Don't pass empty string to query maker
Gosub RunDatabaseQuery ; Reusable data return routine
EndIf
EndSelect ; End the selection
Return
;============================================================================================================================
SaveListToDisk: ; Save the sql dump to disk
;============================================================================================================================
SaveFile.s = SaveFileRequester("Save returned query", "QueryDump.txt", "Text (*.txt)|*.txt|All files (*.*)|*.*", 0)
If CreateFile(0, SaveFile.s) <> 0
For ListItems = 0 To CountGadgetItems(#Gadget_mysqlitetest_datalist) - 1 ; Go through items in the list
For TotalColumns = 0 To program\colnum - 1 ; Go through every column in the list
OutString.s + Chr(34) + GetGadgetItemText(#Gadget_mysqlitetest_datalist, ListItems, TotalColumns) + Chr(34) + ","
Next TotalColumns
SetStat(#StatusBar_mysqlitetest_records, "Saving Line " + Str(ListItems))
WriteStringN(Sremove(OutString, "R", 1)) ; Remove trailing comma
OutString.s = ""
Next ListItems
CloseFile(0)
SetStat(#StatusBar_mysqlitetest_messages, "Info: " + Str(CountGadgetItems(#Gadget_mysqlitetest_datalist)) + " Lines saved To disk")
Else
SetStat(#StatusBar_mysqlitetest_messages, "Error: Cannot save the list to disk, something went wrong")
EndIf
Return
;============================================================================================================================
RunDatabaseQuery: ; Run the database query now
;============================================================================================================================
program\query = GetGadgetText(#Gadget_mysqlitetest_query) ; Get the query text
If SQL3GetTable(program\query, @myRows, @myCols, program\dbhandle) ; Run the query
If CountList(SqlData.s()) <> 0
ClearGadgetItemList(#Gadget_mysqlitetest_datalist) ; Clear previous items from the list
Gosub RemoveOldColumns ; Remove the columns from the previous query
Gosub AddNewColumns ; Add the number of columns that the query returned
ForEach SqlData.s() ; Process each new item and add them to display
FlushEvents() ; Flush window events to stop form greying out
AddGadgetItem(#Gadget_mysqlitetest_datalist, -1, ReplaceString(SqlData.s(), "|", Chr(10), 1, 1))
Next
Gosub AutoSizeColumns ; Auto resize columns based on data widths
SetStat(#StatusBar_mysqlitetest_messages, "Info: The query matched " + Str(myRows) + " lines of data and " + Str(myCols) + " columns in each line")
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")
program\errorhandle = OpenFile(#PB_Any , program\errorlog) ; Open the error log file
CallCFunctionFast(sqlite3_errmsg, @ReturnValue) ; Get the last sqlite error message
FileSeek(Lof()) ; Seek to the end of the file
WriteStringN("RunDatabaseQuery " + PeekS(ReturnValue)) ; Write the error to the error log plus module name
CloseFile(program\errorhandle) ; Close the error log
program\errorhandle = -1 ; Reset the handle to negative value
EndIf
Return
;============================================================================================================================
RemoveOldColumns: ; Remove the columns from the previous query
;============================================================================================================================
If program\colnum <> 0 ; Remove columns from previous query if query okay
For colremove = 1 To program\colnum - 1
RemoveGadgetColumn(#Gadget_mysqlitetest_datalist, 1)
Next colremove
program\colnum = 0
EndIf
Return
;============================================================================================================================
AddNewColumns: ; Add the number of columns that the query returned
;============================================================================================================================
For coladd = 1 To myCols - 1 ; Add number of columns equal to number of fields
AddGadgetColumn(#Gadget_mysqlitetest_datalist, 1, "Data", 100) ; Add the new colum to the ListIcon with a width of 100
Next coladd ; Now do the next column
Return
;============================================================================================================================
AutoSizeColumns: ; Auto resize columns based on data widths, this might take a few seconds
;============================================================================================================================
SetStat(#StatusBar_mysqlitetest_messages, "Info: Please wait while I auto resize the display to fit the data width")
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
;============================================================================================================================
ShowHelp: ; Show a help screen to the user
;============================================================================================================================
Return
Code: Select all
;==============================================================================================================================
; Any declarations
;==============================================================================================================================
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
Declare.s Sremove(InString.s, Direction.s, Length.l) ; Remove strings from left or right side of input string
;==============================================================================================================================
; 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
Code: Select all
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_fcontrol
#Gadget_mysqlitetest_bgetdatabase
#Gadget_mysqlitetest_ltables
#Gadget_mysqlitetest_tables
#Gadget_mysqlitetest_lcolumns
#Gadget_mysqlitetest_columns
#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
#StatusBar_mysqlitetest_records = 1
EndEnumeration
#StatusBarIndex = #PB_Compiler_EnumerationValue
Enumeration 1
#Image_mysqlitetest
EndEnumeration
#ImageIndex = #PB_Compiler_EnumerationValue
CatchImage(#Image_mysqlitetest, ?_OPT_mysqlitetest)
DataSection
_OPT_mysqlitetest : IncludeBinary "Images\Blank Button.bmp"
EndDataSection
Code: Select all
Procedure.l Window_mysqlitetest()
If OpenWindow(#Window_mysqlitetest,18,72,905,600,#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered|#PB_Window_Invisible,"SQLite - ")
Brush.LOGBRUSH\lbStyle=#BS_PATTERN
Brush\lbColor=#DIB_RGB_COLORS
Brush\lbHatch=UseImage(#Image_mysqlitetest)
SetClassLong_(WindowID(#Window_mysqlitetest),#GCL_HBRBACKGROUND,CreateBrushIndirect_(Brush))
If CreateGadgetList(WindowID(#Window_mysqlitetest))
Frame3DGadget(#Gadget_mysqlitetest_fmain,5,0,710,535,"")
ListIconGadget(#Gadget_mysqlitetest_datalist,10,10,700,520,"itemslist",2048,#PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection)
SendMessage_(GadgetID(#Gadget_mysqlitetest_datalist),#LVM_SETBKCOLOR,0,16770015)
SendMessage_(GadgetID(#Gadget_mysqlitetest_datalist),#LVM_SETTEXTBKCOLOR,0,16770015)
Frame3DGadget(#Gadget_mysqlitetest_fquery,5,535,710,40,"")
TextGadget(#Gadget_mysqlitetest_lquery,15,555,45,15,"Query ",#PB_Text_Right)
StringGadget(#Gadget_mysqlitetest_query,60,550,650,20,"")
PVDynamic_AddColorGadget(#Gadget_mysqlitetest_query,0,16770015)
Frame3DGadget(#Gadget_mysqlitetest_fcontrol,720,0,180,535,"")
ButtonGadget(#Gadget_mysqlitetest_bgetdatabase,730,15,165,20,"Open Database")
TextGadget(#Gadget_mysqlitetest_ltables,725,45,170,15,"Table names in database",#PB_Text_Center)
ListViewGadget(#Gadget_mysqlitetest_tables,725,60,170,300)
PVDynamic_AddColorGadget(#Gadget_mysqlitetest_tables,0,16770015)
TextGadget(#Gadget_mysqlitetest_lcolumns,725,365,170,15,"Columns names in table",#PB_Text_Center)
ListViewGadget(#Gadget_mysqlitetest_columns,725,380,170,125)
PVDynamic_AddColorGadget(#Gadget_mysqlitetest_columns,0,16770015)
ButtonGadget(#Gadget_mysqlitetest_bsave,725,510,170,20,"Save sql dump to disk")
GadgetToolTip(#Gadget_mysqlitetest_bsave,"press this button to dump the results of the query to a disk file")
Frame3DGadget(#Gadget_mysqlitetest_fother,720,535,180,40,"")
ButtonGadget(#Gadget_mysqlitetest_helpbutton,725,550,85,20,"Help")
ButtonGadget(#Gadget_mysqlitetest_exitbutton,810,550,85,20,"Exit")
CreateStatusBar(#StatusBar_mysqlitetest,WindowID(#Window_mysqlitetest))
AddStatusBarField(712)
AddStatusBarField(200)
HideWindow(#Window_mysqlitetest,0)
ProcedureReturn WindowID()
EndIf
EndIf
EndProcedure
Code: Select all
;==============================================================================================================================
; 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
#Gadget_mysqlitetest_exit
EndEnumeration
Enumeration #ImageIndex
#Image_mysqlitetest_program
#Image_mysqlitetest_messages
#Image_mysqlitetest_records
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
;============================================================================================================================
;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
lastdbdir.s ; Full path to the last used source database directory
errorlog.s ; Name of the error log file
errorhandle.l ; Handle of the eror log file
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
program\errorlog = program\curdir + "Sqlite Data Test.log" ; Name of the error log 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"
;============================================================================================================================
;
;============================================================================================================================
CatchImage(#Image_mysqlitetest_program, ?_PTK_mysqlitetest_program)
CatchImage(#Image_mysqlitetest_messages, ?_PTK_mysqlitetest_messages)
CatchImage(#Image_mysqlitetest_records, ?_PTK_mysqlitetest_records)
;==============================================================================================================================
; Any included data in the final exe
;==============================================================================================================================
DataSection
sqlite3_dll : IncludeBinary "Libraries\sqlite3upx.dll"
_PTK_mysqlitetest_program : IncludeBinary "Images\program16x16.ico"
_PTK_mysqlitetest_messages : IncludeBinary "Images\messages16x16.ico"
_PTK_mysqlitetest_records : IncludeBinary "Images\records16x16.ico"
EndDataSection
Code: Select all
;============================================================================================================================
; 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
;============================================================================================================================
; Remove strings from left or right side of input string
;============================================================================================================================
Procedure.s Sremove(InString.s, Direction.s, Length.l)
StringLen.l = Len(InString.s)
Select Direction.s
Case "L" : ProcedureReturn = Right(InString.s, StringLen - length)
Case "R" : ProcedureReturn = Left(InString.s, StringLen - length)
EndSelect
EndProcedure
