Als Basis für den Datenaustausch über Netzwerk verwende ich das Modul NetworkData und muss hier geladen werden
Um beim Client die GUI aus Threads zu aktualisieren benötigen wir noch das Modul ThreadToGUIModul_NetworkData.pb Link: http://www.purebasic.fr/english/viewtop ... 12&t=66075
Kurze Erläuterung:Modul_ThreadToGUI.pb Link: http://www.purebasic.fr/english/viewtop ... 12&t=66180
Mit SendString wird direkt das SQL-Command zum Server gesendet. Mit DataID (DatabaseID) können verschiedene Datenbanken angesprochen werden.
Der Server antwortet bei einen Query der Datenbank mit den gesamten Ergebnis in einer LinkedList im Textformat und einen String, Integer mit der Anzahl der Abfrage.
Bei ein Update antwortet der Server mit einen String und Integer.
Ist nur mal schnell zusammengebastelt. Ich denke aber ausbaufähig.
SQLServer.pb
Code: Alles auswählen
;-TOP
; NetworkData SQLite Server v0.1
Enumeration ;Window
#Main
EndEnumeration
Enumeration ; Menu
#Menu
EndEnumeration
Enumeration ; MenuItems
#MenuExit
EndEnumeration
Enumeration ; Gadgets
#List
EndEnumeration
Enumeration ; Statusbar
#Status
EndEnumeration
; Global Variable
Global exit
IncludeFile "Modul_NetworkData.pb"
; ***************************************************************************************
UseModule NetworkData
#DatabaseMax = 100
Global DatabaseFolder.s = GetHomeDirectory()
Global DatabaseFile.s = "Database_"
UseSQLiteDatabase()
; ---------------------------------------------------------------------------------------
Macro AddTextElement(MyList, Text)
AddElement(MyList) : MyList = Text
EndMacro
; ---------------------------------------------------------------------------------------
Procedure SQL_InitDatabase(DatabaseID)
Protected fileDB.s, filePB, result
If DatabaseID > #DatabaseMax
ProcedureReturn 0
EndIf
fileDB = DatabaseFolder + DatabaseFile + DatabaseID + ".db"
If FileSize(fileDB) < 0
filePB = CreateFile(#PB_Any, fileDB)
If filePB
CloseFile(filePB)
EndIf
EndIf
result = OpenDatabase(DatabaseID, fileDB, "", "")
ProcedureReturn result
EndProcedure
; ---------------------------------------------------------------------------------------
Procedure SQL_CloseDatabase(DatabaseID)
If IsDatabase(DatabaseID)
CloseDatabase(DatabaseID)
EndIf
EndProcedure
; ---------------------------------------------------------------------------------------
Procedure SQL_Query(*pData.udtDataSet)
Protected r1, index, columns, count, text.s
Protected NewList Result.s()
Repeat
With *pData
If Not IsDatabase(\DataID)
If Not SQL_InitDatabase(\DataID)
SendString(\ConnectionID, \DataID, "Error: Open Database")
SendInteger(\ConnectionID, \DataID, -1)
Break
EndIf
EndIf
r1 = DatabaseQuery(\DataID, \String)
If r1
columns = DatabaseColumns(\DataID) - 1
text = ""
For index = 0 To columns
text + DatabaseColumnName(\DataID, index) + #TAB$
Next
text = RTrim(text, #TAB$)
AddTextElement(Result(), text)
While NextDatabaseRow(\DataID)
count + 1
text = ""
For index = 0 To columns
text + GetDatabaseString(\DataID, index) + #TAB$
Next
AddTextElement(Result(), text)
Wend
FinishDatabaseQuery(\DataID)
SendList(\ConnectionID, \DataID, Result())
SendString(\ConnectionID, \DataID, "Count: " + count)
SendInteger(\ConnectionID, \DataID, count)
Break
Else
SendString(\ConnectionID, \DataID, DatabaseError())
SendInteger(\ConnectionID, \DataID, - 2)
Break
EndIf
EndWith
ForEver
EndProcedure
; ---------------------------------------------------------------------------------------
Procedure SQL_Update(*pdata.udtDataSet)
Protected r1, rows
Repeat
With *pData
If Not IsDatabase(\DataID)
If Not SQL_InitDatabase(\DataID)
SendString(\ConnectionID, \DataID, "Error: Open Database")
SendInteger(\ConnectionID, \DataID, -1)
Break
EndIf
EndIf
r1 = DatabaseUpdate(\DataID, \String)
If r1
rows = AffectedDatabaseRows(\DataID)
SendString(\ConnectionID, \DataID, "Affected Rows: " + rows)
SendInteger(\ConnectionID, \DataID, rows)
Break
Else
SendString(\ConnectionID, \DataID, DatabaseError())
SendInteger(\ConnectionID, \DataID, - 2)
Break
EndIf
EndWith
ForEver
EndProcedure
; ---------------------------------------------------------------------------------------
Procedure SQL_IsQuery(sql.s)
Protected r1, lSql.s
lSql = LCase(sql)
r1 = FindString(lSql, "select")
If r1 > 0 And r1 < 20
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
; ---------------------------------------------------------------------------------------
; ---------------------------------------------------------------------------------------
UnuseModule NetworkData
; ***************************************************************************************
; NewData Callback
Procedure NewData(SEvent, ConnectionID, *NewData.NetworkData::udtDataset)
UseModule NetworkData
Static online
Protected ip.s, result.s, index
If SEvent = #PB_NetworkEvent_Connect
online + 1
ip = IPString(GetClientIP(ConnectionID))
Logging("Callback: Client connected: IP " + ip)
ProcedureReturn 0
ElseIf SEvent = #PB_NetworkEvent_Disconnect
If online > 0
online - 1
If online = 0
For index = 0 To #DatabaseMax
SQL_CloseDatabase(index)
Next
EndIf
EndIf
Logging("Callback: Client disconnected ID " + Str(ConnectionID))
ProcedureReturn 0
ElseIf SEvent = #PB_NetworkEvent_Data
With *NewData
ip = IPString(GetClientIP(ConnectionID))
Logging("Callback: New data from ID " + Str(ConnectionID) + " (" + ip + "): DataID " + Str(\DataID))
Select \Type
Case #NetInteger
Case #NetString
If SQL_IsQuery(\String)
SQL_Query(*NewData)
Else
SQL_Update(*NewData)
EndIf
Case #NetData
Case #NetList
Case #NetFile
EndSelect
ProcedureReturn 0
EndWith
EndIf
UnuseModule NetworkData
EndProcedure
Procedure UpdateWindow()
Protected x, y, dx, dy, menu, status
menu = MenuHeight()
If IsStatusBar(#Status)
status = StatusBarHeight(#Status)
Else
status = 0
EndIf
x = 0
y = 0
dx = WindowWidth(#Main)
dy = WindowHeight(#Main) - menu - status
ResizeGadget(#List, x, y, dx, dy)
EndProcedure
; Main
Procedure Main()
Protected event, style, dx, dy
style = #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget
dx = 640
dy = 480
If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, dx, dy, "SQLite Server v0.1", style)
; Enable Fullscreen
CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
Protected NewCollectionBehaviour
NewCollectionBehaviour = CocoaMessage(0, WindowID(#Main), "collectionBehavior") | $80
CocoaMessage(0, WindowID(#Main), "setCollectionBehavior:", NewCollectionBehaviour)
CompilerEndIf
; Menu
CreateMenu(#Menu, WindowID(#Main))
MenuTitle("Common")
MenuItem(#MenuExit, "E&xit")
; Gadgets
ListViewGadget(#List, 0, 0, dx, dy)
; Statusbar
CreateStatusBar(#Status, WindowID(#Main))
AddStatusBarField(#PB_Ignore)
UpdateWindow()
NetworkData::BindLogging(#PB_Event_FirstCustomValue, #List)
ServerID = NetworkData::InitServer(6037, @NewData())
NetworkData::SetDataFolder(GetHomeDirectory())
; Main Loop
Repeat
event = WaitWindowEvent(10)
Select event
Case #PB_Event_Menu
Select EventMenu()
CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
Case #PB_Menu_About
Case #PB_Menu_Preferences
Case #PB_Menu_Quit
NetworkData::CloseServer(ServerID)
exit = #True
CompilerEndIf
Case #MenuExit
NetworkData::CloseServer(ServerID)
exit = #True
EndSelect
Case #PB_Event_Gadget
Select EventGadget()
Case #List
EndSelect
Case #PB_Event_SizeWindow
Select EventWindow()
Case #Main
UpdateWindow()
EndSelect
Case #PB_Event_CloseWindow
Select EventWindow()
Case #Main
NetworkData::CloseServer(ServerID)
exit = #True
EndSelect
EndSelect
Until exit
EndIf
EndProcedure : Main()
End