Cancel database connection attempt...

[srod]

Hi,

I've just hacked up a little utility which might prove useful for someone.

Basically, my Pyrex report designer may sometimes be called upon at the drop of a hat to connect to various remote data-sources and this can sometimes be a lengthy process if, for example, a remote server is a bit sluggish to respond or is simply off-line (in which case Pyrex has to await the necessary time-outs etc.)

Wishing, therefore, in cases where the connection attempt took more than a specified amount of time, to throw up a simple dialog showing the attempted connection in progress and giving the user the option of aborting the attempt, led inexorably towards using separate threads. The only way I can see of allowing the user to abort a connection attempt without having to continue to await the timeouts is to put the attempted connection itself into a separate thread.

The following code does exactly this. Supports all databases offered by PB (SQLite, PostgreSQL and ODBC) and also supports ADO through my ADOmate library. All you do with this little utility is set-up the necessary connection parameters and then call the tBase_OpenDatabase() function. This will create a separate thread to deal with the connection in its entirety. Whilst the connection attempt is underway, the tBase_OpenDatabase() function will throw up a simple dialog if the attempt takes more than a specified amount of time. The dialog allows the user to abort the connection.

If the connection fails (or is cancelled) then the thread is allowed to terminate (KillThread() is not used). In the meantime of course control is returned immediately to whichever routine invoked the tBase_OpenDatabase() function.

If the connection succeeds, then the thread remains and is put to sleep whilst it awaits further instructions.

All database functions related to the connection (e.g. issuing a query) is then undertaken by the thread because it is not a good idea to share database/connection handles between a thread and the main process. It works fine for SQLite and PostgreSQL, but for ADO it does not. True, ADO is 'threadsafe' in that it bypasses the COM threaded model and uses a free-threading model. But the fact is that some providers do not function correctly if passing connection handles between multiple threads. I suspect the same to be true of certain ODBC drivers.

It was just simpler to shove the whole lot into the separate thread and not have to worry about moving connection handles between threads etc.

The utility currently supports only the database functions which I specifically require for my own needs and so, for example, there is no DatabaseUpdate() method. Such things would be very easy to add however. I'll probably add these methods sooner rather than later. It does allow you to list all the tables within a connection, however, and this works for SQLite, ODBC, ADO and PostgreSQL.

I'll post a couple of examples in some separate postings in this thread.

Requires my ADOmate library (see the nxSoftware site).

Code: Select all

CompilerIf Defined(INCLUDE_TBASE, #PB_Constant)=0
#INCLUDE_TBASE=1
;/////////////////////////////////////////////////////////////////////////////////
;tBase 1.0.
;==========
;By Stephen Rodriguez.
;August 2010.

;Developed with Purebasic 4.51.
;Windows only.
;
;An OOP class giving threaded access to SQLite, ODBC, ADO and PostgreSQL databases.
;This allows, for example, to display a progress bar when attempting to connect to a remote database and allows the user
;to abort the connection before a timeout expires, which is exactly what the tBase_OpenDatabase() does.
;
;ADO is particularly problematic when dealing with threaded access to OLE-DB providers. 
;Creating an ADO connection in one thread and then using the connection from another thread to, for example, populate a recordset is
;very hit and miss. In principle, ADO supports this (via a free threading model), but it is dependent on the underlying provider.
;For this reason, tBase creates a separate thread for each connection and all subsequent database operations are undertaken by the appropriate thread.
;This way, there is no problem with passing COM objects (ADO) between threads for example.
;/////////////////////////////////////////////////////////////////////////////////

;/////////////////////////////////////////////////////////////////////////////////
;-REQUIREMENTS.
;
; tBase requires my ADOmate library (see the nxSoftware site for the download).
;/////////////////////////////////////////////////////////////////////////////////

;/////////////////////////////////////////////////////////////////////////////////
;-NOTES.
;
;   i)    All clients should enable the threadsafe switch.
;
;   ii)   tBase monitors the initial connection attempt only, allowing the user to cancel the attempt etc.
;         Subsequent queries are not monitored for timeouts and will just expire as per normal.
;
;   iii)  Use the tBase_OpenDatabase() function to open a database (using it's own connection thread).
;         This function returns, if successful, a tBaseObject interface pointer. 
;
;   iv)   tBase_Error() will return an error string from the most recent operation. This is not reported on a thread by thread basis.
;/////////////////////////////////////////////////////////////////////////////////


;-CONSTANTS.

;/////////////////////////////////////////////////////////////////////////////////
  ;tBase error/status codes.
  ;Used only with the optional *returnValue parameter of the tBase_OpenDatabase() function.
    Enumeration
      #tBase_OKAY                 = 0
      #tBase_OUTOFMEMORY          = -1
      #tBase_OPERATIONCANCELLED   = -2
      #tBase_CONNECTIONERROR      = -3  ;The connection failed for some reason. Use the tBase_Error() function to get an error description.
      #tBase_FAILURE              = -4  ;E.g. a query failed. 
    EndEnumeration

  ;tBase connection types.
    Enumeration
      #tBase_SQLITEDATABASE         = 2 ;For compatibility with my Arctic Reports system only.
      #tBase_ODBCDATASOURCE
      #tBase_ADODATASOURCE
      #tBase_POSTGRESQLDATABASE
    EndEnumeration

  ;Flags parameter for the tBase_OpenDatabase() function.
    Enumeration
      #tBase_DISABLEPARENTWINDOW  = 1
    EndEnumeration

  ;For internal use only.
  ;======================
    #tBase_DEFAULTTIMETOSHOWCONNECTIONDIALOG = 1000 ;Milliseconds.

    ;Thread messages.
      Enumeration
        #tBase_TM_IDLE                  ;Not needed because the thread will be placed into a wait state when not needed to perform some task or other.
        #tBase_TM_CONNECT         = 1
        #tBase_TM_QUIT
        #tBase_TM_GETTABLES
        #tBase_TM_EXECUTEQUERY
        #tBase_TM_FINISHQUERY
        #tBase_TM_GETCOLUMNNAME
        #tBase_TM_GETCOLUMNSIZE
        #tBase_TM_GETCOLUMNTYPE
        #tBase_TM_FIRSTDATABASEROW
        #tBase_TM_NEXTDATABASEROW
        #tBase_TM_ISEOF
        #tBase_TM_GETDATABASEDOUBLE
        #tBase_TM_GETDATABASEFLOAT
        #tBase_TM_GETDATABASELONG
        #tBase_TM_GETDATABASEQUAD
        #tBase_TM_GETDATABASESTRING
      EndEnumeration

  ;ODBC constants.
  ;===============
    #SQL_NO_DATA = 100
    #SQL_HANDLE_STMT = 3
    #SQL_NTS = -3
    #SQL_C_CHAR = 1
    #SQL_C_WCHAR = -8
    #SQL_MAX_TABLE_NAME_LEN = 35

    ;The following compiler directive accounts for Ansi and Unicode modes.
      CompilerIf #PB_Compiler_Unicode
        #SQL_CHAR = #SQL_C_WCHAR 
      CompilerElse
        #SQL_CHAR = #SQL_C_CHAR 
      CompilerEndIf
