ServQLite 0.0.6 - CC-BY-NC-SA SQLite-Server for PureBasic

[jamirokwai]

Dear PB-Users,

today I will donate my approach of implementing an SQLite-Server to the PB-community. It will be published under a CC-License like this: http://creativecommons.org/licenses/by-nc-sa/3.0/

Everybody is invited to help making this the perfect server for PureBasic...
The only reason, I added NC (non-commercial) is: I think it is far from being perfectly usable in a productive environment. I will never charge for ServQLite, but users have to contact me to get the allowance to use it commercially.

So: No guarantee at all for your data, and life. - That much for the business terms...

----

Development was done on Mac OS X 10.6.4 using PB 4.41, now PB 4.51rc1.
Testing was done on VirtualBox with Windows XP, and Ubuntu-Linux 10.4.
Here is a ZIP with all Pictures, Icons, and the Source-Codes itself. http://pb.quadworks.de/OSS/ServQLite.0.0.6.zip
Every change and improvement is added to the below posts, and the ZIP (as time permits...)

----

Here is the current feature-set with to-dos, and bugs. Feel free to comment and help making it better...

Code: Select all

; ###################
; # ServQLite 0.0.6 #
; #   (p) 2009-2010 #
; #    quadWorks.de #
; ###################

; #####################################################################
; This code is licensed under a Creative Commons Licence:
; http://creativecommons.org/licenses/by-nc-sa/3.0/
; Means: you may alter the code, but have to give the changes back
;        you may use this code as you like, but without commercial background
; If you like to use this code commercially, please contact joerg.burbach@quadworks.de
; #####################################################################

; Functions
; - create database
; - create table
; - INSERT, SELECT, UPDATE-Queries
; - remove single rows
; - get columns of a single row
; - get count of columns
; - get Name, Size, and Type of a column
; - Set TimeOut for Clients
; - TrayIcon shows if server runs
; - Logging
; - external config-file

; ToDo
; - extend config-file
; - extended logging
; - check for double-connection, max connected clients
; - queueing of queries
; - threading
; - encryption
; - user-rights, password
; - automatic/manual backup/restore, compressed and encrypted
; - better error-checking
; - statistics (uptime, memory-consume, count queries, etc.)
; - put connected users into TrayIcon, short statistics into ToolTip of TrayIcon
; - reduce memory-footprint and CPU-footprint
; - zero-config to find the server and the network and to determine its port-address
; - find a free port
; - send E-Mails with "HELP!" to the admin
; - receive E-Mails with queries and send it back

; ToDo for ServQLite.pbi-Include
; - allow multiple connections
; - correct Blob-Transfer
; - correct fallback to internal SQLite-Routines available by PureBasic

; know Bugs
; - Blobs don't work correctly for now

[jamirokwai]

Part I - III: the Server-Source-Code - ServQLite.pb

Code: Select all

#Debug   = 1            ; 1 = Debug -> set TrayIcon
#Title   = "ServQLite"  ; Name for diverse usages
#Version = "0.0.6"      ; current version

#ServQL_Path = ""

Global ServQL_Port   = 6832             ; Standard-Port for ServQLite
Global BufferSize    = 4096             ; Puffer for transfer of text
Global BlobSize      = 8196             ; maximal size of a BLOB
Global ClientTimeOut = 10 * 60 * 1000   ; 10 minutes Time-Out for Clients
Global CheckTimeOut  =  1 * 60 * 1000   ; Check for Time-Out every 60 seconds
Global LogFile       = 0                ; File-ID for logfile
Global SEvent        = 0                ; for event-management
Global ClientID      = 0                ; for event-management
Global Quit          = 0                ; Quit = 1 -> exit Server

CompilerIf #PB_Compiler_Debugger
 Global location$ = ""
CompilerElse
 Global location$ = Left(GetPathPart(ProgramFilename()),FindString(GetPathPart(ProgramFilename()),GetFilePart(ProgramFilename())+".app",1)-1)
CompilerEndIf 

Enumeration
 #ServQL_Blob_No
 #ServQL_Blob_Upload
 #ServQL_Blob_Download
EndEnumeration

Enumeration
 #ServQL_OK
 #ServQL_DB_Created
 #ServQL_DB_Exists
 #ServQL_DB_Not_Found
 #ServQL_DB_Opened
 #ServQL_DB_Creation_Error
 #ServQL_DB_Opened_Error
 #ServQL_DB_Query_Success
 #ServQL_DB_Query_Fault
 #ServQL_Last_Row
 #ServQL_First_Row
 #ServQL_No_Network
 #ServQL_Mem_Error
 #ServQL_Port_Error
 #ServQL_Ready
EndEnumeration

Structure SerQL_Query
 ClientID.l
 Request$
 Cur.l
 Max.l
 DB.l
 LastConnect.l
 ClientIP.l
 *Blob
 Size.l
 Richtung.l
 Column.l
 LastError.l
EndStructure

Global NewList ServQL.serql_query()

Procedure.l FindeLinked(ClientID)
Define Temp 
 
 Temp = 0
 ForEach ServQL()
  If ServQL()\ClientID = ClientID
   ProcedureReturn Temp
  EndIf
  Temp + 1
 Next
 ProcedureReturn - 1
