New AdoRDD (free)

[digicad]

I suggest first create ADO Connection, this connection we can use in ADO
Recordsets (in dBase terminology TABLE ), second parameter is string or ADO
Connection object. If we create connection object we can use
cnn:Execute("Select * FROM Table"), cnn:Errors and open method of recordsets
is fast.

My suggestion:
ADORDD.CH
#ifndef _ADORDD_CH
#define _ADORDD_CH

// Cursor Type
#define adOpenForwardOnly 0
#define adOpenKeyset 1
#define adOpenDynamic 2
#define adOpenStatic 3

// Lock Types
#define adLockReadOnly 1
#define adLockPessimistic 2
#define adLockOptimistic 3
#define adLockBatchOptimistic 4

// Field Types
#define adEmpty 0
#define adTinyInt 16
#define adSmallInt 2
#define adInteger 3
#define adBigInt 20
#define adUnsignedTinyInt 17
#define adUnsignedSmallInt 18
#define adUnsignedInt 19
#define adUnsignedBigInt 21
#define adSingle 4
#define adDouble 5
#define adCurrency 6
#define adDecimal 14
#define adNumeric 131
#define adBoolean 11
#define adError 10
#define adUserDefined 132
#define adVariant 12
#define adIDispatch 9
#define adIUnknown 13
#define adGUID 72
#define adDate 7
#define adDBDate 133
#define adDBTime 134
#define adDBTimeStamp 135
#define adBSTR 8
#define adChar 129
#define adVarChar 200
#define adLongVarChar 201
#define adWChar 130
#define adVarWChar 202
#define adLongVarWChar 203
#define adBinary 128
#define adVarBinary 204
#define adLongVarBinary 205
#define adChapter 136
#define adFileTime 64
#define adPropVariant 138
#define adVarNumeric 139
#define adArray // &H2000

#define adRecDeleted 4

#define adUseNone 1
#define adUseServer 2
#define adUseClient 3
#define adUseClientBatch 3

#command USE <(db)> [VIA <rdd>] [ALIAS <a>] [<nw: NEW>] ;
[<ex: EXCLUSIVE>] [<sh: SHARED>] [<ro: READONLY>] ;
[CODEPAGE <cp>] [INDEX <(index1)> [, <(indexN)>]] ;
[ TABLE <cTable> ] ;
[ QUERY <cQuery> ] ;
[ CONNECTION <cnn> ]=> ;
[ HB_AdoSetTable( <cTable> ) ; ] ;
[ HB_AdoSetQuery( <cQuery> ) ; ] ;
[ HB_AdoSetConnection( <cnn> ) ; ] ;
dbUseArea( <.nw.>, <rdd>, <(db)>, <(a)>, ;
if(<.sh.> .or. <.ex.>, !<.ex.>, NIL), <.ro.> [, <cp>] ) ;
[; dbSetIndex( <(index1)> )] ;
[; dbSetIndex( <(indexN)> )]

#command OPEN CONNECTION <ConnectionString> TO <cnn> => <cnn> := HB_ADOOpenConnection( <ConnectionString> )
#command SET CONNECTION TO <cnn> => <cnn> := HB_ADOSetConnection( <cnn> )

#endif

ADORDD.PRG

#include "rddsys.ch"
#include "hbusrrdd.ch"
#include "fileio.ch"
#include "error.ch"
#include "adordd.ch"
#include "common.ch"

ANNOUNCE ADORDD

static s_cTableName, s_cEngine, s_cServer, s_cUserName, s_cPassword, s_cConnection, cnn
static s_cQuery := "SELECT * FROM "

STATIC FUNCTION ADO_INIT( nRDD )

LOCAL aRData := ARRAY( 10 )

AFILL( aRData, -1 )
USRRDD_RDDDATA( nRDD, aRData )

RETURN SUCCESS

STATIC FUNCTION ADO_NEW( pWA )

LOCAL aWData := { -1, .F., .F. }

USRRDD_AREADATA( pWA, aWData )

RETURN SUCCESS

STATIC FUNCTION ADO_CREATE( nWA, aOpenInfo )

/*
LOCAL oError := ErrorNew()

oError:GenCode := EG_CREATE
oError:SubCode := 1004
oError:Description := HB_LANGERRMSG( EG_CREATE ) + " (" + ;
HB_LANGERRMSG( EG_UNSUPPORTED ) + ")"
oError:FileName := aOpenInfo[ UR_OI_NAME ]
oError:CanDefault := .T.
UR_SUPER_ERROR( nWA, oError )
*/

