PureBasic Forums - English

Posted: **Wed Feb 24, 2010 9:54 pm**

I use this server (a version of this server) for my POS system. I have truncated it for an example here but I have commented the code so you can hopefully see what I do and how I handle SQL query strings recieved by said server.

I have been planning to redo using MAP now that it is available in 4.41 but I am still learning about that.

I use a 6 (OK I use a 9) character DIRECTOR tag at the beginning of each SQL query sent to my server... This is CUT OFF once it is recognized and then the actual query is sent to a procedure to deal with it.

So far have had no rea issues with up to 12 Clients querying a celeron 1000 server running Win2k... NOT win2K Server just win2k and my server program.

Code: Select all


; Server
; (c) 2010 by Ralph Dunn, Rook Zimbabwe and Blue Mesa Software
; Updated 19 FEB 2010 PB v4.41
; *******************************************************
Enumeration
  #Window_0
EndEnumeration

Enumeration
  #String_INPUT
  #Button_SEND
  #Button_EOD
  #Text_1
  #Text_SERVADDRESS
  #Listview_TEXT
  #Listview_ACTIVITY
  #Server
  #Font1
  #Database
EndEnumeration

;- DATABASE CRAP
; ****** EXTREME HELP FROM ABBKlaus here!

#ODBC_ADD_DSN                       =   1 ; Add Data source
#ODBC_ADD_SYS_DSN                   =   4 ; Add SYSTEM Data source
#ODBC_CONFIG_DSN                    =   2 ; Configure (edit) Data source
#ODBC_REMOVE_DSN                    =   3 ; Remove Data source
#ODBC_REMOVE_SYS_DSN                =   6 ; Remove SYSTEM Data source
#SQL_SUCCESS                        =   0
#SQL_SUCCESS_WITH_INFO              =   1
#SQL_ERROR                          =  -1
#SQL_INVALID_HANDLE                 =  -2
#SQL_NO_DATA                        = 100
#SQL_MAX_MESSAGE_LENGTH             = 512
#SQL_NTS                            =  -3
#SQL_HANDLE_ENV                     =   1;?
#SQL_HANDLE_DBC                     =   2;?
#SQL_HANDLE_STMT                    =   3
#SQL_HANDLE_DESC                    =   4;?
#SQL_C_CHAR                         =   1
#ODBC_ERROR_GENERAL_ERR             =   1
#ODBC_ERROR_INVALID_BUFF_LEN        =   2
#ODBC_ERROR_INVALID_HWND            =   3
#ODBC_ERROR_INVALID_STR             =   4
#ODBC_ERROR_INVALID_REQUEST_TYPE    =   5
#ODBC_ERROR_COMPONENT_NOT_FOUND     =   6
#ODBC_ERROR_INVALID_NAME            =   7
#ODBC_ERROR_INVALID_KEYWORD_VALUE   =   8
#ODBC_ERROR_INVALID_DSN             =   9
#ODBC_ERROR_INVALID_INF             =  10
#ODBC_ERROR_REQUEST_FAILED          =  11
#ODBC_ERROR_INVALID_PATH            =  12
#ODBC_ERROR_LOAD_LIB_FAILED         =  13
#ODBC_ERROR_INVALID_PARAM_SEQUENCE  =  14
#ODBC_ERROR_INVALID_LOG_FILE        =  15
#ODBC_ERROR_USER_CANCELED           =  16
#ODBC_ERROR_USAGE_UPDATE_FAILED     =  17
#ODBC_ERROR_CREATE_DSN_FAILED       =  18
#ODBC_ERROR_WRITING_SYSINFO_FAILED  =  19
#ODBC_ERROR_REMOVE_DSN_FAILED       =  20
#ODBC_ERROR_OUT_OF_MEM              =  21
#ODBC_ERROR_OUTPUT_STRING_TRUNCATED =  22

;- DB INFO

Define Result

Dim DatabaseType.s(4)
DatabaseType(0) = "Unknown"
DatabaseType(1) = "Numeric"
DatabaseType(2) = "String"
DatabaseType(3) = "Float"

;- *** DECLARES ***
Declare AddConnection(Driver.s,ConnectString.s)
Declare RemoveConnection(Driver.s,DSN.s)
Declare ClearMemory() ;(*memory.b, length.l)

Structure VisualDesignerGadgets
  Gadget.l
  EventFunction.l
EndStructure