EndProcedure

Procedure   ServQL_Log(Text$)
  WriteString(LogFile, "[" + FormatDate("%mm/%dd/%yyyy - %hh:%ii:%ss", Date()) + "]: " + Text$ + #CR$)
EndProcedure

Procedure.s ServQL_DatabaseError(ClientID)
 Define Temp$, ServQL_LastError.l
 
 SelectElement(ServQL(), ClientID)
 ServQL_LastError = ServQL()\LastError
 Temp$ = Str(ServQL_LastError) + ": "
 Select ServQL_LastError 
  Case #ServQL_OK                : Temp$ + "no error" 
  Case #ServQL_DB_Created        : Temp$ + "Database created"
  Case #ServQL_DB_Exists         : Temp$ + "Database exists"
  Case #ServQL_DB_Not_Found      : Temp$ + "Database not found"
  Case #ServQL_DB_Opened         : TemP$ + "Database opened"
  Case #ServQL_DB_Creation_Error : Temp$ + "Database could not be created"
  Case #ServQL_DB_Opened_Error   : TemP$ + "Database could not be opened"
  Case #ServQL_DB_Query_Success  : Temp$ + "Query successfully started" 
  Case #ServQL_DB_Query_Fault    : Temp$ + "Query fault" ; !!
  Case #ServQL_Last_Row          : Temp$ + "Reached last row in Table"
  Case #ServQL_First_Row         : Temp$ + "Reached first row in Table"
  Case #ServQL_No_Network        : Temp$ + "No Network reachable"
  Case #ServQL_Mem_Error         : Temp$ + "Could not reserve enough memory"
  Case #ServQL_Port_Error        : Temp$ + "Port already in use. Please change Configuration."
 EndSelect
 ProcedureReturn Temp$
EndProcedure

Procedure.s ServQL_GetTable(Query$)
 Define Ab.l, Bis.l
 Ab  = FindString(UCase(Query$), " FROM ", 0) + 6
 Bis = FindString(Query$ + " ", " ", Ab)
 ProcedureReturn Trim(Mid(Query$, Ab));, Bis - Ab))
EndProcedure