RETURN FAILURE

STATIC FUNCTION ADO_OPEN( nWA, aOpenInfo )

LOCAL cName, nMode, nSlot, nHandle, aRData, aWData, aField, oError, nResult
LOCAL oADO, nTotalFields := 0, i := 1

// When there is no ALIAS we will create new one using file name
IF aOpenInfo[ UR_OI_ALIAS ] == NIL
HB_FNAMESPLIT( aOpenInfo[ UR_OI_NAME ], , @cName )
aOpenInfo[ UR_OI_ALIAS ] := cName
ENDIF

nMode := IIF( aOpenInfo[ UR_OI_SHARED ], FO_SHARED , FO_EXCLUSIVE ) + ;
IIF( aOpenInfo[ UR_OI_READONLY ], FO_READ, FO_READWRITE )

aRData := USRRDD_RDDDATA( USRRDD_ID( nWA ) )
aWData := USRRDD_AREADATA( nWA )
nSlot := ASCAN( aRData, -1 )

IF nSlot == 0
oError := ErrorNew()
oError:GenCode := EG_OPEN
oError:SubCode := 1000
oError:Description := HB_LANGERRMSG( EG_OPEN ) + ", no free slots"
oError:FileName := aOpenInfo[ UR_OI_NAME ]
oError:CanDefault := .T.
UR_SUPER_ERROR( nWA, oError )
RETURN FAILURE
ENDIF

oADO := TOleAuto():New( "ADODB.Recordset" )
oAdo:CursorType = adOpenStatic
oAdo:CursorLocation = adUseClient
oAdo:LockType = adLockPessimistic
oADO:Open( s_cQuery + s_cTableName, cnn )

/*
do case
case Lower( Right( aOpenInfo[ UR_OI_NAME ], 4 ) ) == ".mdb"
oADO:Open( s_cQuery + s_cTableName,;
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + aOpenInfo[ UR_OI_NAME ],;
adOpenKeyset, adLockOptimistic )

case s_cEngine == "MYSQL"
oAdo:CursorType = adOpenStatic
oAdo:CursorLocation = adUseClient
oAdo:LockType = adLockPessimistic
oAdo:Open( s_cQuery + s_cTableName,;
"DRIVER={MySQL ODBC 3.51 Driver};" + ;
"server=" + s_cServer + ;
";database=" + aOpenInfo[ UR_OI_NAME ] + ;
";uid=" + s_cUserName + ;
";pwd=" + s_cPassword, adOpenKeyset, adLockOptimistic )

case s_cEngine == "SQL"
oAdo:CursorType = adOpenStatic
oAdo:CursorLocation = adUseClient
oAdo:LockType = adLockPessimistic
oAdo:Open( s_cQuery + s_cTableName,;
"Provider=SQLOLEDB;" + ;
"server=" + s_cServer + ;
";database=" + aOpenInfo[ UR_OI_NAME ] + ;
";uid=" + s_cUserName + ;
";pwd=" + s_cPassword, adOpenKeyset, adLockOptimistic )
case s_cEngine == "ORACLE"
oAdo:CursorType = adOpenStatic
oAdo:CursorLocation = adUseClient
oAdo:LockType = adLockPessimistic
oAdo:Open( s_cQuery + s_cTableName,;
"Provider=MSDAORA.1;" + ;
"Persist Security Info=False" + ;
IIF( s_cServer == NIL .OR. s_cServer == "", "", ";Data source=" + s_cServer ) + ;
";User ID=" + s_cUserName + ;
+";Password=" + s_cPassword, adOpenKeyset, adLockOptimistic )


endcase
*/

IF oADO == NIL
oError := ErrorNew()
oError:GenCode := EG_OPEN
oError:SubCode := 1001
oError:Description := HB_LANGERRMSG( EG_OPEN )
oError:FileName := aOpenInfo[ UR_OI_NAME ]
oError:OsCode := fError()
oError:CanDefault := .T.

UR_SUPER_ERROR( nWA, oError )
RETURN FAILURE
ENDIF

aRData[ nSlot ] := oADO
aWData[ 1 ] := oADO
aWData[ 2 ] := aWData[ 3 ] := .F.

nTotalFields := oADO:Fields:Count

UR_SUPER_SETFIELDEXTENT( nWA, oADO:Fields:Count )