Global ClientID.l
Global NewList EventProcedures.VisualDesignerGadgets()
Global FontID1
FontID1 = LoadFont(#Font1, "Courier", 9)
Global String$
Global buffet
Global query$
Global methodnumber$

Global *bufferS = AllocateMemory(4800)

;- *** MACROS
Macro SQL_HANDLE_ENV(Database)
PeekL(PeekL(IsDatabase(Database))-4)
EndMacro

Macro SQL_HANDLE_STMT(Database)
PeekL(PeekL(IsDatabase(Database)+4)+4)
EndMacro

Macro SQL_HANDLE_DBC(Database)
PeekL(PeekL(IsDatabase(Database)+4))
EndMacro

;- *** PROCEEDURES
Procedure.s GetSQLMessages(Database)
  lResult.w
  SQLState.s = Space(5)
  NativeErrorPtr.l
  MessageText.s = ""
  BufferLength.l = 10000
  TextLengthPtr.l
  DiagInfoPtr.l = -1
  Index.l=1
  Result.s=""
  Repeat
    res.w=SQLGetDiagRec_(3, SQL_HANDLE_STMT(Database), Index, @SQLState, @NativeErrorPtr, @MessageText, 0, @TextLengthPtr)
    If res=1
      MessageText.s = Space(TextLengthPtr)
      res.w=SQLGetDiagRec_(3, SQL_HANDLE_STMT(Database), Index, @SQLState, @NativeErrorPtr, @MessageText, BufferLength, @TextLengthPtr)
      If res=0
        Result+SQLState+"|"+MessageText
        ; Debug SQLState+"|"+MessageText
        Index+1
      Else
        Break
      EndIf
    Else
      Break
    EndIf
    ForEver
    
    ProcedureReturn Result
  EndProcedure
  
  Procedure.l MakeKeywordValuePairs(Attributes$)
    
    While Right(Attributes$,2)<>";;"
      Attributes$+";"
    Wend
    
    ; Allocate enough memory in both Ascii and Unicode mode + space for the terminating zero character
    *LPAttribMem=AllocateMemory(Len(Attributes$)*SizeOf(character)+SizeOf(character))
    
    ; Copy string to memory
    PokeS(*LPAttribMem,Attributes$,Len(Attributes$))
    
    ; Replace each ';' with zero character
    For L=1 To Len(Attributes$)
      CompilerIf #PB_Compiler_Unicode
        If PeekW(*LPAttribMem + (l-1) * SizeOf(character))=Asc(";")
          PokeW(*LPAttribMem + (l-1) * SizeOf(character),0)
        EndIf
      CompilerElse
        If PeekB(*LPAttribMem + l -1)=Asc(";")
          PokeB(*LPAttribMem + l -1,0)
        EndIf
      CompilerEndIf
    Next
    
    ProcedureReturn *LPAttribMem
  EndProcedure
  
  Procedure.b MakeConnection(Driver$,Attributes$)
    *KVPBuffer=MakeKeywordValuePairs(Attributes$)
    Result=SQLConfigDataSource_(0,#ODBC_ADD_DSN,Driver$,*KVPBuffer)
    ; Debug Result
    FreeMemory(*KVPBuffer)
    ProcedureReturn Result
  EndProcedure
  
  Procedure.b DeleteConnection(Driver$,DSN$)
    DSN$="DSN="+DSN$
    
    *KVPBuffer=MakeKeywordValuePairs(DSN$)
    
    Result=SQLConfigDataSource_(0,#ODBC_REMOVE_DSN,@Driver$,*KVPBuffer)
    
    FreeMemory(*KVPBuffer)
    
    ProcedureReturn Result
  EndProcedure
  
  Procedure.l GetDatabaseTables(Database)
    SQLCancel_(SQL_HANDLE_STMT(Database))
    res.w=SQLTables_(SQL_HANDLE_STMT(Database),0,0,0,0,0,0,0,0)
    If res = 0 Or res = 1 ; #SQL_SUCCESS / #SQL_SUCCESS_WITH_INFO
      ProcedureReturn 1
    EndIf
  EndProcedure
  
  Procedure.l GetDatabaseDBNames(Database)
    SQLCancel_(SQL_HANDLE_STMT(Database))
    res.w=SQLTables_(SQL_HANDLE_STMT(Database),"%",-3,"",-3,"",-3,"",-3)
    If res = 0 Or res = 1 ; #SQL_SUCCESS / #SQL_SUCCESS_WITH_INFO
      ProcedureReturn 1
    EndIf
  EndProcedure
  
  Procedure.l GetDatabaseTables2(Database,Catalogname.s="%",SchemaName.s="",TableName.s="",TableType.s="")
    SQLCancel_(SQL_HANDLE_STMT(Database))
    If Catalogname="%" And SchemaName="" And TableName=""
      ; Debug "DBNames"
      res.w=SQLTables_(SQL_HANDLE_STMT(Database),Catalogname,-3,"",-3,"",-3,"",-3)
    ElseIf SchemaName="%" And Catalogname="" And TableName=""
      ; Debug "Schemaname"
      res.w=SQLTables_(SQL_HANDLE_STMT(Database),0,0,0,0,0,0,0,0)
    Else
      ; Debug "Rest"
      res.w=SQLTables_(SQL_HANDLE_STMT(Database),Catalogname,-3,SchemaName,-3,TableName,-3,TableType,-3)
    EndIf
    If res = 0 Or res = 1 ; #SQL_SUCCESS / #SQL_SUCCESS_WITH_INFO
      ProcedureReturn 1
    EndIf
  EndProcedure
  ;-
  Procedure VoidItem(query$)
    ; Debug "UPDATING TICKET"
    For k=1 To CountString(query$, Chr(182))
      ; Debug k
      tmp$ = StringField(query$, k, Chr(182))
      m = Len(tmp$)
      tmp$ = Right(tmp$,m-6)
      ; Debug "TMP$: "+tmp$
      AddGadgetItem(#Listview_TEXT, - 1, "UPDATE: "+tmp$)
      result = DatabaseQuery(#Database, tmp$) ;
      Error$ = DatabaseError()
      If Error$ >""
        AddGadgetItem(#Listview_TEXT,-1,   "DB ERROR: "+Error$)
        ; Debug "QUERY: "+query$
        ; Debug "DB ERROR: "+Error$
      EndIf
    Next
  EndProcedure
  
  Procedure DBQuery(query$,ClientID)
    
    DatabaseQuery(#Database, query$) ;
    Error$ = DatabaseError()
    If Error$ >""
      AddGadgetItem(#Listview_TEXT,-1,"QUERY ERROR: "+Error$)
    EndIf
    While NextDatabaseRow(#Database)
      ; *** Now while we have a valid query we will need
      ; *** to reset these to match OUR values we want to read...
      ; *** I have found that even if you don't really expect to use data from a column it is better to read it and throw it away
      checknumber$=GetDatabaseString(#Database, 0) ; was 0
      serverID$ = GetDatabaseString(#Database, 1) ; 1
      Table$ = GetDatabaseString(#Database, 2) ; 2
      opened$ = GetDatabaseString(#Database, 3)
      client$ = Str(ClientID)
      AddGadgetItem(#Listview_TEXT, -1, "DB QUERY RESULT: "+client$+" : "+checknumber$+", "+serverid$+", "+table$+", "+TIMER$)
      goof$ = "OPTIKS"+checknumber$+Chr(167)+serverid$+Chr(167)+table$+Chr(167)+TIMER$+Chr(182) ; was chr(0)
      SendNetworkString(ClientID, goof$)
    Wend
    FinishDatabaseQuery(#Database)
    clearmemory() 
    
  EndProcedure
  
  ;-
  
  Procedure UpdateList()
    ; was using this to attempt to FORCE the listicon gadgets to the bottom of the list
    ; has NOT worked well yet!
    Result = CountGadgetItems(#Listview_TEXT)
    SetGadgetState(#Listview_TEXT,Result)
    SetGadgetItemState(#Listview_TEXT, Result, #PB_ListIcon_Selected)
    
    Result1 = CountGadgetItems(#Listview_ACTIVITY)
    SetGadgetItemState(#Listview_Activity, Result1, #PB_ListIcon_Selected)
    
  EndProcedure
  
  Procedure ClearMemory() ;(buf,size) ; from tinman
    
    fillmemory_(*bufferS , 4799 , 0)
    
  EndProcedure
  
  Procedure String_INPUT_Event(Window, Event, Gadget, Type)
    ; Debug "#String_INPUT"
  EndProcedure
  
  Procedure Button_SEND_Event(Window, Event, Gadget, Type)
    String$ = GetGadgetText(#String_INPUT) ; to enter something to send
    SendNetworkData(ClientID, @String$, Len(String$))
    SetGadgetText(#String_INPUT, "") ; clear the text from memory
    AddGadgetItem(#Listview_TEXT, -1,"YOU: "+String$) ; throw the text in the window
    String$ = ""
    SetActiveGadget(#String_INPUT) ; reset the input string
    ClearMemory() ; (*bufferS,48000)
    
  EndProcedure
  
  Procedure Button_EOD_Event(Window, Event, Gadget, Type)
    ; *** save checknumber in cfg file
    ticketnumber = ticketnumber + 15
    OpenPreferences("Server.pref")
    PreferenceGroup("GLOBAL")
    WritePreferenceLong("SEL0", ticketnumber)
    ClosePreferences()
    Goto Zork
  EndProcedure
    
  Procedure Listview_TEXT_Event(Window, Event, Gadget, Type)
    Result = GetGadgetState(#Listview_TEXT)
    msg$ = GetGadgetItemText(#ListView_TEXT, Result)
    MessageRequester("WHATSIT", msg$)
  EndProcedure
  
  Procedure Listview_ACTIVITY_Event(Window, Event, Gadget, Type)
    Result = GetGadgetState(#Listview_ACTIVITY)
    msg$ = GetGadgetItemText(#ListView_ACTIVITY, Result)
    MessageRequester("WHATSIT", msg$)
  EndProcedure
  ;-
  Procedure RegisterGadgetEvent(Gadget, *Function)
    
    If IsGadget(Gadget)
      AddElement(EventProcedures())
      EventProcedures()\Gadget        = Gadget
      EventProcedures()\EventFunction = *Function
    EndIf
    
  EndProcedure
  
  Procedure CallEventFunction(Window, Event, Gadget, Type)
    
    ForEach EventProcedures()
      If EventProcedures()\Gadget = Gadget
        CallFunctionFast(EventProcedures()\EventFunction, Window, Event, Gadget, Type)
        LastElement(EventProcedures())
      EndIf
    Next
    
  EndProcedure
  ;-
  Procedure Open_Window_0()
    
    If OpenWindow(#Window_0, 99, 332, 510, 380, "BLUE MESA SQL SERVER 5.1 - HORNY GOAT BEWERY VERSION",  #PB_Window_TitleBar | #PB_Window_ScreenCentered )
      ;If CreateGadgetList(WindowID(#Window_0))
      ListViewGadget(#Listview_ACTIVITY, 324, 42, 174, 246, #PB_ListIcon_AlwaysShowSelection)
      SetGadgetFont(#Listview_ACTIVITY, FontID1)
      RegisterGadgetEvent(#Listview_ACTIVITY, @Listview_ACTIVITY_Event())
      ListViewGadget(#Listview_TEXT, 6, 42, 312, 246, #PB_ListIcon_AlwaysShowSelection)
      RegisterGadgetEvent(#Listview_TEXT, @Listview_TEXT_Event())
      
      TextGadget(#Text_SERVADDRESS, 130, 12, 140, 18, "000.000.000.000", #PB_Text_Center) ; 6, 12, 120, 18

      TextGadget(#Text_1, 20, 12, 120, 18, "SERVER ADDRESS ::") ; 132, 12, 132, 18
      ButtonGadget(#Button_SEND, 6, 336, 312, 36, "SEND")
      RegisterGadgetEvent(#Button_SEND, @Button_SEND_Event())
      StringGadget(#String_INPUT, 6, 294, 312, 42, "")
      RegisterGadgetEvent(#String_INPUT, @String_INPUT_Event())
      ButtonGadget(#Button_EOD, 324, 294, 174, 42, "Run EOD on SERVER"+ Chr(10) +"And SHUT DOWN", #PB_Button_MultiLine)
      RegisterGadgetEvent(#Button_EOD, @Button_EOD_Event())
      ; EndIf
    EndIf
  EndProcedure
  
  UseODBCDatabase()
  
  Open_Window_0()
  
  ;**********
  Driver$="Microsoft Access Driver (*.mdb)"
  DSN$="DB-USER" ; "DB-Test"
  File$=GetCurrentDirectory()+"TICKET.mdb" ; C:\Program Files\Blue Mesa Software\BMSERVER
  ; Debug File$
  Attrib$="DSN="+DSN$+";DBQ="+File$
  If MakeConnection(Driver$,Attrib$)
    ; Debug "MakeConnection ok"
    If OpenDatabase(#Database,"DB-USER","","") ;"DB-Test","","") ;"Admin","")
      AddGadgetItem(#Listview_ACTIVITY,-1,"TICKET DB OPENED")
    EndIf
  EndIf
   
  InitNetwork()
  If ExamineIPAddresses()
    IP.l = NextIPAddress()
  EndIf
  
  CreateNetworkServer(#Server, 6654)
  
  ; *** OPEN PREF FILE FOR SERVER
  
  methodnumber$ = "0"
  
  AddGadgetItem(#Listview_ACTIVITY,-1,"Server Online")
  AddGadgetItem(#Listview_ACTIVITY,-1,"IP: (" + IPString(IP) + ")")
  SetGadgetText(#Text_SERVADDRESS, ""+IPString(IP))
  SetActiveGadget(#String_INPUT) ; reset the input string
  
  Repeat
    Event  = WaitWindowEvent(18)
    Gadget = EventGadget()
    Type   = EventType()
    Window = EventWindow()
    
    Select Event
    Case #PB_Event_Gadget
      CallEventFunction(Window, Event, Gadget, Type)
    EndSelect
    
    If NetworkServerEvent() = 1
    ; ************** SOMEONE HAS LOGGED ON
    ; *** I could go fancy and have a BLOCK LIST here but that might get tangled in a DOS attack in any instance
      AddGadgetItem(#Listview_ACTIVITY,-1,"A new connection")
      ClientID.l = EventClient()
      IP = GetClientIP(ClientID)
      Cl$ = IPString(IP)
      AddGadgetItem(#Listview_ACTIVITY,-1,"CLIENT: "+Cl$)
      
    EndIf
    
    If NetworkServerEvent() = 2
    ; ************************ A STRING HAS BEEN SENT TO PLAY WITH
    ; *** I use encoding... so if the query string does not start with a certain 6 number or 6 character reference 
    ; *** which I chop OFF beofre sending to the correct function
    ; *** it should die here
      ;ClearMemory() ;(*bufferS,48000)
      length.l = ReceiveNetworkData(ClientID, *bufferS, 48000) ; with what I am sednding 48000 is a HUGE amount
      String$ = PeekS(*bufferS, 48000)
      AddGadgetItem(#Listview_TEXT, -1,"THEM: "+String$) ; did this to check what coming in
      UpdateList() ; so you can click on the lit and see entire string
      command$ = Left(String$,6) ; *** cut off first 6 characters
      Select command$ ; use them to decide what to do and where to send query
      Case "QUERYI"
        long = Len(String$)
        query$ = Right(String$,long-6)
        DBQuery(query$, ClientID)
        ClearMemory() ;(*bufferS,48000)
        UpdateList()
      ;Case "INSOM9"
        ;long = Len(String$)
        ;query$ = Right(String$,long-6)
        ;DBQuery2(query$, ClientID)
        ;ClearMemory() ;(*bufferS,48000)
        ;UpdateList()
      EndSelect
    EndIf
    
  Until Event = #PB_Event_CloseWindow
  
  Zork:

    CloseDatabase(#Database)
  ClearMemory()
  DeleteConnection("Microsoft Access Driver (*.mdb)","MyDSN")
  
  End

If you wan to use this please feel free but I expect a credit to Blue Mesa Software in your program credits and ON SCREEN as well!

Posted: **Thu Feb 25, 2010 12:29 am**

Very Nice Rook, Thank You

Posted: **Thu Feb 25, 2010 8:29 pm**

Thank y'all for your kind words... I wish we had a Scrolling Codebox feature on the forums so it would be a shorter drop to the comments

Posted: **Fri Feb 26, 2010 2:13 am**

OK I am an idiot. What I forgot to tell you is HOW the SQL $ looks as it is SENT to the server (or BACK to the client)

query$ = "QUERYIINSERT INTO DAYTICKET ([CHECKNUMBER], [SERVERID], [TABLE], [ITEM]) VALUES ('" + ticketnumber$ + "', '" + eID$ + "', '" + tablenumber$ + "', '" + item$ + "');" ; ***

And the initial "QUERYI" is cropped off before it is sent to the procedure.

PureBasic Forums - English

Tiny Server

Tiny Server

Re: Tiny Server

Re: Tiny Server

Re: Tiny Server