Procedure.l ServQL_CreateDatabase(DatabaseName$, User$, Password$) ; - OK
 Define DBFile.l
 
 DBFile = ReadFile(#PB_Any, #ServQL_Path + DatabaseName$)
 If DBFile <> 0
  If IsFile(DBFile)
   CloseFile(DBFile)
  EndIf
  ProcedureReturn #ServQL_DB_Exists
 Else
  DBFile = CreateFile(#PB_Any, #ServQL_Path + DatabaseName$)
  If IsFile(DBFile)
   CloseFile(DBFile)
  EndIf
  If DBFile <> 0
   ProcedureReturn #ServQL_DB_Created
  Else
   ProcedureReturn #ServQL_DB_Creation_Error
  EndIf
 EndIf
EndProcedure

Procedure.l ServQL_OpenDatabase(DatabaseName$, User$, Password$, ClientID) ; - 
; fehlt: Statistik ermitteln (Anzahl Tabellen, Anzahl Datensätze, etc.)
; fehlt: Benutzername und Passwort
 Define DBFile.l
 
 SelectElement(ServQL(), ClientID)
 DBFile = ReadFile(#PB_Any,#ServQL_Path + DatabaseName$)
 If DBFile = 0
  ServQL()\LastError = #ServQL_DB_Not_Found
 Else
  If IsFile(DBFile)
   CloseFile(DBFile)
  EndIf
  DBFile = OpenDatabase(#PB_Any, #ServQL_Path + DatabaseName$, User$, Password$)
  If DBFile <> 0
   ServQL()\LastError = #ServQL_DB_Opened
  Else
   CloseDatabase(DBFile)
   ServQL()\LastError = #ServQL_DB_Creation_Error
   ProcedureReturn #ServQL_DB_Creation_Error
  EndIf
 EndIf
 ServQL()\DB = DBFile
 ProcedureReturn DBFile
EndProcedure

Procedure.l ServQL_CloseDatabase(ClientID)
 Define Database.l

 SelectElement(ServQL(), ClientID)
 Database = ServQL()\DB
 If IsDatabase(Database)
  CloseDatabase(Database)
 EndIf
EndProcedure

Procedure.l ServQL_GetCount(ClientID, Table$)
 Define Database.l, Anzahl.l

 SelectElement(ServQL(), ClientID)
 Database = ServQL()\DB
 Anzahl   = 0
 If DatabaseQuery(Database, "SELECT COUNT(*) FROM " + Table$)
  NextDatabaseRow(Database)
  Anzahl = GetDatabaseLong(Database, 0)
  FinishDatabaseQuery(Database) 
 EndIf
 ProcedureReturn Anzahl
EndProcedure

Procedure.s ServQL_SetDatabaseBlob(ClientID)
 SelectElement(ServQL(), ClientID)
 SetDatabaseBlob(ServQL()\DB, ServQL()\Column, ServQL()\Blob, ServQL()\Size)
 ProcedureReturn "SetDatabaseBlob"
EndProcedure

Procedure.s ServQL_GetDatabaseBlob(ClientID, Column)
 Define Database.l, Temp$, *buffer
 
 SelectElement(ServQL(), ClientID) 
 Database = ServQL()\DB
 Temp$ = ServQL()\Request$ + " LIMIT " + Str(ServQL()\Cur) + ",1;" 
 DatabaseQuery(Database, Temp$)
 NextDatabaseRow(Database)
 ServQL()\Column = Column
 ServQL()\Size   = DatabaseColumnSize(Database, Column) 
 *buffer         = AllocateMemory(ServQL()\Size)
 ServQL()\Blob   = AllocateMemory(ServQL()\Size)
; hier gibt es ein Problem?!? 
 GetDatabaseBlob(Database, Column, *buffer, ServQL()\Size)
 CopyMemory(*buffer, ServQL()\Blob, ServQL()\Size)
 If *buffer
  FreeMemory(*buffer)
 EndIf
; hier gibt es ein Problem?!?
 ProcedureReturn "GetDatabaseBlob"
EndProcedure

Procedure.s ServQL_DatabaseQuery(ClientID, Request$)
 Define Table$, Database.l, i.l, Anzahl.l, Additiv$
 
 SelectElement(ServQL(), ClientID)
 Table$            = ServQL_GetTable(Request$)
 ServQL()\Request$ = Request$
 ServQL()\Cur      = -1
 ServQL()\Max      = ServQL_GetCount(ClientID, Table$)
 ; wenn es eine SELECT-Abfrage ist, dann hier bereits ausführen und ermitteln:
 ; - DatabaseColumns (Anzahl)
 ; - DatabaseColumnName (Namen der Spalten)
 ; - DatabaseColumnType (Typ der Spalten)
 If FindString(UCase(Request$), "SELECT", 0) <> 0
  Database = ServQL()\DB
  DatabaseQuery(Database, Request$)
  Anzahl   = DatabaseColumns(Database)
  Additiv$ = "°" + Str(Anzahl)
  For i = 0 To Anzahl - 1
   Additiv$ + "°" + DatabaseColumnName(Database, i) + "°" + Str(DatabaseColumnSize(Database, i)) + "°" + Str(DatabaseColumnType(Database, i))
  Next i
  FinishDatabaseQuery(Database)
 EndIf 
 
ProcedureReturn Str(ServQL()\Max) + Additiv$
EndProcedure

Procedure.l ServQL_NextDatabaseRow(ClientID)
 Define Cur.l, Max.l
 
 SelectElement(ServQL(), ClientID)
 Cur = ServQL()\Cur
 Max = ServQL()\Max
 Cur + 1
 If Cur > Max
  Cur = Max
  ServQL()\LastError = #ServQL_Last_Row
  ProcedureReturn 0
 EndIf
 ServQL()\Cur = Cur
 ProcedureReturn Max - Cur
EndProcedure

Procedure.l ServQL_PreviousDatabaseRow(ClientID)
 Define Cur.l
 
 SelectElement(ServQL(), ClientID)
 Cur = ServQL()\Cur
 If Cur = 0
  Cur = 1
  ServQL()\LastError = #ServQL_Last_Row
  ProcedureReturn 0
 EndIf
 ServQL()\Cur = Cur
 ProcedureReturn Cur
EndProcedure

Procedure.l ServQL_FirstDatabaseRow(ClientID)
 SelectElement(ServQL(), ClientID)
 ServQL()\Cur = - 1
 ProcedureReturn ServQL()\Max - ServQL()\Cur
EndProcedure

Procedure.s ServQL_GetDatabaseString(ClientID)
 Define Database.l, Anzahl.l, I.l, Temp$

 SelectElement(ServQL(), ClientID)
 Database = ServQL()\DB
 Temp$ = ServQL()\Request$ + " LIMIT " + Str(ServQL()\Cur) + ",1;"
 DatabaseQuery(Database, Temp$)
 NextDatabaseRow(Database)
 Anzahl = DatabaseColumns(Database)
 Temp$ = ""
 For I = 0 To Anzahl - 2
  Temp$ + GetDatabaseString(Database, I) + "°"
 Next i
 Temp$ + GetDatabaseString(Database, Anzahl - 1)
 FinishDatabaseQuery(Database)
 ProcedureReturn Temp$
EndProcedure

Procedure.l ServQL_CheckDatabaseUpdate(ClientID, Request$)
 SelectElement(ServQL(), ClientID)
 DatabaseUpdate(ServQL()\DB, Request$)
;  Debug DatabaseError()
EndProcedure

Procedure.l ServQL_FinishDatabaseQuery(ClientID)
 SelectElement(ServQL(), ClientID)
 FinishDatabaseQuery(ServQL()\DB)
EndProcedure

Procedure.s ServQL_CheckString(Request$, ClientID)
 Define Order$, Order1$, Order2$, Order3$, Temp$
 
 Order$     = StringField(Request$, 1, "°")
 Order1$    = StringField(Request$, 2, "°")
 Order2$    = StringField(Request$, 3, "°")
 Order3$    = StringField(Request$, 4, "°")
 Temp$      = ""

 SelectElement(ServQL(), ClientID)
 
 Select Order$
  Case "CreateDatabase"      : Temp$ = Str(ServQL_Createdatabase(Order1$, Order2$, Order3$))
  Case "OpenDatabase"        : Temp$ = Str(ServQL_OpenDatabase(Order1$, Order2$, Order3$, ClientID))
  Case "DatabaseQuery"       : Temp$ = ServQL_DatabaseQuery(ClientID, Order1$)
  Case "FinishDatabaseQuery" : Temp$ = Str(ServQL_FinishDatabaseQuery(ClientID))
  Case "NextDatabaseRow"     : Temp$ = Str(ServQL_NextDatabaseRow(ClientID))
  Case "PreviousDatabaseRow" : Temp$ = Str(ServQL_PreviousDatabaseRow(ClientID))
  Case "FirstDatabaseRow"    : Temp$ = Str(ServQL_FirstDatabaseRow(ClientID))
  Case "GetDatabaseString"   : Temp$ = ServQL_GetDatabaseString(ClientID)
  Case "DatabaseUpdate"      : Temp$ = Str(ServQL_CheckDatabaseUpdate(ClientID, Order1$))
  Case "DatabaseError"       : Temp$ = ServQL_DatabaseError(ClientID)
  Case "CloseDatabase"       : Temp$ = Str(ServQL_CloseDatabase(ClientID))
  Case "DatabaseDriverName"  : Temp$ = #Title + " v" + #Version
  Case "DatabaseDriverDescription" : Temp$ = #Title + " v" + #Version + ": support for SQLite-orders via Network"
  Case "SetDatabaseBlob"     : If Val(Order2$) <> 0
                                SendNetworkString(ServQL()\ClientID, Order$ + "°Prepared. Send me " + Order2$)
                                ServQL()\Richtung = #ServQL_Blob_Upload
                                ServQL()\Column   = Val(Order1$)
                                ServQL()\Size     = Val(Order2$)
                               Else
                                SendNetworkString(ServQL()\ClientID, Order$ + "°0°I am out")
                               EndIf
  Case "GetDatabaseBlob"     : ServQL_GetDatabaseBlob(ClientID, Val(Order1$))
                               SendNetworkString(ServQL()\ClientID, Order$ + "°Prepared. I send you°" + Str(ServQL()\Size))
  Case "GetDatabaseBlobRec"  : SendNetworkData(ServQL()\ClientID, ServQL()\Blob, ServQL()\Size)
                               FreeMemory(ServQL()\Blob)
  Case "Quit Server"         : Temp$ = Order$
 EndSelect
 ServQL_Log(Order$ + " - " + Temp$)

 If Temp$ <> ""
  SendNetworkString(ServQL()\ClientID, Order$ + "°" + Temp$)
 EndIf
 ProcedureReturn Temp$
EndProcedure

Procedure.l ServQL_Init()
 ; Use SQLite-Database driver for file-based databases
 UseSQLiteDatabase()
 
 ; Create or open Log-File
 LogFile = OpenFile(#PB_Any, "/ServQLite.log")
 If LogFile = 0
   MessageRequester("Information", "Log-File could not be created!!")
   End
 EndIf
 
 ; Check, if Network available. If not, exit procedure
 If InitNetwork() = 0
  ServQL_Log("No network connection available.")
  ProcedureReturn #ServQL_No_Network
 EndIf

 ; create network-server. If not successul, exit procedure
 If CreateNetworkServer(0,ServQL_Port) = 0
   ProcedureReturn #ServQL_Port_Error
 EndIf

 ServQL_Log("ServQLite started on port " + Str(ServQL_Port))

EndProcedure

Procedure   ServQL_CheckClients(*Value)
 Define Zeit.l, Datenbank.l
 
 Repeat
  ForEach ServQL()
   Zeit = ServQL()\LastConnect
   Datenbank = ServQL()\DB
   If Zeit + ClientTimeOut < ElapsedMilliseconds()
    If IsDatabase(Datenbank)
     CloseDatabase(Datenbank)
    EndIf
    Debug "server said: kicking client"
    DeleteElement(ServQL())
   EndIf
  Next
  Delay(*Value) 
 ForEver 
EndProcedure

Procedure   ServQL_AddClient(ClientID)
 Define Doppelt.l
 
 ;  Doppelt = 0
;  ForEach ServQL()     
;   If ServQL()\ClientIP = GetClientIP(ClientID)  
;    SendNetworkString(ClientID, "Double-Connection For this IP. Sorry, no double... Please wait 10 minutes.")
;    Debug "double connection from IP: " + IPString(GetClientIP(ClientID))
;    Doppelt = 1
;   EndIf
;  Next
;  If Doppelt = 0
  AddElement(ServQL())
  ServQL()\ClientID    = ClientID
  ServQL()\LastConnect = ElapsedMilliseconds()
  ServQL()\ClientIP    = GetClientIP(ClientID)
  Debug "client connected: " + Str(ClientID) + " - IP: " + IPString(GetClientIP(ClientID))
;  EndIf 
EndProcedure

Procedure   ServQL_CheckQuery(ClientID)
 Define Temp$, *Buffer, Temp.l
 
 SelectElement(ServQL(), ClientID) 
 Temp = ServQL()\Richtung
 Select Temp
  Case #ServQL_Blob_Upload
   ServQL()\Blob = AllocateMemory(ServQL()\Size)
   ReceiveNetworkData(ServQL()\ClientID, ServQL()\Blob, ServQL()\Size)
   ServQL_SetDatabaseBlob(ClientID)
   FreeMemory(ServQL()\Blob)
   ServQL()\Richtung = 0
   SendNetworkString(ServQL()\ClientID, "SetDatabaseBlob°" + Str(ServQL()\Size))
  
  Default :
   *Buffer = AllocateMemory(BufferSize)
   ReceiveNetworkData(ServQL()\ClientID, *Buffer, BufferSize)
   Temp$ = PeekS(*Buffer)
   Debug "Client asked: " + Temp$
   If ServQL()\ClientID = 0
    SendNetworkString(ServQL()\ClientID, "Can't remember your ID. Please reconnect")
   Else
    ServQL()\LastConnect = ElapsedMilliseconds()   
    If ServQL_CheckString(Temp$, ClientID) = "Quit Server"
     ProcedureReturn 1
    EndIf
   EndIf
   FreeMemory(*Buffer)
  
 EndSelect
EndProcedure

Procedure   ServQL_LoadConfig()
  OpenPreferences(location$ + "ServQLite.conf")
  ServQL_Port   = ReadPreferenceLong("ServQL_Port", ServQL_Port)
  BufferSize    = ReadPreferenceLong("BufferSize", BufferSize)
  BlobSize      = ReadPreferenceLong("BlobSize", BlobSize)
  ClientTimeOut = ReadPreferenceLong("ClientTimeOut", ClientTimeOut)
  CheckTimeOut  = ReadPreferenceLong("CheckTimeOut", CheckTimeOut)
  ClosePreferences()
EndProcedure

Procedure   ServQL_SaveConfig()
  CreatePreferences(location$ + "ServQLite.conf")
  PreferenceGroup("ServQLite Settings")
  
  PreferenceComment("ServQLPort is the port, on which ServQLite offers it's services")
  WritePreferenceLong("ServQL_Port", ServQL_Port)
  
  PreferenceComment("")
  PreferenceComment("BufferSize defines, how much memory ServQLite uses for buffering")
  WritePreferenceLong("BufferSize", BufferSize)
  
  PreferenceComment("")
  PreferenceComment("BlobSize defines the maximum size of a BLOB, e.g. an image")
  WritePreferenceLong("BlobSize", BlobSize)
  
  PreferenceComment("")
  PreferenceComment("ClientTimeOut defines, how long a client will be held offline until it is being removed")
  WritePreferenceLong("ClientTimeOut", ClientTimeOut)
  
  PreferenceComment("")
  PreferenceComment("CheckTimeOut defines, how often (in seconds) online-state of clients are checked")
  WritePreferenceLong("CheckTimeOut", CheckTimeOut)
  ClosePreferences()
  Debug location$
  
EndProcedure

ServQL_LoadConfig()
If ServQL_Init() <> #ServQL_OK
 ServQL_Log("Server could not be started. Quitting!")
 Quit = 1
EndIf

CompilerIf #debug <> 0

 OpenWindow(0,0,0,0,0,"ServQLite",#PB_Window_Invisible)
 UsePNGImageDecoder()
 CatchImage(0,?Icon)
 AddSysTrayIcon(Num, WindowID(0), ImageID(ID))
 SysTrayIconToolTip(Num, ToolTip$)
 
DataSection
 Icon : IncludeBinary "icon.png"  
EndDataSection

CompilerEndIf


CreateThread(@ServQL_CheckClients(), CheckTimeOut)
Repeat
  SEvent = NetworkServerEvent()
  
CompilerIf #debug <> 0 ; Debug mode for Programming - will display the SysTray-Icon
  
  Select WaitWindowEvent(50)
    Case #PB_Event_SysTray
      If EventType() = #PB_EventType_LeftClick
        If MessageRequester("Question", "Really quit ServQLite?", #PB_MessageRequester_YesNo) = #PB_MessageRequester_Yes
          Quit = 1
        EndIf
      EndIf
  EndSelect

CompilerEndIf
   
 If SEvent
  ClientID = EventClient()
  Select SEvent
   Case #PB_NetworkEvent_Connect    : ServQL_AddClient(ClientID)         ; registrieren eines clients 
   Case #PB_NetworkEvent_Data       : Quit = ServQL_CheckQuery(FindeLinked(ClientID)) ; Anfrage eines Clients abfangen -> Threaded !?
   Case #PB_NetworkEvent_Disconnect ; Client entfernen
    ServQL_CloseDatabase(FindeLinked(ClientID))
    SelectElement(ServQL(), ClientID)
    DeleteElement(ServQL())
    Debug "client is gone"
     
  EndSelect
 EndIf
 Delay(0)   ; give everything back to the System...
Until Quit = 1

CloseNetworkServer(0)
ServQL_Log("ServQLite quit.")

[jamirokwai]

Part II - III - The PB-Include-File - ServQLite.pbi

Code: Select all

#TimeOut               = 2500 ; TimeOut für jede Anfrage ist 1000 ms
Global ServQL_BuffSize = 1000 ; Buffergröße

Global ServQL_Port     = 6832 ; Standard-Port
Global ConnectionID    = 0    ; Connection-ID
Global ServQL_Server$  = "127.0.0.1" ; ServQLite-Server-Adresse
Global DatabaseString$ = ""   ; Puffer für eine Abfrage
Global DatabaseInfo$   = ""   ; Puffer für Namen, Größe und Typ der Tabelle
Global Use_ServQLite   = 0    ; 1 = Server benutzen
Global ServerQL_Ready     = 0  ; 0 = nur Lokal, 1 = Netzwerk nicht verfügbar, nur lokal, 2 = Netzwerk verfügbar, Server kann gesucht werden
Global ServerQL_LastError = 0 ; Letzter Fehler
Global *ServerQL_BlobBuff     ; Puffer für den Blob
Global ServerQL_BlobSize = 0  ; Größe des erhaltenen Puffers

Enumeration
 #ServerQL_Lokal
 #ServerQL_Lokal_No_Network
 #ServerQL_Network
EndEnumeration

Enumeration
 #ServerQL_OK
 #ServerQL_DB_Created
 #ServerQL_DB_Exists
 #ServerQL_DB_Not_Found
 #ServerQL_DB_Opened
 #ServerQL_DB_Creation_Error
 #ServerQL_DB_Opened_Error
 #ServerQL_DB_Query_Success
 #ServerQL_DB_Query_Fault
 #ServerQL_Last_Row
 #ServerQL_First_Row
 #ServerQL_No_Network
 #ServerQL_Mem_Error
 #ServerQL_Port_Error
EndEnumeration

Procedure.s ServQL_WaitClientEvent(Connection, TimeOut = #TimeOut)
 Define *Buffer, TimeOutBeginn.l, Exit.l, CEvent.l, Temp$
 
 *Buffer       = AllocateMemory(ServQL_BuffSize)
 TimeOutBeginn = 0
 Exit          = 0
 Repeat
  TimeOutBeginn + 10
  CEvent    = NetworkClientEvent(Connection)
  If CEvent = #PB_NetworkEvent_Data
   ReceiveNetworkData(Connection, *Buffer, ServQL_BuffSize)
   Temp$ = PeekS(*Buffer)
   Debug "server said: " + Temp$
   Exit = 1
  EndIf
  If TimeOutBeginn >= TimeOut
   Debug "TIMEOUT!"
   Exit = 1
  EndIf
  Delay(10)
 Until Exit = 1
 FreeMemory(*Buffer)
 ProcedureReturn Temp$
EndProcedure

Procedure.l ServQL_Connect_Server(IP$, Port)
 Define Antwort.l

 If Use_ServQLite = 1
  Antwort = OpenNetworkConnection(IP$, Port)
  If Antwort = 0
    Use_ServQLite = 0
    UseSQLiteDatabase()
  EndIf
  ProcedureReturn Antwort
 Else
  ProcedureReturn 1
 EndIf
EndProcedure

Procedure.s ServQL_DatabaseError(Connection)
 If Use_ServQLite = 1
  SendNetworkString(Connection, "DatabaseError")
  ProcedureReturn ServQL_WaitClientEvent(Connection)
 Else
  ProcedureReturn DatabaseError()
 EndIf
EndProcedure

Procedure.l ServQL_OpenDatabase(Connection, Database$, User$, Password$, Make = 1)
 Define DBFile.l
 
 If Use_ServQLite = 1
  If Make = 1
   SendNetworkString(Connection, "CreateDatabase" + "°" + Database$ + "°" + User$ + "°" + Password$)
   ServQL_WaitClientEvent(Connection) 
  EndIf
  SendNetworkString(Connection, "OpenDatabase" + "°" + Database$ + "°" + User$ + "°" + Password$)
  ServQL_WaitClientEvent(Connection)
  ProcedureReturn Connection
 EndIf
 If Make = 1
  DBFile = ReadFile(#PB_Any,  Database$)
  If DBFile <> 0
   If IsFile(DBFile)
    CloseFile(DBFile)
   EndIf
   ServerQL_LastError = #ServerQL_DB_Exists
  Else
   DBFile = CreateFile(#PB_Any,  Database$)
   If IsFile(DBFile)
    CloseFile(DBFile)
   EndIf
   If DBFile <> 0
    ServerQL_LastError = #ServerQL_DB_Created
   Else
    ServerQL_LastError = #ServerQL_DB_Creation_Error
   EndIf  
  EndIf
  ProcedureReturn OpenDatabase(Connection, Database$, User$, Password$)
 EndIf 
EndProcedure

Procedure.l ServQL_CloseDatabase(Connection)
 If Use_ServQLite = 1
  SendNetworkString(Connection, "CloseDatabase")
  ProcedureReturn Val(ServQL_WaitClientEvent(Connection))
 Else
  ProcedureReturn CloseDatabase(Connection)
 EndIf 
EndProcedure

Procedure.l ServQL_DatabaseQuery(Connection, Request$)
 Define TemP$
 
 If Use_ServQLite = 1
  If FindString(UCase(Request$), "SELECT", 0) <> 0
   DatabaseInfo$ = ""
  EndIf
  SendNetworkString(Connection, "DatabaseQuery" + "°" + Request$)
  Temp$ = ServQL_WaitClientEvent(Connection)
  If StringField(Temp$, 2, "°") <> "0"
;    Debug temp$
   If FindString(Temp$, "Time-Out", 0)
    ProcedureReturn -1
   EndIf
   DatabaseInfo$ = Temp$
   ProcedureReturn 1
  EndIf
 Else
  ProcedureReturn DatabaseQuery(Connection, Request$)
 EndIf
EndProcedure

Procedure.s ServQL_DatabaseColumnName(Connection, Column)
 If Use_ServQLite = 1
  ProcedureReturn StringField(DatabaseInfo$, 4 + Column * 3, "°")
 Else
  ProcedureReturn DatabaseColumnName(Connection, Column)
 EndIf
EndProcedure

Procedure.l ServQL_DatabaseColumnSize(Connection, Column)
 If Use_ServQLite = 1
  ProcedureReturn Val(StringField(DatabaseInfo$, 5 + Column * 3, "°"))
 Else
  ProcedureReturn DatabaseColumnSize(Connection, Column)
 EndIf
EndProcedure

Procedure.l ServQL_DatabaseColumnType(Connection, Column)
 If Use_ServQLite = 1
  ProcedureReturn Val(StringField(DatabaseInfo$, 6 + Column * 3, "°"))
 Else
  ProcedureReturn DatabaseColumnType(Connection, Column)
 EndIf
EndProcedure

Procedure.l ServQL_DatabaseColums(Connection)
 If Use_ServQLite = 1
  ProcedureReturn Val(StringField(DatabaseInfo$, 3, "°"))
 Else
  ProcedureReturn DatabaseColumns(Connection)
 EndIf
EndProcedure

Procedure.l ServQL_NextDatabaseRow(Connection)
 Define Temp$
 
 If Use_ServQLite = 1
  DataBaseString$ = ""
  SendNetworkString(Connection, "NextDatabaseRow")
  Temp$ = ServQL_WaitClientEvent(Connection)
  If StringField(Temp$, 2, "°") <> "0"
   ProcedureReturn 1
  EndIf
 Else
  ProcedureReturn NextDatabaseRow(Connection)
 EndIf
EndProcedure

Procedure.l ServQL_PreviousDatabaseRow(Connection)
 If Use_ServQLite = 1
  DataBaseString$ = ""
  SendNetworkString(Connection, "PreviousDatabaseRow")
  ServQL_WaitClientEvent(Connection) 
 Else
  ProcedureReturn PreviousDatabaseRow(Connection)
 EndIf
EndProcedure

Procedure.l ServQL_DatabaseUpdate(Connection, Request$)
 If Use_ServQLite = 1
  SendNetworkString(Connection, "DatabaseUpdate" + "°" + Request$)
  ProcedureReturn Val(ServQL_WaitClientEvent(Connection))
 Else
  ProcedureReturn DatabaseUpdate(Connection, Request$)
 EndIf
EndProcedure

Procedure.l ServQL_CloseNetworkConnection(Connection)
 If Use_ServQLite = 1
  CloseNetworkConnection(Connection)
 EndIf
EndProcedure

Procedure.s ServQL_RefreshDatabaseString(Connection)
 If DataBaseString$ = ""
  SendNetworkString(Connection, "GetDatabaseString")
  DataBaseString$ = ServQL_WaitClientEvent(Connection)
  DataBaseString$ = Right(DataBaseString$, Len(DataBaseString$) - FindString(DataBaseString$, "°", 0))
 EndIf
 ProcedureReturn DataBasestring$
EndProcedure

Procedure.s ServQL_GetDatabaseString(Connection, Column)
 If Use_ServQLite = 1
  ProcedureReturn StringField(ServQL_RefreshDatabaseString(Connection), Column + 1, "°")
 Else
  ProcedureReturn GetDatabaseString(Connection, Column)
 EndIf
EndProcedure

Procedure.l ServQL_GetDatabaseLong(Connection, Column)
 If Use_ServQLite = 1
  ProcedureReturn Val(StringField(ServQL_RefreshDatabaseString(Connection), Column + 1, "°"))
 Else
  ProcedureReturn GetDatabaseLong(Connection, Column)
 EndIf
EndProcedure

Procedure.q ServQL_GetDatabaseQuad(Connection, Column)
 If Use_ServQLite = 1
  ProcedureReturn ValF(StringField(ServQL_RefreshDatabaseString(Connection), Column, "°"))
 Else
  ProcedureReturn GetDatabaseQuad(Connection, Column)
 EndIf
EndProcedure

Procedure.f ServQL_GetDatabaseFloat(Connection, Column)
 If Use_ServQLite = 1
  ProcedureReturn ValF(StringField(ServQL_RefreshDatabaseString(Connection), Column, "°"))
 Else
  ProcedureReturn GetDatabaseFloat(Connection, Column)
 EndIf
EndProcedure

Procedure.d ServQL_GetDatabaseDouble(Connection, Column)
 If Use_ServQLite = 1
  ProcedureReturn ValD(StringField(ServQL_RefreshDatabaseString(Connection), Column, "°"))
 Else
  ProcedureReturn GetDatabaseDouble(Connection, Column)
 EndIf
EndProcedure

Procedure.l ServQL_SetDatabaseBlob(Connection, Statementindex, *Buffer, Bufferlength)
 If Use_ServQLite = 1
  SendNetworkString(Connection, "SetDatabaseBlob°" + Str(Statementindex) + "°" + Str(Bufferlength))
  ServQL_WaitClientEvent(Connection)    ; Abfrage, ob ich schicken kann
  SendNetworkData(Connection, *Buffer, Bufferlength)
  ServQL_WaitClientEvent(Connection)    ; Abfrage, ob alles in Ordnung
 Else
  ProcedureReturn SetDatabaseBlob(Connection, Statementindex, *Buffer, Bufferlength)
 EndIf
EndProcedure

Procedure.l ServQL_GetDatabaseBlob(Connection, Column)
Define Temp$

 If Use_ServQLite = 1
  SendNetworkString(Connection, "GetDatabaseBlob°" + Str(Column))
  Temp$ = ServQL_WaitClientEvent(Connection)
  ServerQL_BlobSize = Val(StringField(Temp$, 3, "°"))
 Else
  ServerQL_BlobSize = DatabaseColumnSize(Connection, Column)
 EndIf

 If *ServerQL_BlobBuff <> 0
  FreeMemory(*ServerQL_BlobBuff)
 EndIf
 *ServerQL_BlobBuff = AllocateMemory(ServerQL_BlobSize)
 
 If Use_ServQLite = 1
  SendNetworkString(Connection, "GetDatabaseBlobRec") 
  ReceiveNetworkData(Connection, *ServerQL_BlobBuff, ServerQL_BlobSize)
 Else
   GetDatabaseBlob(Connection, Column, *ServerQL_BlobBuff, ServerQL_BlobSize)
  ProcedureReturn 1
 EndIf
EndProcedure
 
Procedure.l ServQL_FinishDatabaseQuery(Connection)
 If Use_ServQLite = 1
  SendNetworkString(Connection, "FinishDatabaseQuery")
  ProcedureReturn Val(ServQL_WaitClientEvent(Connection)) 
 Else
  ProcedureReturn FinishDatabaseQuery(Connection)
 EndIf
EndProcedure

Procedure.l ServQL_Quit_Server(Connection)
 If Use_ServQLite = 1
  SendNetworkString(Connection, "Quit Server")
  ServQL_WaitClientEvent(Connection)
 EndIf
EndProcedure

[jamirokwai]

Part III - III - A Test-Client - ServQLite-Test.pb

Code: Select all

XIncludeFile "ServQLite.pbi"

If InitNetwork() = 0
 ServerQL_Ready =  #ServerQL_Lokal_No_Network
Else
 ServerQL_Ready =  #ServerQL_Network
EndIf

use_servqlite = 1

ConnectionID = ServQL_Connect_Server(ServQL_Server$, ServQL_Port)
ServQL_OpenDatabase(ConnectionID, "test.sqlite", "", "")

If ConnectionID = 0
  MessageRequester("Error", "Can't connect to Server")
  End
EndIf

ServQL_DatabaseUpdate(ConnectionID, "CREATE TABLE food (name CHAR(50), amount INT)")
ServQL_DatabaseUpdate(ConnectionID, "INSERT INTO food (name, amount) VALUES ('apple', '10')")
ServQL_DatabaseUpdate(ConnectionID, "INSERT INTO food (name, amount) VALUES ('pear', '5')")
ServQL_DatabaseUpdate(ConnectionID, "INSERT INTO food (name, amount) VALUES ('banana', '20')")
ServQL_DatabaseUpdate(ConnectionID, "INSERT INTO food (name, amount) VALUES ('coconuts', '3')")

MessageRequester("Info", "Created a table food with 10 apples, 5 pears, 20 bananas, 3 coconuts")

ServQL_DatabaseUpdate(ConnectionID, "UPDATE food SET amount = '12' WHERE name = 'coconuts'")
ServQL_DatabaseUpdate(ConnectionID, "DELETE FROM food WHERE name = 'banana'")

If ServQL_DatabaseQuery(ConnectionID, "SELECT * FROM food WHERE amount > 7") = -1
 Debug "you've been kicked"
EndIf

MessageRequester("Info", "Added 9 coconuts to a total of 12 and remove the whole bananas.")

x$ = "We looked for food of more than 7 pieces each..." + #CR$ + "There is/are "
While ServQL_NextDatabaseRow(ConnectionID)
 x$ + Str(ServQL_GetDatabaseLong(ConnectionID, 1)) + " "
 x$ + ServQL_GetDatabaseString(ConnectionID, 0) + "(s) and "
Wend
x$ + " that's it..."

MessageRequester("Info", x$)

ServQL_FinishDatabaseQuery(ConnectionID)

ServQL_Quit_Server(ConnectionID)
ServQL_CloseNetworkConnection(ConnectionID)

[quasiperfect]

any updates on this ?

[jamirokwai]

any updates on this ?

No. Didn't have the time. My customers are exhausting ...
But go on, help yourself. It's free to adopt, and edit!