FOR i = 1 TO nTotalFields
aField := ARRAY( UR_FI_SIZE )
aField[ UR_FI_NAME ] := oADO:Fields( i - 1 ):Name
aField[ UR_FI_TYPE ] := ADO_GETFIELDTYPE( oADO:Fields( i - 1 ):Type )
aField[ UR_FI_TYPEEXT ] := 0
aField[ UR_FI_LEN ] := ADO_GETFIELDSIZE( aField[ UR_FI_TYPE ], oADO:Fields( i - 1 ):DefinedSize )// 80 // set any arbitrary length - the real size will be differ
aField[ UR_FI_DEC ] := 0
UR_SUPER_ADDFIELD( nWA, aField )
NEXT

nResult := UR_SUPER_OPEN( nWA, aOpenInfo )

IF nResult == SUCCESS
ADO_GOTOP( nWA )
ENDIF

RETURN nResult

STATIC FUNCTION ADO_CLOSE( nWA )

LOCAL aRData, oADO := USRRDD_AREADATA( nWA )[ 1 ]

oADO:Close()

aRData := USRRDD_RDDDATA( USRRDD_ID( nWA ) )

RETURN UR_SUPER_CLOSE( nWA )

STATIC FUNCTION ADO_GETVALUE( nWA, nField, xValue )

LOCAL aWData := USRRDD_AREADATA( nWA )
LOCAL oADO := USRRDD_AREADATA( nWA )[ 1 ]

IF aWData[ 3 ]
xValue := ""
ELSE
xValue := oADO:Fields( nField - 1 ):Value
ENDIF

RETURN SUCCESS

STATIC FUNCTION ADO_GOTO( nWA, nRecord )

/*
LOCAL aWData := USRRDD_AREADATA( nWA )
LOCAL oADO := aWData[ 1 ]

IF nRecord <= 0
aWData[ 2 ] := aWData[ 3 ] := .T.
ELSEIF nRecord == 1
oADO:MoveFirst()
aWData[ 2 ] := aWData[ 3 ] := HB_FEOF()
ELSE
//HB_FSKIP(0) // Clear the EOF flag inside HB_F* engin
// - it's not done automatically in HB_FGOBOTTOM()
//HB_FGOTO( nRecord )
oADO:Move( nRecord )
aWData[ 2 ] := HB_FRECNO() == 0
aWData[ 3 ] := HB_FEOF()
ENDIF
*/
/*
LOCAL aWData := USRRDD_AREADATA( nWA )
HB_FSELECT( aWData[ 1 ] )
IF nRecord <= 0
aWData[ 2 ] := aWData[ 3 ] := .T.
ELSEIF nRecord == 1
HB_FGOTOP()
aWData[ 2 ] := aWData[ 3 ] := HB_FEOF()
ELSE
HB_FSKIP(0) // Clear the EOF flag inside HB_F* engin
// - it's not done automatically in HB_FGOBOTTOM()
HB_FGOTO( nRecord )
aWData[ 2 ] := HB_FRECNO() == 0
aWData[ 3 ] := HB_FEOF()
ENDIF

*/

RETURN SUCCESS

STATIC FUNCTION ADO_GOTOID( nWA, nRecord )

RETURN SUCCESS // ADO_GOTO( nWA, nRecord )

STATIC FUNCTION ADO_GOTOP( nWA )

local oADO := USRRDD_AREADATA( nWA )[ 1 ]

oADO:MoveFirst()
USRRDD_AREADATA( nWA )[ 2 ] = .f.
USRRDD_AREADATA( nWA )[ 3 ] = .f.

RETURN SUCCESS

STATIC FUNCTION ADO_GOBOTTOM( nWA )

local oADO := USRRDD_AREADATA( nWA )[ 1 ]

oADO:MoveLast()
USRRDD_AREADATA( nWA )[ 2 ] = .f.
USRRDD_AREADATA( nWA )[ 3 ] = .f.

RETURN SUCCESS

STATIC FUNCTION ADO_SKIPRAW( nWA, nRecords )

LOCAL aWData, oADO

IF nRecords != 0
aWData := USRRDD_AREADATA( nWA )
oADO := aWData[ 1 ]
IF aWData[ 3 ]
IF nRecords > 0
RETURN SUCCESS
ENDIF
ADO_GOBOTTOM( nWA )
++nRecords
ENDIF
IF nRecords < 0 .AND. oADO:AbsolutePosition <= -nRecords
oADO:MoveFirst()
aWData[ 2 ] := .T.
aWData[ 3 ] := oADO:EOF
ELSEIF nRecords != 0
oADO:Move( nRecords )
aWData[ 2 ] := .F.
aWData[ 3 ] := oADO:EOF
ENDIF
ENDIF

