// SQLExpress demo program showing how to use XbpBrowse to browse ODBC tables
//------------------------------------------------------------------------------------
#include "sql.ch"
#include "sqlext.ch"
#include "xbp.ch"
#include "dll.ch"
#include "gra.ch"
#include "appevent.ch"
#include "common.ch"
#include "font.ch"
#define xbeU_Quit xbeP_User + 101
#define __CONNECT_STRING 'DSN=Xtreme sample data;UID=;PWD='
#define __TABLE "Customer"
#define __STATEMENT "SELECT DISTINCTROW Credit.[Credit Authorization Number], Credit.Amount, Customer.[Customer Name], Customer.[Contact First Name], Customer.[Contact Last Name] "+ ;
"FROM Customer INNER JOIN Credit ON Customer.[Customer Credit ID] = Credit.[Customer Credit ID] " + ;
"WHERE (Credit.Amount < 500.00)"
//-----------------------------------------------------------------------------
PROCEDURE DbeSys() ; Return
PROCEDURE AppSys() ; Return
PROCEDURE Main()
Local oConnection, oDlg, oXbp, oMenu, oMenuBar, nEvent, mp1, mp2
Local cConnectString := __CONNECT_STRING
// establish the ODBC connection
oConnection := SQLConnection():new()
oConnection:driverConnect(Nil, cConnectString)
if ! oConnection:isConnected
MsgBox("Connection error!")
Return
endif
// create the dialog window
oDlg := xt_BrowseDialog():new(,AppDesktop(),,,,.F.):create()
oMenuBar := oDlg:menuBar()
oMenu := XbpMenu():new( oMenuBar )
oMenu:title := "~File"
oMenu:create()
oMenu:addItem( {"~Refresh", {|| oDlg:browse:dataLink:refresh(), oDlg:browse:refreshAll()}} )
oMenu:addItem( {"E~xit" , {|| PostAppEvent(xbeP_Close,,,oDlg)}} )
oMenuBar:addItem({oMenu, nil})
oMenu := XbpMenu():new( oMenuBar )
oMenu:title := "~View"
oMenu:create()
oMenu:addItem( {"SQLSelect" , } )
oMenu:addItem( {"SQLListColumnPrivileges", } )
oMenu:addItem( {"SQLListColumns" , } )
oMenu:addItem( {"SQLListForeignKeys" , } )
oMenu:addItem( {"SQLListPrimaryKeys" , } )
oMenu:addItem( {"SQLListProcedureColumns", } )
oMenu:addItem( {"SQLListProcedures" , } )
oMenu:addItem( {"SQLListSpecialColumns" , } )
oMenu:addItem( {"SQLListStatistics" , } )
oMenu:addItem( {"SQLListTablePrivileges" , } )
oMenu:addItem( {"SQLListTables" , } )
oMenu:addItem( {"SQLListTypeInfo" , } )
oMenu:activateItem := {|i,x,o| CreateSQLCursor(oConnection, oDlg, i, o:getItem(i)[1]) }
oMenuBar:addItem({oMenu, nil})
CreateSQLCursor(oConnection, oDlg, 1, "SQLSelect")
oDlg:show()
oDlg:browse:show()
SetAppFocus( oDlg:browse )
while nEvent != xbeU_Quit
nEvent := AppEvent( @mp1, @mp2, @oXbp )
oXbp:HandleEvent( nEvent, mp1, mp2 )
end
oConnection:destroy()
Return
//-----------------------------------------------------------------------------
STATIC FUNCTION CreateSQLCursor( oConnection, oDlg, i, cTitle )
Local oCursor, oXbp, nSuccess := SQL_XPP_ERROR
if ValType(oDlg:browse)=="O"
oDlg:browse:hide()
endif
oXbp := xt_MPointerWait( oDlg )
oConnection:displayErrors := .t.
do case
case i == 1
oCursor := SQLSelect():new(__STATEMENT, oConnection, SQL_CONCUR_READ_ONLY, SQL_CURSOR_STATIC)
nSuccess := oCursor:execute()
case i == 2
oCursor := SQLListColumnPrivileges():new( oConnection )
nSuccess := oCursor:execute(,,__TABLE)
case i == 3
oCursor := SQLListColumns():new( oConnection )
nSuccess := oCursor:execute()
case i == 4
oCursor := SQLListForeignKeys():new( oConnection )
nSuccess := oCursor:execute(,,,,,__TABLE)
case i == 5
oCursor := SQLListPrimaryKeys():new( oConnection )
nSuccess := oCursor:execute(,,__TABLE)
case i == 6
oCursor := SQLListProcedureColumns():new( oConnection )
nSuccess := oCursor:execute()
case i == 7
oCursor := SQLListProcedures():new( oConnection )
nSuccess := oCursor:execute()
case i == 8
oCursor := SQLListSpecialColumns():new( oConnection )
nSuccess := oCursor:execute(,,,__TABLE)
case i == 9
oCursor := SQLListStatistics():new( oConnection )
nSuccess := oCursor:execute(,,__TABLE)
case i == 10
oCursor := SQLListTablePrivileges():new( oConnection )
nSuccess := oCursor:execute()
case i == 11
oCursor := SQLListTables():new( oConnection )
nSuccess := oCursor:execute()
case i == 12
oCursor := SQLListTypeInfo():new( oConnection )
nSuccess := oCursor:execute()
endcase
oConnection:displayErrors := .f.
oXbp:destroy()
if nSuccess == SQL_XPP_ERROR
if ValType(oDlg:browse)=="O"
oDlg:browse:show()
endif
Return .f.
endif
oDlg:setTitle("SQLExpress Demo: " + cTitle )
oDlg:createBrowse( oCursor )
Return .t.
//-----------------------------------------------------------------------------
CLASS xt_BrowseDialog FROM XbpDialog, SQLBrowse
PROTECTED:
CLASS VAR cRegSubKey
CLASS VAR aOptions
VAR ButtonMgr
EXPORTED:
CLASS METHOD initClass
METHOD init, create, resize, close, saveOptions, createBrowse
VAR browse
ENDCLASS
//-----------------------------------------------------------------------------
CLASS METHOD xt_BrowseDialog:initClass
::cRegSubKey := "Software\" + Left(AppName(), At(".", AppName())-1)
::aOptions := xt_RegQuery( HKEY_LOCAL_MACHINE, ::cRegSubKey, ::ClassName() )
if ValType(::aOptions) != "A" .or. Len(::aOptions) != 2
::aOptions := {nil, nil}
endif
Return self
//-----------------------------------------------------------------------------
METHOD xt_BrowseDialog:SaveOptions()
if ::getFrameState() != XBPDLG_FRAMESTAT_MINIMIZED
::aOptions := { ::currentPos(), ::currentSize() }
xt_RegWrite( HKEY_LOCAL_MACHINE, ::cRegSubKey, ::ClassName(), ::aOptions )
endif
Return self
//-----------------------------------------------------------------------------
METHOD xt_BrowseDialog:init( oParent, oOwner, aPos, aSize, aPP, lVisible, cTitle )
DEFAULT oParent TO AppDesktop()
DEFAULT aSize TO {600,440}
DEFAULT aPos TO xt_CenterBox(aSize, AppDeskTop())
DEFAULT lVisible TO .F.
DEFAULT aPP TO {}
// Saved values from previous session
if ValType( ::aOptions[1] ) == "A"
aPos := ::aOptions[1]
endif
if ValType( ::aOptions[2] ) == "A"
aSize := ::aOptions[2]
endif
AAdd( aPP, { XBP_PP_BGCLR , GRA_CLR_PALEGRAY } )
AAdd( aPP, { XBP_PP_COMPOUNDNAME, FONT_HELV_SMALL } )
::XbpDialog:init( oParent, oOwner, aPos, aSize, aPP, lVisible )
::XbpDialog:drawingArea:ColorBG := GRA_CLR_PALEGRAY
::XbpDialog:taskList := .T.
::XbpDialog:title := cTitle
::drawingArea:clipChildren := .T.
::buttonMgr := GroupManager():new( ::drawingArea,, {60,24} ):create()
::buttonMgr:maxDistance := 24
Return self
//-----------------------------------------------------------------------------
METHOD xt_BrowseDialog:create( oParent, oOwner, aPos, aSize, aPP, lVisible )
LOCAL aMinSize
::XbpDialog:create( oParent, oOwner, aPos, aSize, aPP, lVisible )
::buttonMgr:addButton( "Refresh", {|| ::browse:dataLink:refresh(), ::browse:refreshAll()}, .T., .T. )
::buttonMgr:addButton( "Close" , {||PostAppEvent(xbeP_Close,,,self)}, .T., .T. )
::buttonMgr:setPos( {0,8} )
aMinSize := ::buttonMgr:minSize()
aMinSize[1] += 8
aMinSize[2] += 98
aMinSize := ::calcFrameRect( { 0, 0, aMinSize[1], aMinSize[2] } )
::minSize := { aMinSize[3], aMinSize[4] }
aSize := ::currentSize()
aSize[1] := Max( aSize[1], aMinSize[1] )
aSize[2] := Max( aSize[2], aMinSize[2] )
// this results in a resize event and :resize() is called in turn
::xbpDialog:setSize( aSize )
Return self
//-----------------------------------------------------------------------------
METHOD xt_BrowseDialog:createBrowse(dataLink, aColumns, aColumnsLen)
LOCAL aSize := ::drawingArea:currentSize()
if ValType(::browse)=="O"
::browse:dataLink:destroy() // drop the previous SQL cursor
::browse:destroy() // destroy the previous SqlBrowse object
endif
::browse := SQLBrowse():new(::drawingArea,, {4,44},{aSize[1]-8,aSize[2]-48},,.f., dataLink, aColumns, aColumnsLen)
::browse:tabStop := .t.
::browse:create()
::drawingArea:invalidateRect()
::browse:show()
SetAppFocus( ::browse )
Return self
//-----------------------------------------------------------------------------
METHOD xt_BrowseDialog:close
::saveOptions():hide()
::destroy()
PostAppEvent(xbeU_Quit,,,self)
Return .t.
//-----------------------------------------------------------------------------
METHOD xt_BrowseDialog:resize
LOCAL aSize := ::drawingArea:currentSize()
::buttonMgr:center( aSize[1] )
aSize:= { aSize[1]-8, aSize[2] - 48 }
::browse:setSize( aSize, .F. )
::drawingArea:invalidateRect()
Return self
//-----------------------------------------------------------------------------
FUNCTION xt_CenterBox( aSize, oParent )
Local aParSize
DEFAULT oParent TO SetAppWindow()
aParSize := oParent:currentSize()
Return { Max(Int((aParSize[1]-aSize[1])/2),0), Max(Int((aParSize[2]-aSize[2])/2),0) }
//-----------------------------------------------------------------------------
PROCEDURE xt_ClearAppEvent()
While AppEvent(,,,1) != 0; end
Return
//-----------------------------------------------------------------------------
FUNCTION xt_MPointerWait( oParent, nPointer )
Local oXbp
DEFAULT oParent TO SetAppWindow()
DEFAULT nPointer TO XBPSTATIC_SYSICON_WAIT
oXbp := XbpStatic():new(oParent,nil,{0,0},oParent:currentSize(),nil,.t.)
oXbp:create()
oXbp:setPointer(nil, nPointer, XBPWINDOW_POINTERTYPE_SYSPOINTER)
Return oXbp
//----------------------------------------------------------------------------
FUNCTION xt_RegQuery( nHKey, cSubKey, cEntryName )
Local xValue, cValue
Local nKeyHandle := 0
Local nSize := 0
Local nType := 0
Local nDllHandle := DllLoad( "ADVAPI32.DLL" )
if nDllHandle = 0
Return Nil
endif
if DllCall( nDllHandle, DLL_STDCALL, "RegOpenKeyExA", nHKey, @cSubKey, 0, KEY_QUERY_VALUE, @nKeyHandle) = 0
DllCall( nDllHandle, DLL_STDCALL, "RegQueryValueExA", nKeyHandle, @cEntryName, 0, @nType, 0, @nSize)
if nSize > 0
cValue := Space( nSize )
if DllCall( nDllHandle, DLL_STDCALL, "RegQueryValueExA", nKeyHandle, @cEntryName, 0, @nType, @cValue, @nSize) = 0
do case
case nType == REG_SZ ; xValue := Trim(StrTran( cValue ,Chr(0), ""))
case nType == REG_DWORD ; xValue := Bin2L( cValue )
case nType == REG_BINARY; xValue := Bin2Var( cValue )
endcase
endif
endif
DllCall( nDllHandle, DLL_STDCALL, "RegCloseKey", nKeyHandle )
endif
DllUnload( nDllHandle )
Return xValue
//----------------------------------------------------------------------------
FUNCTION xt_RegWrite( nHKey, cSubKey, cEntryName, xValue )
Local nSuccess, nSize, nType
Local nKeyHandle := 0
Local nDisposition := 0
Local nDllHandle := DllLoad( "ADVAPI32.DLL" )
if nDllHandle = 0
Return .f.
endif
if DllCall( nDllHandle, DLL_STDCALL, "RegCreateKeyExA", nHKey, ;
@cSubKey, 0, "", REG_OPTION_NON_VOLATILE, ;
KEY_ALL_ACCESS , 0, @nKeyHandle, @nDisposition ) = 0
do case
case xValue == Nil
nSize := 0
nType := REG_NONE
case ValType( xValue ) == "C"
nSize := Len(xValue) + 1
nType := REG_SZ
case ValType( xValue ) == "N"
xValue := L2Bin( xValue )
nSize := 4
nType := REG_DWORD
otherwise
xValue := Var2Bin( xValue )
nSize := Len( xValue )
nType := REG_BINARY
endcase
nSuccess := DllCall( nDllHandle, DLL_STDCALL, "RegSetValueExA", ;
nKeyHandle, @cEntryName, 0, nType , @xValue, nSize )
DllCall( nDllHandle, DLL_STDCALL, "RegCloseKey", nKeyHandle )
endif
DllUnload( nDllHandle )
Return nSuccess = 0
//-----------------------------------------------------------------------------
// SQLBrowse
//-----------------------------------------------------------------------------
CLASS SQLBrowse FROM XbpBrowse
VAR aCols, aColLen
METHOD FieldBlock
EXPORTED:
VAR dataLink
METHOD init, create
ENDCLASS
//-----------------------------------------------------------------------------
METHOD SQLBrowse:init( oParent, oOwner, aPos, aSize, aPP, lVisible, oCursor, aColumns, aColumnsLen )
DEFAULT aPP TO {{ XBP_PP_COL_DA_HILITE_FGCLR, GRA_CLR_WHITE },;
{ XBP_PP_COL_DA_HILITE_BGCLR, GRA_CLR_BLUE } }
::xbpBrowse:Init( oParent, oOwner, aPos, aSize, aPP, lVisible )
::aCols := aColumns
::aColLen := if(aColumnsLen==nil, if(aColumns==nil,nil, ARRAY(Len(aColumns))), aColumnsLen )
::dataLink := oCursor
::skipBlock := {|n| ::dataLink:Skipper(n) }
::goTopBlock := {| | ::dataLink:goTop() }
::goBottomBlock := {| | ::dataLink:goBottom() }
::phyPosBlock := {|n| iif(ValType(n)!="N", ::dataLink:RecNo(), ::dataLink:goTo(n)) }
// Navigation blocks for VScroll bar
::posBlock := {|| ::dataLink:RecNo() }
::lastPosBlock := {|| ::dataLink:RecCount() }
::firstPosBlock := {|| 1 }
::vScroll := .T.
::softTrack := .T.
Return self
//-----------------------------------------------------------------------------
METHOD SQLBrowse:create()
Local i, nCols, xItem, oCol
::xbpBrowse:create()
if ::aCols == Nil
nCols := ::dataLink:FCount
for i := 1 to nCols
oCol := ::addColumn( ::FieldBlock(i), , ::dataLink:FieldName(i))
next
else
nCols := Len(::aCols)
for i := 1 to nCols
xItem := ::aCols[i]
do case
case ValType( xItem ) $ "NC"
::addColumn( ::FieldBlock(xItem), ::aColLen[i] , ::dataLink:FieldName(xItem))
case ValType( xItem ) == "O"
::addColumn( xItem )
case ValType( xItem ) == "A"
if Len(xItem) > 2
// { nArrayElement, cHeader, cFooter }
::addColumn( ::FieldBlock(xItem[1]), ::aColLen[i] , xItem[2], xItem[3])
else
// { nArrayElement, cHeader }
::addColumn( ::FieldBlock(xItem[1]), ::aColLen[i] , xItem[2])
endif
endcase
next
endif
Return self
//-----------------------------------------------------------------------------
METHOD SQLBrowse:FieldBlock( nField )
Return {|x| iif(PCount()==0, ::dataLink:fieldGet(nField), ::dataLink:fieldPut(nField, x))}
Back to main menu
Top of page