;/////////////////////////////////////////////////////////////////////////////////


;-STRUCTURES.

;/////////////////////////////////////////////////////////////////////////////////
  ;The following holds a few globals.
    Structure _tBase_Prog
      iconExlamation.i
      databaseError$
      standardFont.i
      boldFont.i
    EndStructure

  ;The following is the class definition for the tBaseObject.
    Structure tBaseObject_ClassTemplate
      *vTable.i
      ;Connection fields.
        connectionType.i
        connection$
        user$
        pass$
        connectionID.i
      ;Table fields.
        tables$
      ;Query fields.
        SQL$
        param.i
        numColumns.i
      ;Thread fields.
        threadID.i
        threadEvent.i               ;An event object.
        threadMsg.i
        threadStatusResponse.i      ;1 for success, or -1 for failure.
        threadIntegerReturn.i
        threadDoubleReturn.d
        threadFloatReturn.f
        threadLongReturn.l
        threadQuadReturn.q
        threadStringReturn$
      ;Miscellaneous.
        blnDoEvents.i
    EndStructure
;/////////////////////////////////////////////////////////////////////////////////

;/////////////////////////////////////////////////////////////////////////////////
;-INTERFACES.

  Interface tBaseObject
    Destroy()
    ;========
    DatabaseColumnName.s(column)
    DatabaseColumns.i()
    DatabaseColumnSize.i(column)
    DatabaseColumnType.i(column)
    DatabaseQuery.i(SQL$, param=0)        ;param currently used for ADO only and it gives the cursortype (default = #adOpenForwardOnly)
                                          ;Returns non-zero if successful. For ADO, returns a COMate object housing the underlying ADO recordset object.
    FinishDatabaseQuery()
    FirstDatabaseRow.i()                  ;Returns non-zero if successful.
    GetDatabaseDouble.d(column)
    GetDatabaseFloat.f(column)
    GetDatabaseLong.l(column)
    GetDatabaseQuad.q(column)
    GetDatabaseString.s(column)
    IsEOF.i()                             ;ADO only. Do not use for other types of connection.
    ListTableNames.s(tableType$="TABLE")  ;The optional parameter is used only by ODBC and OLEDB.
                                          ;Issue this before any queries else, in the case of SQLite, ODBC and PostgreSQL it will destroy any existing query.
                                          ;Returns a Chr(10) separated list of tablenames.
    NextDatabaseRow.i()                   ;Returns non-zero if successful.
    ProcessWindowEvents(state)            ;Set state to #True to have all methods process window events whilst they await the
                                          ;connection thread etc. Default = #false.
  EndInterface
;/////////////////////////////////////////////////////////////////////////////////


;-GLOBALS.

;/////////////////////////////////////////////////////////////////////////////////
  Global g_tBase._tBase_Prog
;/////////////////////////////////////////////////////////////////////////////////


;-DECLARES.

;/////////////////////////////////////////////////////////////////////////////////
  Declare tBase_XXX_GetTextDimensions(text$, fontID, *sz.SIZE, pxWidth=0)
  Declare tBase_XXX_ConnectionThread(*this.tBaseObject_ClassTemplate)

;/////////////////////////////////////////////////////////////////////////////////


;-INCLUDES.

;/////////////////////////////////////////////////////////////////////////////////
  IncludePath #PB_Compiler_Home+"Includes"
    #COMATE_NOINCLUDEATL = 1
      XIncludeFile "ADOmate.pbi"
   IncludePath ""
;/////////////////////////////////////////////////////////////////////////////////


;-PUBLIC FUNCTIONS.

;/////////////////////////////////////////////////////////////////////////////////
;Returns the last recorded error message.
Procedure.s tBase_Error()
  ProcedureReturn g_tBase\databaseError$
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
;Returns, if successful, a tBaseObject pointer representing a successful connection.
Procedure.i tBase_OpenDatabase(connectionType, connection$, user$, pass$, dialogTitle$, dialogInfo$, cancelCaption$, flags=0, hParent=0, backColor=-1, timeoutToShowDialog=#tBase_DEFAULTTIMETOSHOWCONNECTIONDIALOG, *returnValue.INTEGER=0)
  Protected errorCode = #tBase_OKAY, startTime, blnProgressShown, winID, progressID, gadgetList, imGadgetID, titleID, infoID, btnCancelID, eventID, progress, null.w, libID
  Protected lf.LOGFONT, sz.SIZE, titleHeight, infoHeight, infoWidth, winWidth = 280, winHeight = 190
  Protected *this.tBaseObject_ClassTemplate
  ;Set globals if not already done.
    If g_tBase\iconExlamation = 0
      g_tBase\iconExlamation = LoadIcon_(0, #IDI_EXCLAMATION)
      g_tBase\standardFont = GetStockObject_(#DEFAULT_GUI_FONT)
      ;Bold font.
        If GetObject_(g_tBase\standardFont, SizeOf(LOGFONT), lf)
          lf\lfWeight = #FW_BOLD
          g_tBase\boldFont = CreateFontIndirect_(lf)
        EndIf
    EndIf
  ;Clear the global error string.
    g_tBase\databaseError$ = "ok"
  ;Create connection dialog.
    gadgetList = UseGadgetList(0)
    ;Calculate the various text extents.
      If dialogTitle$
        tBase_XXX_GetTextDimensions(dialogTitle$, g_tBase\boldFont, sz)
        winWidth = 60 + sz\cx
        titleHeight = sz\cy
      EndIf
      If dialogInfo$
        tBase_XXX_GetTextDimensions(dialoginfo$, g_tBase\standardFont, sz, winWidth-40)
        infoWidth = sz\cx
        infoHeight = sz\cy
      EndIf
      winHeight = titleHeight + infoHeight + 110
      If infoHeight
        winHeight+ 20
      EndIf
    winID = OpenWindow(#PB_Any, 0, 0, winWidth, winHeight, "", #PB_Window_WindowCentered|#PB_Window_BorderLess|#PB_Window_Invisible|#WS_BORDER, hParent)
    If winID
      imGadgetID = ImageGadget(#PB_Any, 5, 5, 0, 0,  g_tBase\iconExlamation)
      ;Get the dimensions of the title.
      titleID = TextGadget(#PB_Any, 50, 20, winWidth-60, titleHeight, dialogTitle$)
      SetGadgetFont(titleID, g_tBase\boldFont)
      ;We do not set a marquee style for the progressbar as this requires XP themes. We remove XP styles from the progress bar
      ;because of the timer lag under Vista.
        progressID = ProgressBarGadget(#PB_Any, 20, titleHeight + 40, winWidth-40, 20, 0, 100)
        If progressID
          libID = OpenLibrary(#PB_Any, "UxTheme.dll")
          If libID
            CallFunction(libID, "SetWindowTheme", GadgetID(progressID),@null,@null)
            CloseLibrary(libID)
          EndIf
        EndIf
      If dialogInfo$
        infoID = TextGadget(#PB_Any, 20, titleHeight + 80, infoWidth, infoHeight, dialogInfo$)
        SetGadgetFont(infoID, g_tBase\standardFont)
      EndIf
      btnCancelID = ButtonGadget(#PB_Any, winWidth-70, winHeight-30, 60, 20, cancelCaption$)
      If BackColor <> -1
        SetWindowColor(winID, backColor)
        SetGadgetColor(titleID, #PB_Gadget_BackColor, backColor)
        SetGadgetColor(infoID, #PB_Gadget_BackColor, backColor)
      EndIf
      UseGadgetList(gadgetList)
      ;Create a new tBaseObject.
        *this = AllocateMemory(SizeOf(tBaseObject_ClassTemplate))
      If *this
        With *this
          \vTable = ?tBaseObject_VT
          \connectionType = connectionType
          \connection$ = connection$
          \user$ = user$
          \pass$ = pass$
          \blnDoEvents = #False
        EndWith
        ;Create the event object.
          *this\threadEvent = CreateEvent_(0, #True, #False, 0)
        If *this\threadEvent
          ;Create the connection thread.
            *this\threadID = CreateThread(@tBase_XXX_ConnectionThread(), *this)
          If *this\threadID
            ;Disable parent if requested.
              If flags & #tBase_DISABLEPARENTWINDOW And hParent
                EnableWindow_(hParent, #False)
              EndIf
            ;Instruct the thread to attempt a connection and await the thread's response.
              *this\threadStatusResponse = 0
              *this\threadMsg = #tBase_TM_CONNECT
              SetEvent_(*this\threadEvent)
              startTime = ElapsedMilliseconds()
              While *this\threadStatusResponse = 0
                eventID = WindowEvent() : Delay(1)
                If blnProgressShown = #False
                  If ElapsedMilliseconds() - startTime > timeoutToShowDialog
                    HideWindow(winID, 0)
                    blnProgressShown = #True
                  EndIf
                ElseIf EventWindow() = winID And eventID = #PB_Event_Gadget And EventGadget() = btnCancelID
                  ;Here we instruct the connection thread to terminate and clear up. KillThread() is too risky in case a connection
                  ;is established right at the point we kill the thread!
                    *this\threadMsg = #tBase_TM_QUIT
                  g_tBase\databaseError$ = "Cancelled"
                  errorCode = #tBase_OPERATIONCANCELLED
                  *this = 0
                  Break
                ElseIf ElapsedMilliseconds() - startTime > 50
                  SetGadgetState(progressID, progress)
                  progress + 1
                  If progress > 100
                    progress = 0
                  EndIf
                  startTime = ElapsedMilliseconds()
                EndIf
              Wend
            ;Enable parent if requested.
              If flags & #tBase_DISABLEPARENTWINDOW And hParent
                EnableWindow_(hParent, #True)
              EndIf
            ;Set error code.
              If errorCode = #tBase_OKAY
                ;Either thread succeeded or it failed (cancelling could not have happened).
                If *this\threadStatusResponse = -1 
                  ;The thread has quit following a failed connection but has not destroyed the *this variable.
                  ;There is no need to set the g_tBase\databaseError$ variable as the thread will have done it.
                  errorCode = #tBase_CONNECTIONERROR
                  CloseHandle_(*this\threadEvent)
                  ClearStructure(*this, tBaseObject_ClassTemplate)
                  FreeMemory(*this)
                  *this = 0
                Else
                  *this\threadMsg = 0
                EndIf
              EndIf
          Else
            CloseHandle_(*this\threadEvent)
            Goto tBase_OpenDatabase_L2
          EndIf
        Else
tBase_OpenDatabase_L2:
          ClearStructure(*this, tBaseObject_ClassTemplate)
          FreeMemory(*this)
          *this = 0
          Goto tBase_OpenDatabase_L1
        EndIf
      Else
        Goto tBase_OpenDatabase_L1
      EndIf
    Else
tBase_OpenDatabase_L1:
      g_tBase\databaseError$ = "Out of memory"
      errorCode = #tBase_OUTOFMEMORY
    EndIf
  ;Tidy up.
    If winID
      CloseWindow(winID)
    EndIf
  ;Set any error return
    If *returnValue
      *returnValue\i = errorCode
    EndIf
  ProcedureReturn *this
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;-CLASS METHODS.

;/////////////////////////////////////////////////////////////////////////////////
Procedure tBaseClass_Destroy(*this.tBaseObject_ClassTemplate)
  ;Arrange for the connection thread to terminate which will undertake all tidying up operations.
    *this\threadMsg = #tBase_TM_QUIT
    SetEvent_(*this\threadEvent)
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.s tBaseClass_DatabaseColumnName(*this.tBaseObject_ClassTemplate, column)
  *this\tables$ = ""
  ;Clear the global error string.
    g_tBase\databaseError$ = "ok"
  If *this\numColumns
    ;Instruct the thread to retrieve the column name.
      *this\param = column
      *this\threadStatusResponse = 0
      *this\threadMsg = #tBase_TM_GETCOLUMNNAME
    SetEvent_(*this\threadEvent)
    While *this\threadStatusResponse = 0
      If *this\blnDoEvents
        WindowEvent()
      EndIf
      Delay(10)
    Wend
  EndIf
  ProcedureReturn *this\tables$
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.i tBaseClass_DatabaseColumns(*this.tBaseObject_ClassTemplate)
  ProcedureReturn *this\numColumns
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.i tBaseClass_DatabaseColumnSize(*this.tBaseObject_ClassTemplate, column)
  *this\threadIntegerReturn = 0
  ;Clear the global error string.
    g_tBase\databaseError$ = "ok"
  If *this\numColumns 
    ;Instruct the thread to retrieve the column size.
      *this\param = column
      *this\threadStatusResponse = 0
      *this\threadMsg = #tBase_TM_GETCOLUMNSIZE
    SetEvent_(*this\threadEvent)
    While *this\threadStatusResponse = 0
      If *this\blnDoEvents
        WindowEvent()
      EndIf
      Delay(10)
    Wend
  EndIf
  ProcedureReturn *this\threadIntegerReturn
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.i tBaseClass_DatabaseColumnType(*this.tBaseObject_ClassTemplate, column)
  *this\threadIntegerReturn = 0
  ;Clear the global error string.
    g_tBase\databaseError$ = "ok"
  If *this\numColumns 
    ;Instruct the thread to retrieve the column type.
      *this\param = column
      *this\threadStatusResponse = 0
      *this\threadMsg = #tBase_TM_GETCOLUMNTYPE
    SetEvent_(*this\threadEvent)
    While *this\threadStatusResponse = 0
      If *this\blnDoEvents
        WindowEvent()
      EndIf
      Delay(10)
    Wend
  EndIf
  ProcedureReturn *this\threadIntegerReturn
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.i tBaseClass_DatabaseQuery(*this.tBaseObject_ClassTemplate, SQL$, param=0)
  *this\threadIntegerReturn = 0
  ;Clear the global error string.
    g_tBase\databaseError$ = "ok"
  ;Instruct the thread to attempt to execute the query.
    *this\SQL$ = SQL$
    *this\param = param
    *this\numColumns = 0
    *this\threadStatusResponse = 0
    *this\threadMsg = #tBase_TM_EXECUTEQUERY
    SetEvent_(*this\threadEvent)
  While *this\threadStatusResponse = 0
    If *this\blnDoEvents
      WindowEvent()
    EndIf
    Delay(10)
  Wend
  ProcedureReturn *this\threadIntegerReturn ;Non-zero if successful. For ADO, returns a COMate object housing the underlying ADO recordset object.
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure tBaseClass_FinishDatabaseQuery(*this.tBaseObject_ClassTemplate)
  ;Clear the global error string.
    g_tBase\databaseError$ = "ok"
  ;Instruct the thread to attempt to finish the query.
    *this\threadStatusResponse = 0
    *this\threadMsg = #tBase_TM_FINISHQUERY
    SetEvent_(*this\threadEvent)
  While *this\threadStatusResponse = 0
    If *this\blnDoEvents
      WindowEvent()
    EndIf
    Delay(10)
  Wend
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.i tBaseClass_FirstDatabaseRow(*this.tBaseObject_ClassTemplate)
  *this\threadIntegerReturn = 0
  ;Clear the global error string.
    g_tBase\databaseError$ = "ok"
  ;Instruct the thread to attempt to repostion the record pointer.
    *this\threadStatusResponse = 0
    *this\threadMsg = #tBase_TM_FIRSTDATABASEROW
    SetEvent_(*this\threadEvent)
  While *this\threadStatusResponse = 0
    If *this\blnDoEvents
      WindowEvent()
    EndIf
    Delay(10)
  Wend
  ProcedureReturn *this\threadIntegerReturn
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.d tBaseClass_GetDatabaseDouble(*this.tBaseObject_ClassTemplate, column)
  *this\threadDoubleReturn = 0
  ;Clear the global error string.
    g_tBase\databaseError$ = "ok"
  ;Instruct the thread to attempt to retrieve the required string.
    *this\threadStatusResponse = 0
    *this\param = column
    *this\threadMsg = #tBase_TM_GETDATABASEDOUBLE
    SetEvent_(*this\threadEvent)
  While *this\threadStatusResponse = 0
    If *this\blnDoEvents
      WindowEvent()
    EndIf
    Delay(10)
  Wend
  ProcedureReturn *this\threadDoubleReturn
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.f tBaseClass_GetDatabaseFloat(*this.tBaseObject_ClassTemplate, column)
  *this\threadFloatReturn = 0
  ;Clear the global error string.
    g_tBase\databaseError$ = "ok"
  ;Instruct the thread to attempt to retrieve the required string.
    *this\threadStatusResponse = 0
    *this\param = column
    *this\threadMsg = #tBase_TM_GETDATABASEFLOAT
    SetEvent_(*this\threadEvent)
  While *this\threadStatusResponse = 0
    If *this\blnDoEvents
      WindowEvent()
    EndIf
    Delay(10)
  Wend
  ProcedureReturn *this\threadFloatReturn
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.l tBaseClass_GetDatabaseLong(*this.tBaseObject_ClassTemplate, column)
  *this\threadLongReturn = 0
  ;Clear the global error string.
    g_tBase\databaseError$ = "ok"
  ;Instruct the thread to attempt to retrieve the required string.
    *this\threadStatusResponse = 0
    *this\param = column
    *this\threadMsg = #tBase_TM_GETDATABASELONG
    SetEvent_(*this\threadEvent)
  While *this\threadStatusResponse = 0
    If *this\blnDoEvents
      WindowEvent()
    EndIf
    Delay(10)
  Wend
  ProcedureReturn *this\threadLongReturn
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.q tBaseClass_GetDatabaseQuad(*this.tBaseObject_ClassTemplate, column)
  *this\threadQuadReturn = 0
  ;Clear the global error string.
    g_tBase\databaseError$ = "ok"
  ;Instruct the thread to attempt to retrieve the required string.
    *this\threadStatusResponse = 0
    *this\param = column
    *this\threadMsg = #tBase_TM_GETDATABASEQUAD
    SetEvent_(*this\threadEvent)
  While *this\threadStatusResponse = 0
    If *this\blnDoEvents
      WindowEvent()
    EndIf
    Delay(10)
  Wend
  ProcedureReturn *this\threadQuadReturn
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.s tBaseClass_GetDatabaseString(*this.tBaseObject_ClassTemplate, column)
  *this\threadStringReturn$ = ""
  ;Clear the global error string.
    g_tBase\databaseError$ = "ok"
  ;Instruct the thread to attempt to retrieve the required string.
    *this\threadStatusResponse = 0
    *this\param = column
    *this\threadMsg = #tBase_TM_GETDATABASESTRING
    SetEvent_(*this\threadEvent)
  While *this\threadStatusResponse = 0
    If *this\blnDoEvents
      WindowEvent()
    EndIf
    Delay(10)
  Wend
  ProcedureReturn *this\threadStringReturn$
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.i tBaseClass_IsEOF(*this.tBaseObject_ClassTemplate)
  *this\threadIntegerReturn = 0
  ;Clear the global error string.
    g_tBase\databaseError$ = "ok"
  ;Instruct the thread to retrieve the EOF setting.
    *this\threadStatusResponse = 0
    *this\threadMsg = #tBase_TM_ISEOF
    SetEvent_(*this\threadEvent)
  While *this\threadStatusResponse = 0
    If *this\blnDoEvents
      WindowEvent()
    EndIf
    Delay(10)
  Wend
  ProcedureReturn *this\threadIntegerReturn
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.s tBaseClass_ListTableNames(*this.tBaseObject_ClassTemplate, tableType$="TABLE")
  ;Clear the global error string.
    g_tBase\databaseError$ = "ok"
  *this\tables$ = tableType$
  ;Instruct the thread to attempt to retrieve the table names.
    *this\threadStatusResponse = 0
    *this\threadMsg = #tBase_TM_GETTABLES
    SetEvent_(*this\threadEvent)
  While *this\threadStatusResponse = 0
    If *this\blnDoEvents
      WindowEvent()
    EndIf
    Delay(10)
  Wend
  ;There is no need to set the g_tBase\databaseError$ variable as the thread will have done it.
  ProcedureReturn *this\tables$
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure.i tBaseClass_NextDatabaseRow(*this.tBaseObject_ClassTemplate)
  *this\threadIntegerReturn = 0
  ;Clear the global error string.
    g_tBase\databaseError$ = "ok"
  ;Instruct the thread to attempt to repostion the record pointer.
    *this\threadStatusResponse = 0
    *this\threadMsg = #tBase_TM_NEXTDATABASEROW
    SetEvent_(*this\threadEvent)
  While *this\threadStatusResponse = 0
    If *this\blnDoEvents
      WindowEvent()
    EndIf
    Delay(10)
  Wend
  ProcedureReturn *this\threadIntegerReturn
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;/////////////////////////////////////////////////////////////////////////////////
Procedure tBaseClass_ProcessWindowEvents(*this.tBaseObject_ClassTemplate, state)
  *this\blnDoEvents = state
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;-INTERNAL FUNCTIONS.

;/////////////////////////////////////////////////////////////////////////////////
;The following function returns the dimensions of the specified text using the given font and optional pixel width.
Procedure tBase_XXX_GetTextDimensions(text$, fontID, *sz.SIZE, pxWidth=0)
  Protected hdc, oldFont, flags, rc.RECT
  hdc = GetDC_(0)
  If hdc
    oldFont = SelectObject_(hdc, fontID)
    If pxWidth
      flags = #DT_WORDBREAK
      SetRect_(rc, 0, 0, pxWidth, 0)
    Else
      flags = #DT_SINGLELINE
    EndIf	
    DrawText_(hdc, @text$, Len(text$), rc, flags!#DT_CALCRECT|#DT_EDITCONTROL) 
    *sz\cx = rc\right
    *sz\cy = rc\bottom
    SelectObject_(hdc, oldFont)
    ReleaseDC_(0, hdc)
  EndIf
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;-CONNECTION THREAD.

;/////////////////////////////////////////////////////////////////////////////////
Procedure tBase_XXX_ConnectionThread(*this.tBaseObject_ClassTemplate)
  Protected blnQuit, wResult.w, i, t1, t1$, Dim tableNames$(0), dbc, tableName$, tableNameMaxSize, stmt, tableType
  Repeat
    WaitForSingleObject_(*this\threadEvent, #INFINITE)
    Select *this\threadMsg
      Case #tBase_TM_QUIT
;{
        ;Close any active connection.
          If *this\connectionID
            Select *this\connectionType
              Case #tBase_SQLITEDATABASE, #tBase_ODBCDATASOURCE, #tBase_POSTGRESQLDATABASE
                CloseDatabase(*this\connectionID)
              Case #tBase_ADODATASOURCE
                ADOmate_CloseDatabase(*this\connectionID)
            EndSelect
          EndIf
        ;Tidy up.
          CloseHandle_(*this\threadEvent)
          ClearStructure(*this, tBaseObject_ClassTemplate)
          FreeMemory(*this)
        blnQuit = #True
;}
      Case #tBase_TM_CONNECT
;{
      ;Attempts to connect to the underlying source. Any failure to connect will result, unless the user has cancelled the operation,
      ;in the thread being closed but without clearing the *this object.
        Select *this\connectionType
          Case #tBase_SQLITEDATABASE, #tBase_ODBCDATASOURCE, #tBase_POSTGRESQLDATABASE
            If *this\connectionType = #tBase_SQLITEDATABASE
              *this\connectionID = OpenDatabase(#PB_Any, *this\connection$, "", "",  #PB_Database_SQLite)
            ElseIf *this\connectionType = #tBase_ODBCDATASOURCE
              *this\connectionID = OpenDatabase(#PB_Any, *this\connection$, *this\user$, *this\pass$,  #PB_Database_ODBC)
            Else
              *this\connectionID = OpenDatabase(#PB_Any, *this\connection$, *this\user$, *this\pass$,  #PB_Database_PostgreSQL)
            EndIf
            ;Proceed only if we have not been signalled to cancel.
              If *this\threadMsg <> #tBase_TM_QUIT
                If *this\connectionID
                  ResetEvent_(*this\threadEvent)
                  *this\threadStatusResponse = 1
                Else
                  If *this\connectionType = #tBase_SQLITEDATABASE
                    g_tBase\databaseError$ = "database not found"
                  Else
                    g_tBase\databaseError$ = DatabaseError()
                  EndIf
                  *this\threadStatusResponse = -1
                  blnQuit = #True
                EndIf
              EndIf
          Case #tBase_ADODATASOURCE
            *this\connectionID = ADOmate_OpenDatabase(*this\connection$, *this\user$, *this\pass$)
            ;Proceed only if we have not been signalled to cancel.
              If *this\threadMsg <> #tBase_TM_QUIT
                If *this\connectionID
                  ResetEvent_(*this\threadEvent)
                  *this\threadStatusResponse = 1
                Else
                  g_tBase\databaseError$ = ADOmate_GetLastErrorDescription()
                  *this\threadStatusResponse = -1
                  blnQuit = #True
                EndIf
              EndIf
        EndSelect
;}
      Case #tBase_TM_GETTABLES
;{
        t1$ = *this\tables$
        *this\tables$ = ""
        Select *this\connectionType
          Case #tBase_POSTGRESQLDATABASE, #tBase_SQLITEDATABASE
            ;Tidy up any existing query (since we will use the same connection)
              FinishDatabaseQuery(*this\connectionID)
            If *this\connectionType = #tBase_POSTGRESQLDATABASE
              t1$ = "Select c.relname FROM pg_catalog.pg_class c LEFT JOIN pg_catalog.pg_namespace n ON n.oid = c.relnamespace WHERE c.relkind IN ('r','') And n.nspname Not IN ('pg_catalog', 'pg_toast') And pg_catalog.pg_table_is_visible(c.oid);"
            Else
              t1$ = "SELECT name FROM sqlite_master WHERE type='table' ORDER BY name"
            EndIf
            If DatabaseQuery(*this\connectionID, t1$)
              While NextDatabaseRow(*this\connectionID)
                If *this\tables$
                  *this\tables$ + #LF$
                EndIf
                *this\tables$ + GetDatabaseString(*this\connectionID, 0)
              Wend
              FinishDatabaseQuery(*this\connectionID)
            ElseIf *this\connectionType = #tBase_POSTGRESQLDATABASE
              g_tBase\databaseError$ = DatabaseError()
            Else
              g_tBase\databaseError$ = "Out of memory"
            EndIf
          Case #tBase_ODBCDATASOURCE
            tableType = 0
            ;Tidy up any existing query (since we will use the same connection)
              FinishDatabaseQuery(*this\connectionID)
            dbc = DatabaseID(*this\connectionID)
            SQLGetInfo_(dbc, #SQL_MAX_TABLE_NAME_LEN, @tableNameMaxSize, 4, 0)
            tableName$ = Space(tableNameMaxSize+1)
            ;Allocate a statement handle.
              SQLAllocHandle_(#SQL_HANDLE_STMT, dbc, @stmt)
            If stmt
              If t1$
                tableType = @t1$
              EndIf
              SQLTables_(stmt, #Null, 0, #Null, 0, #Null, 0, tableType, #SQL_NTS)
              ;Loop through the tables.
                SQLBindCol_(stmt,3,#SQL_CHAR, @tableName$, (tableNameMaxSize+1)<<(SizeOf(CHARACTER)-1), 0) 
                wResult = SQLFetch_(stmt)
                While wResult = #SQL_SUCCESS
                  If *this\tables$
                    *this\tables$ + #LF$
                  EndIf
                  *this\tables$ + tableName$
                  wResult = SQLFetch_(stmt)
                Wend
              SQLFreeHandle_(#SQL_HANDLE_STMT, stmt)
            Else
              g_tBase\databaseError$ = "Out of memory"
            EndIf
          Case #tBase_ADODATASOURCE
            t1 = ADOmate_ListDatabaseTables(*this\connectionID, tableNames$(), t1$)
            If ADOmate_GetLastErrorCode() <> #S_OK
              g_tBase\databaseError$ = ADOmate_GetLastErrorDescription()               
            Else
              For i = 0 To t1-1
                If *this\tables$
                  *this\tables$ + #LF$
                EndIf
                *this\tables$ + tableNames$(i)
              Next
            EndIf
        EndSelect
        ResetEvent_(*this\threadEvent)
        *this\threadStatusResponse = 1
;}
      Case #tBase_TM_EXECUTEQUERY
;{
        Select *this\connectionType
          Case #tBase_POSTGRESQLDATABASE, #tBase_SQLITEDATABASE, #tBase_ODBCDATASOURCE
            ;Tidy up any existing query (since we will use the same connection)
              FinishDatabaseQuery(*this\connectionID)
            *this\threadIntegerReturn = DatabaseQuery(*this\connectionID, *this\SQL$)
            If *this\threadIntegerReturn = 0
              g_tBase\databaseError$ = DatabaseError()
            Else
              *this\numColumns = DatabaseColumns(*this\connectionID)
            EndIf
          Case #tBase_ADODATASOURCE
            ;Tidy up any existing query (since we will use the same connection)
               ADOmate_FinishDatabaseQuery(*this\connectionID)
            *this\threadIntegerReturn = ADOmate_DatabaseQuery(*this\connectionID, *this\SQL$, *this\param)
            If *this\threadIntegerReturn = 0
              g_tBase\databaseError$ = ADOmate_GetLastErrorDescription()
            Else
              *this\numColumns = ADOmate_DatabaseColumns(*this\connectionID)
            EndIf
        EndSelect
        ResetEvent_(*this\threadEvent)
        *this\threadStatusResponse = 1
;}
      Case #tBase_TM_FINISHQUERY
;{
        Select *this\connectionType
          Case #tBase_POSTGRESQLDATABASE, #tBase_SQLITEDATABASE, #tBase_ODBCDATASOURCE
            FinishDatabaseQuery(*this\connectionID)
          Case #tBase_ADODATASOURCE
            ADOmate_FinishDatabaseQuery(*this\connectionID)
        EndSelect
        ResetEvent_(*this\threadEvent)
        *this\threadStatusResponse = 1
        

;}
      Case #tBase_TM_GETCOLUMNNAME
;{
        Select *this\connectionType
          Case #tBase_POSTGRESQLDATABASE, #tBase_SQLITEDATABASE, #tBase_ODBCDATASOURCE
            *this\tables$ = DatabaseColumnName(*this\connectionID, *this\param)
            g_tBase\databaseError$ = DatabaseError()
          Case #tBase_ADODATASOURCE
            *this\tables$ = ADOmate_DatabaseColumnName(*this\connectionID, *this\param)
            g_tBase\databaseError$ = ADOmate_GetLastErrorDescription()
        EndSelect        
        ResetEvent_(*this\threadEvent)
        *this\threadStatusResponse = 1
;}
      Case #tBase_TM_GETCOLUMNSIZE
;{
        Select *this\connectionType
          Case #tBase_POSTGRESQLDATABASE, #tBase_SQLITEDATABASE, #tBase_ODBCDATASOURCE
            *this\threadIntegerReturn = DatabaseColumnSize(*this\connectionID, *this\param)
            g_tBase\databaseError$ = DatabaseError()
          Case #tBase_ADODATASOURCE
            *this\threadIntegerReturn = ADOmate_DatabaseColumnSize(*this\connectionID, *this\param)
            g_tBase\databaseError$ = ADOmate_GetLastErrorDescription()
        EndSelect        
        ResetEvent_(*this\threadEvent)
        *this\threadStatusResponse = 1
;}
      Case #tBase_TM_GETCOLUMNTYPE
;{
        Select *this\connectionType
          Case #tBase_POSTGRESQLDATABASE, #tBase_SQLITEDATABASE, #tBase_ODBCDATASOURCE
            *this\threadIntegerReturn = DatabaseColumnType(*this\connectionID, *this\param)
            g_tBase\databaseError$ = DatabaseError()
          Case #tBase_ADODATASOURCE
            *this\threadIntegerReturn = ADOmate_DatabaseColumnType(*this\connectionID, *this\param)
            g_tBase\databaseError$ = ADOmate_GetLastErrorDescription()
        EndSelect        
        ResetEvent_(*this\threadEvent)
        *this\threadStatusResponse = 1
;}
      Case #tBase_TM_FIRSTDATABASEROW
;{
        Select *this\connectionType
          Case #tBase_POSTGRESQLDATABASE, #tBase_SQLITEDATABASE, #tBase_ODBCDATASOURCE
            *this\threadIntegerReturn = FirstDatabaseRow(*this\connectionID)
            If *this\threadIntegerReturn = 0
              g_tBase\databaseError$ = DatabaseError()
            EndIf
          Case #tBase_ADODATASOURCE
            *this\threadIntegerReturn = ADOmate_FirstDatabaseRow(*this\connectionID)
            If *this\threadIntegerReturn = 0
              g_tBase\databaseError$ = ADOmate_GetLastErrorDescription()
            EndIf
        EndSelect        
        ResetEvent_(*this\threadEvent)
        *this\threadStatusResponse = 1
;}
      Case #tBase_TM_NEXTDATABASEROW
;{
        Select *this\connectionType
          Case #tBase_POSTGRESQLDATABASE, #tBase_SQLITEDATABASE, #tBase_ODBCDATASOURCE
            *this\threadIntegerReturn = NextDatabaseRow(*this\connectionID)
            If *this\threadIntegerReturn = 0
              g_tBase\databaseError$ = DatabaseError()
            EndIf
          Case #tBase_ADODATASOURCE
            *this\threadIntegerReturn = ADOmate_NextDatabaseRow(*this\connectionID)
            If *this\threadIntegerReturn = 0
              g_tBase\databaseError$ = ADOmate_GetLastErrorDescription()
            EndIf
        EndSelect        
        ResetEvent_(*this\threadEvent)
        *this\threadStatusResponse = 1
;}
      Case #tBase_TM_ISEOF
;{
        If *this\connectionType = #tBase_ADODATASOURCE
          *this\threadIntegerReturn =  ADOmate_IsEOF(*this\connectionID)
          g_tBase\databaseError$ = ADOmate_GetLastErrorDescription()
        EndIf
        ResetEvent_(*this\threadEvent)
        *this\threadStatusResponse = 1
;}
      Case #tBase_TM_GETDATABASESTRING
;{
        Select *this\connectionType
          Case #tBase_POSTGRESQLDATABASE, #tBase_SQLITEDATABASE, #tBase_ODBCDATASOURCE
            *this\threadStringReturn$ = GetDatabaseString(*this\connectionID, *this\param)
            g_tBase\databaseError$ = DatabaseError()
          Case #tBase_ADODATASOURCE
            *this\threadStringReturn$ = ADOmate_GetDatabaseString(*this\connectionID, *this\param)
            g_tBase\databaseError$ = ADOmate_GetLastErrorDescription()
        EndSelect        
        ResetEvent_(*this\threadEvent)
        *this\threadStatusResponse = 1
;}
      Case #tBase_TM_GETDATABASEDOUBLE
;{
        Select *this\connectionType
          Case #tBase_POSTGRESQLDATABASE, #tBase_SQLITEDATABASE, #tBase_ODBCDATASOURCE
            *this\threadDoubleReturn = GetDatabaseDouble(*this\connectionID, *this\param)
            g_tBase\databaseError$ = DatabaseError()
          Case #tBase_ADODATASOURCE
            *this\threadDoubleReturn = ADOmate_GetDatabaseDouble(*this\connectionID, *this\param)
            g_tBase\databaseError$ = ADOmate_GetLastErrorDescription()
        EndSelect        
        ResetEvent_(*this\threadEvent)
        *this\threadStatusResponse = 1
;}
      Case #tBase_TM_GETDATABASEFLOAT
;{
        Select *this\connectionType
          Case #tBase_POSTGRESQLDATABASE, #tBase_SQLITEDATABASE, #tBase_ODBCDATASOURCE
            *this\threadFloatReturn = GetDatabaseFloat(*this\connectionID, *this\param)
            g_tBase\databaseError$ = DatabaseError()
          Case #tBase_ADODATASOURCE
            *this\threadFloatReturn = ADOmate_GetDatabaseFloat(*this\connectionID, *this\param)
            g_tBase\databaseError$ = ADOmate_GetLastErrorDescription()
        EndSelect        
        ResetEvent_(*this\threadEvent)
        *this\threadStatusResponse = 1
;}
      Case #tBase_TM_GETDATABASELONG
;{
        Select *this\connectionType
          Case #tBase_POSTGRESQLDATABASE, #tBase_SQLITEDATABASE, #tBase_ODBCDATASOURCE
            *this\threadLongReturn = GetDatabaseLong(*this\connectionID, *this\param)
            g_tBase\databaseError$ = DatabaseError()
          Case #tBase_ADODATASOURCE
            *this\threadLongReturn = ADOmate_GetDatabaseLong(*this\connectionID, *this\param)
            g_tBase\databaseError$ = ADOmate_GetLastErrorDescription()
        EndSelect        
        ResetEvent_(*this\threadEvent)
        *this\threadStatusResponse = 1
;}
      Case #tBase_TM_GETDATABASEQUAD
;{
        Select *this\connectionType
          Case #tBase_POSTGRESQLDATABASE, #tBase_SQLITEDATABASE, #tBase_ODBCDATASOURCE
            *this\threadQuadReturn = GetDatabaseQuad(*this\connectionID, *this\param)
            g_tBase\databaseError$ = DatabaseError()
          Case #tBase_ADODATASOURCE
            *this\threadQuadReturn = ADOmate_GetDatabaseQuad(*this\connectionID, *this\param)
            g_tBase\databaseError$ = ADOmate_GetLastErrorDescription()
        EndSelect        
        ResetEvent_(*this\threadEvent)
        *this\threadStatusResponse = 1
;}
    EndSelect
  Until blnQuit
EndProcedure
;/////////////////////////////////////////////////////////////////////////////////


;-DATA SECTION.

;/////////////////////////////////////////////////////////////////////////////////
DataSection
  tBaseObject_VT:
    Data.i @tBaseClass_Destroy()
    Data.i @tBaseClass_DatabaseColumnName()
    Data.i @tBaseClass_DatabaseColumns()
    Data.i @tBaseClass_DatabaseColumnSize()
    Data.i @tBaseClass_DatabaseColumnType()
    Data.i @tBaseClass_DatabaseQuery()
    Data.i @tBaseClass_FinishDatabaseQuery()
    Data.i @tBaseClass_FirstDatabaseRow()
    Data.i @tBaseClass_GetDatabaseDouble()
    Data.i @tBaseClass_GetDatabaseFloat()
    Data.i @tBaseClass_GetDatabaseLong()
    Data.i @tBaseClass_GetDatabaseQuad()
    Data.i @tBaseClass_GetDatabaseString()
    Data.i @tBaseClass_IsEOF()
    Data.i @tBaseClass_ListTableNames()
    Data.i @tBaseClass_NextDatabaseRow()
    Data.i @tBaseClass_ProcessWindowEvents()
EndDataSection
;/////////////////////////////////////////////////////////////////////////////////

CompilerEndIf

[srod]

Demo 1.

PostgreSQL.

The following demo will connect to a PostgreSQL server (you of course need to provide some valid credentials). If successful the program will simply list all the tables and all the fieldnames therein.

Point the code at a non-existant server and, if the timeout is exceeded, you will be presented with a simple dialog which allows you to cancel the attempt etc.

Set the threadsafe switch. Do NOT compile with the Unicode switch set (there is a bug in the PostgreSQL library... fixed by Fred, but we need PB 4.51 RC2! )

Place the code in the first post above into an include file named "tBase.pbi" etc.

Code: Select all

;tBase.
;======
;By Stephen Rodriguez.
;August 2010.
;
;PostgreSQL demonstration program.


;/////////////////////////////////////////////////////////////////////////////////
;-NOTES.
;
; Use the connection$, user$, pass$ variables to define a valid PostgreSQL connection if you wish to see the tables listed etc.
; Otherwise, use this demo to see how the connection timeout is handled by tBase (just close your PostgreSQL server).
;/////////////////////////////////////////////////////////////////////////////////


;Initialise the PostgreSQL library. tBase will not do this automatically.
  UsePostgreSQLDatabase()

XIncludeFile "tBase.pbi"

Define tBase.tBaseObject

;Connection details.  Change as appropriate if you wish to actually connect.
;===================
  connection$ = "hostaddr=127.0.0.1 port=5432 dbname=customers"
  user$ = "postgres"
  pass$ = "postgres"

;Provide a simple GUI as a kind of back-drop.
If OpenWindow(0, 0, 0, 300, 300, "tBase PostgreSQL demo", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget |#PB_Window_ScreenCentered)

  TreeGadget(0, 10, 10, 280, 250)
  ButtonGadget(1, 210, 270, 80, 20, "Connect...")
  Repeat
    eventID = WaitWindowEvent()
    Select eventID
      Case #PB_Event_Gadget
        Select EventGadget()
          Case 1
            ClearGadgetItems(0)
            ;Create a tBase database object which connects to a PostgreSQL database.
              tBase = tBase_OpenDatabase(#tBase_POSTGRESQLDATABASE, connection$, user$, pass$, "Attempting to connect to data-source......", "Hit the cancel button to abort the connection attempt before the PostgreSQL timeout kicks in.", "Cancel", #tBase_DISABLEPARENTWINDOW, WindowID(0), #White)
              If tBase
                ;Clear the 'Process window events' flag to prohibit the library methods from processing window events. This will speed things up.
                ;#False is the default anyhow.
                  tBase\ProcessWindowEvents(#False)
                tableNames$ = tbase\ListTableNames()
                numTables = CountString(tableNames$, #LF$) + 1
                For i = 1 To numTables
                  tableName$ = StringField(tableNames$, i, #LF$)
                  AddGadgetItem(0, -1, tableName$ + " (table)", 0, 0)
                  If tBase\DatabaseQuery("select * from " + tableName$)
                    numFields = tBase\DatabaseColumns()
                    For j = 0 To numFields - 1
                      AddGadgetItem(0, -1, tBase\DatabaseColumnName(j), 0, 1)
                    Next
                    tBase\FinishDatabaseQuery()
                  EndIf
                Next
                tBase\Destroy()
              Else
                MessageRequester("Error!", tBase_Error())
              EndIf
        EndSelect
    EndSelect
  Until eventID = #PB_Event_CloseWindow 
EndIf

[srod]

Demo 2.

ADO.

The following demo will connect to datasource via an OLE-DB provider (you of course need to provide some valid credentials). If successful the program will simply list all the tables and all the fieldnames therein.

Set the threadsafe switch.

Place the code in the first post above into an include file named "tBase.pbi" etc.

Code: Select all

;tBase.
;======
;By Stephen Rodriguez.
;August 2010.
;
;ADO demonstration program.


;/////////////////////////////////////////////////////////////////////////////////
;-NOTES.
;
; Use the connection$, user$, pass$ variables to define a valid OLE-DB connection if you wish to see the tables listed etc.
;/////////////////////////////////////////////////////////////////////////////////

XIncludeFile "tBase.pbi"

Define tBase.tBaseObject

;Connection details.  Change as appropriate if you wish to actually connect.
;===================
  connection$ = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=billing.mdb;"
  user$ = ""
  pass$ = ""

;Provide a simple GUI as a kind of back-drop.
If OpenWindow(0, 0, 0, 300, 300, "tBase ADO demo", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget |#PB_Window_ScreenCentered)

  TreeGadget(0, 10, 10, 280, 250)
  ButtonGadget(1, 210, 270, 80, 20, "Connect...")
  Repeat
    eventID = WaitWindowEvent()
    Select eventID
      Case #PB_Event_Gadget
        Select EventGadget()
          Case 1
            ClearGadgetItems(0)
            ;Create a tBase database object which connects to an ADO source.
              tBase = tBase_OpenDatabase(#tBase_ADODATASOURCE, connection$, user$, pass$, "Attempting to connect to data-source......", "Hit the cancel button to abort the connection attempt before the OLE-DB provider's timeout kicks in.", "Cancel", #tBase_DISABLEPARENTWINDOW, WindowID(0), #White)
              If tBase
                ;Clear the 'Process window events' flag to prohibit the library methods from processing window events. This will speed things up.
                ;#False is the default anyhow.
                tableNames$ = tbase\ListTableNames()
                numTables = CountString(tableNames$, #LF$) + 1
                For i = 1 To numTables
                  tableName$ = StringField(tableNames$, i, #LF$)
                  AddGadgetItem(0, -1, tableName$ + " (table)", 0, 0)
                  If tBase\DatabaseQuery("select * from " + tableName$)
                    numFields = tBase\DatabaseColumns()
                    For j = 0 To numFields - 1
                      AddGadgetItem(0, -1, tBase\DatabaseColumnName(j), 0, 1)
                    Next
                    tBase\FinishDatabaseQuery()
                  EndIf
                Next
                tBase\Destroy()
              Else
                MessageRequester("Error!", tBase_Error())
              EndIf
        EndSelect
    EndSelect
  Until eventID = #PB_Event_CloseWindow 
EndIf

[flaith]

thanks for sharing this with us srod
I've tested both and for postgreSQL, if i check unicode mode, the names of each column are not showed correctly (with ADO, it's ok for both unicode and ascii)
The Database is UTF8 coded.

Thanks

[srod]

Set the threadsafe switch. Do NOT compile with the Unicode switch set (there is a bug in the PostgreSQL library... fixed by Fred, but we need PB 4.51 RC2! )

I have a simple workaround for that bug, but did not add it because Fred has already fixed the bug for the next version of PB.

[flaith]

i've only read your first post several times to be sure and not the others, sorry
need to wear his glasses again