RETURN SUCCESS

STATIC FUNCTION ADO_BOF( nWA, lBof )

LOCAL aWData := USRRDD_AREADATA( nWA )

lBof := aWData[ 2 ]

RETURN SUCCESS

STATIC FUNCTION ADO_EOF( nWA, lEof )

local oADO := USRRDD_AREADATA( nWA )[ 1 ]

lEof := ( oADO:AbsolutePosition == -3 ) // lEof := aWData[ 3 ]

RETURN SUCCESS

STATIC FUNCTION ADO_DELETED( nWA, lDeleted )

local oADO := USRRDD_AREADATA( nWA )[ 1 ]

IF oADO:Status == adRecDeleted // To be checked, ACCESS does not uses it
lDeleted := .T.
ELSE
lDeleted := .F.
ENDIF

RETURN SUCCESS

STATIC FUNCTION ADO_DELETE( nWA )

local oADO := USRRDD_AREADATA( nWA )[ 1 ]

oADO:Delete()

ADO_SKIPRAW( nWA, 1 )

RETURN SUCCESS

STATIC FUNCTION ADO_RECID( nWA, nRecNo )

local oADO := USRRDD_AREADATA( nWA )[ 1 ]

nRecno := If( oADO:AbsolutePosition == -3, oAdo:RecordCount + 1, oAdo:AbsolutePosition )

RETURN SUCCESS

STATIC FUNCTION ADO_RECCOUNT( nWA, nRecords )

local oADO := USRRDD_AREADATA( nWA )[ 1 ]

nRecords := oADO:RecordCount

RETURN SUCCESS

STATIC FUNCTION ADO_PUTVALUE( nWA, nField, xValue )

LOCAL aWData := USRRDD_AREADATA( nWA )
LOCAL oADO := USRRDD_AREADATA( nWA )[ 1 ]

IF aWData[ 3 ]
xValue := ""
ELSE
oADO:Fields( nField - 1 ):Value := xValue
oADO:Update()
ENDIF

RETURN SUCCESS

STATIC FUNCTION ADO_LOCATE( nWA, lContinue )

local oADO := USRRDD_AREADATA( nWA )[ 1 ]

// not implemented yet

RETURN SUCCESS

STATIC FUNCTION ADO_SETLOCATE( nWA, aDBScopeInfo )

local oADO := USRRDD_AREADATA( nWA )[ 1 ]

// not implemented yet

RETURN SUCCESS

STATIC FUNCTION ADO_APPEND( nWA, lUnLockAll )

local oADO := USRRDD_AREADATA( nWA )[ 1 ]

oADO:AddNew()
oADO:Update() // keep it here, or there is an ADO error

RETURN SUCCESS

STATIC FUNCTION ADO_FLUSH( nWA )

local oADO := USRRDD_AREADATA( nWA )[ 1 ]

oADO:Update()

RETURN SUCCESS

STATIC FUNCTION ADO_ORDINFO( nWA, iIndex, aOrderInfo )

local oADO := USRRDD_AREADATA( nWA )[ 1 ]

RETURN SUCCESS // aOrderInfo[ iIndex ]

STATIC FUNCTION ADO_PACK( nWA )

local oADO := USRRDD_AREADATA( nWA )[ 1 ]

RETURN SUCCESS

STATIC FUNCTION ADO_RAWLOCK( nWA, nAction, nRecNo )

local oADO := USRRDD_AREADATA( nWA )[ 1 ]

RETURN SUCCESS

STATIC FUNCTION ADO_LOCK( nWA, aLockInfo )

local oADO := USRRDD_AREADATA( nWA )[ 1 ]

aLockInfo[ UR_LI_METHOD ] := DBLM_MULTIPLE
aLockInfo[ UR_LI_RECORD ] := RECNO()
aLockInfo[ UR_LI_RESULT ] := .T.

RETURN SUCCESS

STATIC FUNCTION ADO_UNLOCK( nWA, xRecID )

local oADO := USRRDD_AREADATA( nWA )[ 1 ]

RETURN SUCCESS

FUNCTION ADORDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID )

LOCAL cSuperRDD := NIL /* NO SUPER RDD */
LOCAL aMyFunc[ UR_METHODCOUNT ]

aMyFunc[ UR_INIT ] := ( @ADO_INIT() )
aMyFunc[ UR_NEW ] := ( @ADO_NEW() )
aMyFunc[ UR_CREATE ] := ( @ADO_CREATE() )
aMyFunc[ UR_OPEN ] := ( @ADO_OPEN() )
aMyFunc[ UR_CLOSE ] := ( @ADO_CLOSE() )
aMyFunc[ UR_BOF ] := ( @ADO_BOF() )
aMyFunc[ UR_EOF ] := ( @ADO_EOF() )
aMyFunc[ UR_DELETED ] := ( @ADO_DELETED() )
aMyFunc[ UR_SKIPRAW ] := ( @ADO_SKIPRAW() )
aMyFunc[ UR_GOTO ] := ( @ADO_GOTO() )
aMyFunc[ UR_GOTOID ] := ( @ADO_GOTOID() )
aMyFunc[ UR_GOTOP ] := ( @ADO_GOTOP() )
aMyFunc[ UR_GOBOTTOM ] := ( @ADO_GOBOTTOM() )
aMyFunc[ UR_RECID ] := ( @ADO_RECID() )
aMyFunc[ UR_RECCOUNT ] := ( @ADO_RECCOUNT() )
aMyFunc[ UR_GETVALUE ] := ( @ADO_GETVALUE() )
aMyFunc[ UR_PUTVALUE ] := ( @ADO_PUTVALUE() )
aMyFunc[ UR_DELETE ] := ( @ADO_DELETE() )
aMyFunc[ UR_LOCATE ] := ( @ADO_LOCATE() )
aMyFunc[ UR_SETLOCATE ]:= ( @ADO_SETLOCATE() )
aMyFunc[ UR_APPEND ] := ( @ADO_APPEND() )
aMyFunc[ UR_FLUSH ] := ( @ADO_FLUSH() )
aMyFunc[ UR_ORDINFO ] := ( @ADO_ORDINFO() )
aMyFunc[ UR_PACK ] := ( @ADO_PACK() )
aMyFunc[ UR_RAWLOCK ] := ( @ADO_RAWLOCK() )
aMyFunc[ UR_LOCK ] := ( @ADO_LOCK() )
aMyFunc[ UR_UNLOCK ] := ( @ADO_UNLOCK() )

RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ;
cSuperRDD, aMyFunc )

INIT PROC ADORDD_INIT()
rddRegister( "ADORDD", RDT_FULL )
RETURN

STATIC FUNCTION ADO_GETFIELDSIZE( nDBFTypeField, nADOFielSize )

LOCAL nDBFFieldSize := 0

DO CASE

CASE nDBFTypeField == HB_FT_STRING
nDBFFieldSize := nADOFielSize

CASE nDBFTypeField == HB_FT_INTEGER
nDBFFieldSize := nADOFielSize

CASE nDBFTypeField == HB_FT_DATE
nDBFFieldSize := 8

CASE nDBFTypeField == HB_FT_LOGICAL
nDBFFieldSize := 1

ENDCASE

RETURN nDBFFieldSize

STATIC FUNCTION ADO_GETFIELDTYPE( nADOFielfType )

LOCAL nDBFTypeField := 0

DO CASE

CASE nADOFielfType == adEmpty // 0
CASE nADOFielfType == adTinyInt // 16
CASE nADOFielfType == adSmallInt // 2
CASE nADOFielfType == adInteger // 3
nDBFTypeField := HB_FT_INTEGER

CASE nADOFielfType == adBigInt // 20
CASE nADOFielfType == adUnsignedTinyInt // 17
CASE nADOFielfType == adUnsignedSmallInt // 18
CASE nADOFielfType == adUnsignedInt // 19
CASE nADOFielfType == adUnsignedBigInt // 21
CASE nADOFielfType == adSingle // 4
CASE nADOFielfType == adDouble // 5
CASE nADOFielfType == adCurrency // 6
CASE nADOFielfType == adDecimal // 14
CASE nADOFielfType == adNumeric // 131
CASE nADOFielfType == adBoolean // 11
nDBFTypeField := HB_FT_LOGICAL

CASE nADOFielfType == adError // 10
CASE nADOFielfType == adUserDefined // 132
CASE nADOFielfType == adVariant // 12
CASE nADOFielfType == adIDispatch // 9
CASE nADOFielfType == adIUnknown // 13
CASE nADOFielfType == adGUID // 72
CASE nADOFielfType == adDate // 7
nDBFTypeField := HB_FT_DATE

CASE nADOFielfType == adDBDate // 133
CASE nADOFielfType == adDBTime // 134
CASE nADOFielfType == adDBTimeStamp // 135
CASE nADOFielfType == adBSTR // 8
CASE nADOFielfType == adChar // 129
// nDBFTypeField := HB_FT_STRING

CASE nADOFielfType == adVarChar // 200
// nDBFTypeField := HB_FT_STRING

CASE nADOFielfType == adLongVarChar // 201
// nDBFTypeField := HB_FT_STRING

CASE nADOFielfType == adWChar // 130
// nDBFTypeField := HB_FT_STRING

CASE nADOFielfType == adVarWChar // 202
nDBFTypeField := HB_FT_STRING

CASE nADOFielfType == adLongVarWChar // 203

CASE nADOFielfType == adBinary // 128
CASE nADOFielfType == adVarBinary // 204
CASE nADOFielfType == adLongVarBinary // 205
CASE nADOFielfType == adChapter // 136
CASE nADOFielfType == adFileTime // 64
CASE nADOFielfType == adPropVariant // 138
CASE nADOFielfType == adVarNumeric // 139
// CASE nADOFielfType == adArray &H2000

ENDCASE

RETURN nDBFTypeField

function HB_AdoSetQuery( cQuery )

DEFAULT cQuery TO ""

s_cQuery := cQuery
IF LEN(s_cQuery) > 0
s_cTableName := ""
ENDIF

return nil

function HB_AdoSetTable( cTableName )

DEFAULT cTableName TO ""

IF LEN(cTableName) > 0
s_cQuery := ""
s_cTableName := "SELECT * FROM "+cTableName
ELSE
s_cTableName := ""
ENDIF
return nil

FUNCTION HB_AdoOpenConnection( cConnectionString )
cnn := TOleAuto():New( "ADODB.Connection" )
cnn:Open( cConnectionString )
RETURN cnn

FUNCTION HB_AdoSetConnection( db )
cnn := db
RETURN NIL

[digicad]

#include "adordd.ch"

REQUEST ADORDD

function Main()
LOCAL db


/*
// Example for creation of Oracle connection string
cDataSource := ""
cUserID := "digi"
cPassword := "digi"
OPEN CONNECTION "Provider=MSDAORA.1;Persist Security Info=False"+IIF( cDataSource == "", "", ";Data source=" + cDataSource ) + ";User ID=" + cUserID + ";Password=" + cPassword TO db
USE NewQuery VIA "ADORDD" QUERY "SELECT Objekat# AS Sifra, Naziv, NVL(X,0) AS XCOOR, NVL(Y,0) AS YCOOR FROM Objekat ORDER BY Sifra" NEW
*/



// Example for creation of MySQL connection string
cServer := "www.freesql.org"
cUserID := "myuser"
cPassword := "mypass"
cDatabase := "test00"
OPEN CONNECTION "DRIVER={MySQL ODBC 3.51 Driver};database="+cDatabase+";server=" + cServer + ";uid=" + cUserID + ";pwd=" + cPassword TO db
USE Accounts VIA "ADORDD" TABLE "ACCOUNTS" NEW


/*
// Example for creation of Access connection string
cDatabase := "Test.MDB"
OPEN CONNECTION "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + cDataBase TO db
USE SampleAccess VIA "ADORDD" TABLE "Tabla1" NEW
*/

Browse()
CLOSE ALL

return nil

[Antonio Linares]

Srdjan,

Our first intention with the ADORDD is that a Harbour/xHarbour application may replace the used RDD for the ADORDD and the application automatically may work with a different databases engine like MySQL, MS SQL, Oracle, etc. with no changes or at least the minimum changes.

We can encapsulate the ADO connection objects inside the ADORDD itself, so they will be automatically created and may be accessed using DbOrdInfo() or another RDD standard function, for each workarea.

Actually we are planning and implementing the indexes management, later on we will go for the relations. As soon as possible we will automatically create and keep the ADO connections objects inside the ADORDD itself.

[digicad]

Antonio,

First excuse me for big messages

[Antonio Linares]

Srdjan,

You are welcome though we appreciate if you build a ZIP file, upload it to www.rapidshare.com or similar and just place here the download url, thanks

[Antonio Linares]

Srdjan,

With this recent ADORDD change now you don't have to care about ADO connections and catalogs as they are automatically created and managed by the ADORDD

Please notice that the samples source code remains the same

[NK]

Dear Antonio,

when i set an legal SQL Filter like

Code: Select all  Expand view  RUN

   SET FILTER TO "Status < 'D' AND Mandant = 1 AND (VB = 'AA' OR VB = 'WW')"


or

Code: Select all  Expand view  RUN

   SET FILTER TO "Status < 'D' AND Mandant = 1 AND VB IN ('AA','WW') "


an Error occured:

Error description: Error ADODB.Recordset/16389 E_FAIL: _FILTER

This is the Problem: (VB = 'AA' OR VB = 'WW')

Any Ideas ?

Regards Norbert

[Antonio Linares]

Norbert,

When you get an error ADODB.Recordset/16389 E_FAIL: _FILTER it means that the filter condition is not valid.

As we do some translations with the filter expression, please make this change in the ADORDD source code and check the expression that is shown:

Code: Select all  Expand view  RUN

STATIC FUNCTION ADO_SETFILTER( nWA, aInfo )

   local oADO := USRRDD_AREADATA( nWA )[ 1 ]
  local cFilter := aInfo[ 2 ]
     
  if Left( cFilter, 1 ) == '"' .and. Right( cFilter, 1 ) == '"'
     cFilter = SubStr( cFilter, 2, Len( cFilter ) - 2 )
  endif     
     
  cFilter = StrTran( cFilter, '""', "" )
  cFilter = StrTran( cFilter, '"', "'" )
  cFilter = StrTran( cFilter, "''", "'" )
  cFilter = StrTran( cFilter, "==", "=" )
  cFilter = StrTran( cFilter, ".and.", "AND" )
  cFilter = StrTran( cFilter, ".or.", "OR" )
  cFilter = StrTran( cFilter, ".AND.", "AND" )
  cFilter = StrTran( cFilter, ".OR.", "OR" )

   MsgInfo( cFilter )
   oADO:Filter = cFilter

RETURN SUCCESS


[NK]

Hello Antonio,

the Filter from MsgInfo is correct and in the normal query from sql-server or in your odbc-functions it works fine.

Code: Select all  Expand view  RUN

Application
===========
   Path and name: C:\FWH\ADO\ADO.Exe
   Size: 1,446,912 bytes
   Error occurred at: 04/30/07, 14:52:01
   Error description: Error ADODB.Recordset/16389  E_FAIL: _FILTER

   Args:
     [   1] = C   Status < 'D' AND Mandant = 1 AND (VB = 'NK' OR VB = 'BW')

Stack Calls
===========
   Called from TOLEAUTO:_FILTER(0)
   Called from ADO_SETFILTER(475)
   Called from DBSETFILTER(0)
   Called from MAIN(47)

[Antonio Linares]

Norbert,

Are you using Microsoft SQL server ?

[NK]

Norbert,

Are you using Microsoft SQL server ?

Yes. MS SQL 2000

[Antonio Linares]

Norbert,

Are "Status", "Mandant" and "VB" fieldnames ?

Are they written the same way (first upper and lower case) into the table ?

[NK]

Norbert,

Are "Status", "Mandant" and "VB" fieldnames ?

Are they written the same way (first upper and lower case) into the table ?

Yes, are Fieldnames and in the Query-String includet.

case is the same (in ADO Case-sensitive ???)

[NK]

Norbert,

works other filters to you with ADORDD and MSSQL?

other Filters works fine. but if i have OR this don´t work.

Example: You Have 2 Fields

STATUS and PERSON. You seek all records from STATUS = 'A' and from
PERSON AA or BB or CC, but only STATUS A

the Select string is:
SELECT FROM ADRESS WHERE STATUS = 'A' AND (PERSON = 'AA' OR PERSON = 'BB' OR PERSON = 'CC')
... ERROR _FILTER
or you write

SELECT FROM ADRESS WHERE STATUS = 'A' AND PERSON IN ('AA', 'BB', 'CC')
... ERROR _FILTER

on the ( or´s ) an IN () an Error occured.

If you write in the WHERE ...
WHERE STATUS = 'A' AND PERSON = 'AA' OR (STATUS = 'A' AND PERSON = 'BB' ) OR (STATUS = 'A' AND PERSON = 'CC' )
... it works. but all 3 ways are legal SQL Syntax.

[jlcapel]

Hi,

From Msdn

Filter Property
Indicates a filter for data in a Recordset.

Settings and Return Values
Sets or returns a Variant value, which can contain one of the following:

Criteria string — a string made up of one or more individual clauses concatenated with AND or OR operators.
Array of bookmarks — an array of unique bookmark values that point to records in the Recordset object.
A FilterGroupEnum value.
Remarks
Use the Filter property to selectively screen out records in a Recordset object. The filtered Recordset becomes the current cursor. Other properties that return values based on the current cursor are affected, such as AbsolutePosition, AbsolutePage, RecordCount, and PageCount. This is because setting the Filter property to a specific value will move the current record to the first record that satisfies the new value.

The criteria string is made up of clauses in the form FieldName-Operator-Value (for example, "LastName = 'Smith'"). You can create compound clauses by concatenating individual clauses with AND (for example, "LastName = 'Smith' AND FirstName = 'John'") or OR (for example, "LastName = 'Smith' OR LastName = 'Jones'"). Use the following guidelines for criteria strings:

FieldName must be a valid field name from the Recordset. If the field name contains spaces, you must enclose the name in square brackets.
Operator must be one of the following: <, >, <=, >=, <>, =, or LIKE.
Value is the value with which you will compare the field values (for example, 'Smith', #8/24/95#, 12.345, or $50.00). Use single quotes with strings and pound signs (#) with dates. For numbers, you can use decimal points, dollar signs, and scientific notation. If Operator is LIKE, Value can use wildcards. Only the asterisk (*) and percent sign (%) wild cards are allowed, and they must be the last character in the string. Value cannot be null.
Note To include single quotation marks (') in the filter Value, use two single quotation marks to represent one. For example, to filter on O'Malley, the criteria string should be "col1 = 'O''Malley'". To include single quotation marks at both the beginning and the end of the filter value, enclose the string with pound signs (#). For example, to filter on '1', the criteria string should be "col1 = #'1'#".
There is no precedence between AND and OR. Clauses can be grouped within parentheses. However, you cannot group clauses joined by an OR and then join the group to another clause with an AND, like this:
(LastName = 'Smith' OR LastName = 'Jones') AND FirstName = 'John'
Instead, you would construct this filter as
(LastName = 'Smith' AND FirstName = 'John') OR (LastName = 'Jones' AND FirstName = 'John')
In a LIKE clause, you can use a wildcard at the beginning and end of the pattern (for example, LastName Like '*mit*'), or only at the end of the pattern (for example, LastName Like 'Smit*').
The filter constants make it easier to resolve individual record conflicts during batch update mode by allowing you to view, for example, only those records that were affected during the last UpdateBatch method call.

Setting the Filter property itself may fail because of a conflict with the underlying data (for example, a record has already been deleted by another user). In such a case, the provider returns warnings to the Errors collection but does not halt program execution. A run-time error occurs only if there are conflicts on all the requested records. Use the Status property to locate records with conflicts.

Setting the Filter property to a zero-length string ("") has the same effect as using the adFilterNone constant.

Whenever the Filter property is set, the current record position moves to the first record in the filtered subset of records in the Recordset. Similarly, when the Filter property is cleared, the current record position moves to the first record in the Recordset.

See the Bookmark property for an explanation of bookmark values from which you can build an array to use with the Filter property.

Only Filters in the form of Criteria Strings (e.g. OrderDate > '12/31/1999') affect the contents of a persisted Recordset. Filters created with an Array of Bookmarks or using a value from the FilterGroupEnum will not affect the contents of the persisted Recordset. These rules apply to Recordsets created with either client-side or server-side cursors.

Note When you apply the adFilterPendingRecords flag to a filtered and modified Recordset in the batch update mode, the resultant Recordset is empty if the filtering was based on the key field of a single-keyed table and the modification was made on the key field values. The resultant Recordset will be non-empty if one of the following is true:
The filtering was based on non-key fields in a single-keyed table.
The filtering was based on any fields in a multiple-keyed table.
Modifications were made on non-key fields in a single-keyed table.
Modifications were made on any fields in a multiple-keyed table.
The following table summarizes the effects of adFilterPendingRecords in different combinations of filtering and modifications. The left column shows the possible modifications; modifications can be made on any of the non-keyed fields, on the key field in a single-keyed table, or on any of the key fields in a multiple-keyed table. The top row shows the filtering criterion; filtering can be based on any of the non-keyed fields, the key field in a single-keyed table, or any of the key fields in a multiple-keyed table. The intersecting cells show the results: + means that applying adFilterPendingRecords results

Regards,
José Luis Capel