c:\harbour\contrib\hbmysql
mysql.c |
Type | Function | Source | Line |
HB_FUNC | SQLVERSION(void)
HB_FUNC( SQLVERSION ) /* long mysql_get_server_version( MYSQL * ) */
{
#if MYSQL_VERSION_ID > 32399
hb_retnl( ( long ) mysql_get_server_version( ( MYSQL * ) HB_PARPTR( 1 ) ) );
#else
const char * szVer = mysql_get_server_info( ( MYSQL * ) HB_PARPTR( 1 ) );
long lVer = 0;
while( *szVer )
{
if( *szVer >= '0' && *szVer <= '9' )
lVer = lVer * 10 + *szVer;
szVer++;
}
hb_retnl( lVer );
#endif
}
| mysql.c | 81 |
HB_FUNC | SQLCONNECT(void)
HB_FUNC( SQLCONNECT ) /* MYSQL *mysql_real_connect(MYSQL*, char * host, char * user, char * password, char * db, uint port, char *, uint flags) */
{
const char * szHost = hb_parc( 1 );
const char * szUser = hb_parc( 2 );
const char * szPass = hb_parc( 3 );
#if MYSQL_VERSION_ID > 32200
MYSQL * mysql;
unsigned int port = ISNUM( 4 ) ? ( unsigned int ) hb_parni( 4 ) : MYSQL_PORT;
unsigned int flags = ISNUM( 5 ) ? ( unsigned int ) hb_parni( 5 ) : 0;
if( ( mysql = mysql_init( ( MYSQL * ) NULL ) ) != NULL )
{
/* from 3.22.x of MySQL there is a new parameter in mysql_real_connect() call, that is char * db
which is not used here */
if( mysql_real_connect( mysql, szHost, szUser, szPass, 0, port, NULL, flags ) )
HB_RETPTR( ( void * ) mysql );
else
{
mysql_close( mysql );
HB_RETPTR( NULL );
}
}
else
HB_RETPTR( NULL );
#else
HB_RETPTR( ( void * ) mysql_real_connect( NULL, szHost, szUser, szPass, 0, NULL, 0 ) );
#endif
}
| mysql.c | 99 |
HB_FUNC | SQLCLOSE(void)
HB_FUNC( SQLCLOSE ) /* void mysql_close(MYSQL *mysql) */
{
mysql_close( ( MYSQL * ) HB_PARPTR( 1 ) );
}
| mysql.c | 129 |
HB_FUNC | SQLCOMMIT(void)
HB_FUNC( SQLCOMMIT ) /* bool mysql_commit(MYSQL *mysql) */
{
#if MYSQL_VERSION_ID >= 40100
hb_retnl( ( long ) mysql_commit( ( MYSQL * ) HB_PARPTR( 1 ) ) );
#else
hb_retnl( ( long ) mysql_query( ( MYSQL * ) HB_PARPTR( 1 ), "COMMIT" ) );
#endif
}
| mysql.c | 134 |
HB_FUNC | SQLROLLBACK(void)
HB_FUNC( SQLROLLBACK ) /* bool mysql_rollback(MYSQL *mysql) */
{
#if MYSQL_VERSION_ID >= 40100
hb_retnl( ( long ) mysql_rollback( ( MYSQL * ) HB_PARPTR( 1 ) ) );
#else
hb_retnl( ( long ) mysql_query( ( MYSQL * ) HB_PARPTR( 1 ), "ROLLBACK" ) );
#endif
}
| mysql.c | 143 |
HB_FUNC | SQLSELECTD(void)
HB_FUNC( SQLSELECTD ) /* int mysql_select_db(MYSQL *, char *) */
{
hb_retnl( ( long ) mysql_select_db( ( MYSQL * ) HB_PARPTR( 1 ), ( const char * ) hb_parc( 2 ) ) );
}
| mysql.c | 152 |
HB_FUNC | SQLQUERY(void)
HB_FUNC( SQLQUERY ) /* int mysql_query(MYSQL *, char *) */
{
hb_retnl( ( long ) mysql_query( ( MYSQL * ) HB_PARPTR( 1 ), hb_parc( 2 ) ) );
}
| mysql.c | 157 |
HB_FUNC | SQLSTORER(void)
HB_FUNC( SQLSTORER ) /* MYSQL_RES *mysql_store_result( MYSQL * ) */
{
HB_RETPTR( ( void * ) mysql_store_result( ( MYSQL * ) HB_PARPTR( 1 ) ) );
}
| mysql.c | 162 |
HB_FUNC | SQLUSERES(void)
HB_FUNC( SQLUSERES ) /* MYSQL_RES *mysql_use_result( MYSQL * ) */
{
HB_RETPTR( ( void * ) mysql_use_result( ( MYSQL * ) HB_PARPTR( 1 ) ) );
}
| mysql.c | 167 |
HB_FUNC | SQLFREER(void)
HB_FUNC( SQLFREER ) /* void mysql_free_result(MYSQL_RES *) */
{
mysql_free_result( ( MYSQL_RES * ) HB_PARPTR( 1 ) );
}
| mysql.c | 172 |
HB_FUNC | SQLFETCHR(void)
HB_FUNC( SQLFETCHR ) /* MYSQL_ROW *mysql_fetch_row(MYSQL_RES *) */
{
MYSQL_RES * mresult = ( MYSQL_RES * ) HB_PARPTR( 1 );
int num_fields = mysql_num_fields( mresult );
PHB_ITEM aRow = hb_itemArrayNew( num_fields );
MYSQL_ROW mrow = mysql_fetch_row( mresult );
if( mrow )
{
int i;
for( i = 0; i < num_fields; i++ )
hb_arraySetC( aRow, i + 1, mrow[ i ] );
}
hb_itemReturnRelease( aRow );
}
| mysql.c | 177 |
HB_FUNC | SQLDATAS(void)
HB_FUNC( SQLDATAS ) /* void mysql_data_seek(MYSQL_RES *, unsigned int) */
{
mysql_data_seek( ( MYSQL_RES * ) HB_PARPTR( 1 ), ( unsigned int ) hb_parni( 2 ) );
}
| mysql.c | 194 |
HB_FUNC | SQLNROWS(void)
HB_FUNC( SQLNROWS ) /* my_ulongulong mysql_num_rows(MYSQL_RES *) */
{
hb_retnint( mysql_num_rows( ( ( MYSQL_RES * ) HB_PARPTR( 1 ) ) ) );
}
| mysql.c | 199 |
HB_FUNC | SQLFETCHF(void)
HB_FUNC( SQLFETCHF ) /* MYSQL_FIELD *mysql_fetch_field(MYSQL_RES *) */
{
/* NOTE: field structure of MySQL has 8 members as of MySQL 3.22.x */
PHB_ITEM aField = hb_itemArrayNew( 8 );
MYSQL_FIELD * mfield = mysql_fetch_field( ( MYSQL_RES * ) HB_PARPTR( 1 ) );
if( mfield )
{
hb_arraySetC( aField, 1, mfield->name );
hb_arraySetC( aField, 2, mfield->table );
hb_arraySetC( aField, 3, mfield->def );
hb_arraySetNL( aField, 4, ( long ) mfield->type );
hb_arraySetNL( aField, 5, mfield->length );
hb_arraySetNL( aField, 6, mfield->max_length );
hb_arraySetNL( aField, 7, mfield->flags );
hb_arraySetNL( aField, 8, mfield->decimals );
}
hb_itemReturnRelease( aField );
}
| mysql.c | 204 |
HB_FUNC | SQLFSEEK(void)
HB_FUNC( SQLFSEEK ) /* MYSQL_FIELD_OFFSET mysql_field_seek(MYSQL_RES *, MYSQL_FIELD_OFFSET) */
{
mysql_field_seek( ( MYSQL_RES * ) HB_PARPTR( 1 ), ( MYSQL_FIELD_OFFSET ) hb_parni( 2 ) );
}
| mysql.c | 225 |
HB_FUNC | SQLNUMFI(void)
HB_FUNC( SQLNUMFI ) /* unsigned int mysql_num_fields(MYSQL_RES *) */
{
hb_retnl( mysql_num_fields( ( ( MYSQL_RES * ) HB_PARPTR( 1 ) ) ) );
}
| mysql.c | 230 |
HB_FUNC | SQLFICOU(void)
HB_FUNC( SQLFICOU ) /* unsigned int mysql_field_count( MYSQL * ) */
{
hb_retnl( mysql_field_count( ( ( MYSQL * ) HB_PARPTR( 1 ) ) ) );
}
| mysql.c | 237 |
HB_FUNC | SQLLISTF(void)
HB_FUNC( SQLLISTF ) /* MYSQL_RES *mysql_list_fields(MYSQL *, char *); */
{
hb_retptr( mysql_list_fields( ( MYSQL * ) HB_PARPTR( 1 ), hb_parc( 2 ), NULL ) );
}
| mysql.c | 244 |
HB_FUNC | SQLGETERR(void)
HB_FUNC( SQLGETERR ) /* char *mysql_error( MYSQL * ); */
{
hb_retc( mysql_error( ( MYSQL * ) HB_PARPTR( 1 ) ) );
}
| mysql.c | 249 |
HB_FUNC | SQLLISTDB(void)
HB_FUNC( SQLLISTDB ) /* MYSQL_RES * mysql_list_dbs(MYSQL *, char * wild); */
{
MYSQL * mysql = ( MYSQL * ) HB_PARPTR( 1 );
MYSQL_RES * mresult = mysql_list_dbs( mysql, NULL );
long nr = ( long ) mysql_num_rows( mresult );
PHB_ITEM aDBs = hb_itemArrayNew( nr );
long i;
for( i = 0; i < nr; i++ )
{
MYSQL_ROW mrow = mysql_fetch_row( mresult );
hb_arraySetC( aDBs, i + 1, mrow[ 0 ] );
}
mysql_free_result( mresult );
hb_itemReturnRelease( aDBs );
}
| mysql.c | 254 |
HB_FUNC | SQLLISTTBL(void)
HB_FUNC( SQLLISTTBL ) /* MYSQL_RES * mysql_list_tables(MYSQL *, char * wild); */
{
MYSQL * mysql = ( MYSQL * ) HB_PARPTR( 1 );
char * cWild = hb_parc( 2 );
MYSQL_RES * mresult = mysql_list_tables( mysql, cWild );
long nr = ( long ) mysql_num_rows( mresult );
PHB_ITEM aTables = hb_itemArrayNew( nr );
long i;
for( i = 0; i < nr; i++ )
{
MYSQL_ROW mrow = mysql_fetch_row( mresult );
hb_arraySetC( aTables, i + 1, mrow[ 0 ] );
}
mysql_free_result( mresult );
hb_itemReturnRelease( aTables );
}
| mysql.c | 273 |
HB_FUNC | SQLAND(void)
HB_FUNC( SQLAND )
{
hb_retnl( hb_parnl( 1 ) & hb_parnl( 2 ) );
}
| mysql.c | 292 |
HB_FUNC | SQLAFFROWS(void)
HB_FUNC( SQLAFFROWS )
{
hb_retnl( ( long ) mysql_affected_rows( ( MYSQL * ) HB_PARPTR( 1 ) ) );
}
| mysql.c | 298 |
HB_FUNC | SQLHOSTINFO(void)
HB_FUNC( SQLHOSTINFO )
{
hb_retc( mysql_get_host_info( ( MYSQL * ) HB_PARPTR( 1 ) ) );
}
| mysql.c | 303 |
HB_FUNC | SQLSRVINFO(void)
HB_FUNC( SQLSRVINFO )
{
hb_retc( mysql_get_server_info( ( MYSQL * ) HB_PARPTR( 1 ) ) );
}
| mysql.c | 308 |
HB_FUNC | DATATOSQL(void)
HB_FUNC( DATATOSQL )
{
const char * from = hb_parc( 1 );
int iSize = hb_parclen( 1 );
char * buffer = ( char * ) hb_xgrab( iSize * 2 + 1 );
iSize = mysql_escape_string( buffer, from, iSize );
hb_retclen_buffer( ( char * ) buffer, iSize );
}
| mysql.c | 313 |
STATIC CHAR * | filetoBuff( char * fname, int * size )
static char * filetoBuff( char * fname, int * size )
{
char * buffer = NULL;
int handle = hb_fsOpen( ( BYTE * ) fname, FO_READWRITE );
if( handle != FS_ERROR )
{
*size = ( int ) hb_fsSeek( handle, 0, FS_END );
*size -= ( int ) hb_fsSeek( handle, 0, FS_SET );
buffer = ( char * ) hb_xgrab( * size + 1 );
*size = hb_fsReadLarge( handle, ( BYTE * ) buffer, *size );
buffer[ *size ] = '\0';
hb_fsClose( handle );
}
else
*size = 0;
return buffer;
}
| mysql.c | 322 |
HB_FUNC | FILETOSQLBINARY(void)
HB_FUNC( FILETOSQLBINARY )
{
int iSize;
char * from = filetoBuff( hb_parc( 1 ), &iSize );
if( from )
{
char *buffer = ( char * ) hb_xgrab( iSize * 2 + 1 );
iSize = mysql_escape_string( buffer, from, iSize );
hb_retclen_buffer( buffer, iSize );
hb_xfree( from );
}
}
| mysql.c | 342 |
tmysql.prg |
Type | Function | Source | Line |
CLASS | TMySQLRow
CLASS TMySQLRow
DATA aRow // a single row of answer
DATA aDirty // array of booleans set to .T. if corresponding field of aRow has been changed
DATA aOldValue // If aDirty[n] is .T. aOldValue[n] keeps a copy of changed value if aRow[n] is part of a primary key
//DAVID:
DATA aOriValue // Original values ( same as TMySQLtable:aOldValue )
DATA aFieldStruct // type of each field
DATA cTable // Name of table containing this row, empty if TMySQLQuery returned this row
METHOD New(aRow, aFStruct, cTableName) // Create a new Row object
METHOD FieldGet(cnField) // Same as clipper ones, but FieldGet() and FieldPut() accept a string as
METHOD FieldPut(cnField, Value) // field identifier, not only a number
METHOD FieldName(nNum)
METHOD FieldPos(cFieldName)
METHOD FieldLen(nNum) // Length of field N
METHOD FieldDec(nNum) // How many decimals in field N
METHOD FieldType(nNum) // Clipper type of field N
METHOD MakePrimaryKeyWhere() // returns a WHERE x=y statement which uses primary key (if available)
ENDCLASS
| tmysql.prg | 70 |
TMYSQLROW:METHOD | New(aRow, aFStruct, cTableName) CLASS TMySQLRow
METHOD New(aRow, aFStruct, cTableName) CLASS TMySQLRow
default cTableName to ""
default aFStruct to {}
::aRow := aRow
//DAVID:
::aOriValue := ACLONE( aRow ) // Original values ( same as TMySQLtable:aOldValue )
::aFieldStruct := aFStruct
::cTable := cTableName
::aDirty := Array(Len(::aRow))
::aOldValue := Array(Len(::aRow))
AFill(::aDirty, .F.)
return Self
| tmysql.prg | 97 |
TMYSQLROW:METHOD | FieldGet(cnField) CLASS TMySQLRow
METHOD FieldGet(cnField) CLASS TMySQLRow
local nNum := iif( ISCHARACTER( cnField ), ::FieldPos(cnField), cnField )
if nNum > 0 .AND. nNum <= Len(::aRow)
// Char fields are padded with spaces since a real .dbf field would be
if ::FieldType(nNum) == "C"
return PadR(::aRow[nNum], ::aFieldStruct[nNum][MYSQL_FS_LENGTH])
else
return ::aRow[nNum]
endif
endif
return nil
| tmysql.prg | 117 |
TMYSQLROW:METHOD | FieldPut(cnField, Value) CLASS TMySQLRow
METHOD FieldPut(cnField, Value) CLASS TMySQLRow
local nNum := iif( ISCHARACTER( cnField ), ::FieldPos(cnField), cnField )
if nNum > 0 .AND. nNum <= Len(::aRow)
if Valtype(Value) == Valtype(::aRow[nNum]) .OR. ::aRow[nNum]==NIL
// if it is a char field remove trailing spaces
if ValType(Value) == "C"
Value := RTrim(Value)
endif
// Save starting value for this field
if !::aDirty[nNum]
::aOldValue[nNum] := ::aRow[nNum]
::aDirty[nNum] := .T.
endif
::aRow[nNum] := Value
return Value
endif
endif
return nil
| tmysql.prg | 135 |
TMYSQLROW:METHOD | FieldPos(cFieldName) CLASS TMySQLRow
METHOD FieldPos(cFieldName) CLASS TMySQLRow
local cUpperName := Upper(cFieldName)
return AScan(::aFieldStruct, {|aItem| (Upper(aItem[MYSQL_FS_NAME]) == cUpperName)})
| tmysql.prg | 164 |
TMYSQLROW:METHOD | FieldName(nNum) CLASS TMySQLRow
METHOD FieldName(nNum) CLASS TMySQLRow
return iif( nNum >=1 .AND. nNum <= Len(::aFieldStruct), ::aFieldStruct[nNum][MYSQL_FS_NAME], "" )
| tmysql.prg | 172 |
TMYSQLROW:METHOD | FieldLen(nNum) CLASS TMySQLRow
METHOD FieldLen(nNum) CLASS TMySQLRow
return iif( nNum >=1 .AND. nNum <= Len(::aFieldStruct), ::aFieldStruct[nNum][MYSQL_FS_LENGTH], 0 )
| tmysql.prg | 177 |
TMYSQLROW:METHOD | FieldDec(nNum) CLASS TMySQLRow
METHOD FieldDec(nNum) CLASS TMySQLRow
if nNum >=1 .AND. nNum <= Len(::aFieldStruct)
if ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_FLOAT_TYPE .or. ;
::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_DOUBLE_TYPE
return set(_SET_DECIMALS)
else
return ::aFieldStruct[nNum][MYSQL_FS_DECIMALS]
endif
endif
return 0
| tmysql.prg | 181 |
TMYSQLROW:METHOD | FieldType(nNum) CLASS TMySQLRow
METHOD FieldType(nNum) CLASS TMySQLRow
local cType := "U"
if nNum >=1 .AND. nNum <= Len(::aFieldStruct)
do case
case ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_TINY_TYPE
cType := "L"
case ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_SHORT_TYPE .OR.;
::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_LONG_TYPE .OR.;
::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_LONGLONG_TYPE .OR.;
::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_FLOAT_TYPE .OR.;
::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_DOUBLE_TYPE .OR.;
::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_DECIMAL_TYPE
cType := "N"
case ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_DATE_TYPE
cType := "D"
case ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_BLOB_TYPE
cType := "M"
case ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_VAR_STRING_TYPE .OR.;
::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_STRING_TYPE .OR.;
::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_DATETIME_TYPE
cType := "C"
case ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_INT24_TYPE
cType := "N"
case ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_MEDIUM_BLOB_TYPE
cType := "M"
otherwise
cType := "U"
endcase
endif
return cType
| tmysql.prg | 195 |
TMYSQLROW:METHOD | MakePrimaryKeyWhere() CLASS TMySQLRow
METHOD MakePrimaryKeyWhere() CLASS TMySQLRow
local ni, cWhere := " WHERE "
for nI := 1 to Len(::aFieldStruct)
// search for fields part of a primary key
if (sqlAND(::aFieldStruct[nI][MYSQL_FS_FLAGS], PRI_KEY_FLAG) == PRI_KEY_FLAG) .OR.;
(sqlAND(::aFieldStruct[nI][MYSQL_FS_FLAGS], MULTIPLE_KEY_FLAG) == MULTIPLE_KEY_FLAG)
cWhere += ::aFieldStruct[nI][MYSQL_FS_NAME] + "="
// if a part of a primary key has been changed, use original value
if ::aDirty[nI]
cWhere += ClipValue2SQL(::aOldValue[nI])
else
cWhere += ClipValue2SQL(::aRow[nI])
endif
cWhere += " AND "
endif
next
// remove last " AND "
cWhere := Left(cWhere, Len(cWhere) - 5)
return cWhere
| tmysql.prg | 240 |
CLASS | TMySQLQuery
CLASS TMySQLQuery
DATA nSocket // connection handle to MySQL server
DATA nResultHandle // result handle received from MySQL
DATA cQuery // copy of query that generated this object
DATA nNumRows // number of rows available on answer NOTE MySQL is 0 based
DATA nCurRow // I'm currently over row number
//DAVID:
DATA lBof
DATA lEof
//DAVID:
DATA lFieldAsData //Use fields as object DATA. For compatibility
//Names of fields can match name of TMySQLQuery/Table DATAs,
//and it is dangerous. ::lFieldAsData:=.F. can fix it
DATA aRow //Values of fields of current row
DATA nNumFields // how many fields per row
DATA aFieldStruct // type of each field, a copy is here a copy inside each row
DATA lError // .T. if last operation failed
METHOD New(nSocket, cQuery) // New query object
METHOD Destroy()
| tmysql.prg | 272 |
TMYSQLQUERY:METHOD | End()
METHOD End() INLINE ::Destroy()
METHOD Refresh() // ReExecutes the query (cQuery) so that changes to table are visible
METHOD GetRow(nRow) // return Row n of answer
METHOD Skip(nRows) // Same as clipper ones
| tmysql.prg | 299 |
TMYSQLQUERY:METHOD | Bof()
METHOD Bof() INLINE ::lBof //DAVID: ::nCurRow == 1
| tmysql.prg | 306 |
TMYSQLQUERY:METHOD | Eof()
METHOD Eof() INLINE ::lEof //DAVID: ::nCurRow == ::nNumRows
| tmysql.prg | 307 |
TMYSQLQUERY:METHOD | RecNo()
METHOD RecNo() INLINE ::nCurRow
| tmysql.prg | 308 |
TMYSQLQUERY:METHOD | LastRec()
METHOD LastRec() INLINE ::nNumRows
| tmysql.prg | 309 |
TMYSQLQUERY:METHOD | GoTop()
METHOD GoTop() INLINE ::GetRow(1)
| tmysql.prg | 310 |
TMYSQLQUERY:METHOD | GoBottom()
METHOD GoBottom() INLINE ::GetRow(::nNumRows)
| tmysql.prg | 311 |
TMYSQLQUERY:METHOD | GoTO(nRow)
METHOD GoTO(nRow) INLINE ::GetRow(nRow)
METHOD FCount()
| tmysql.prg | 312 |
TMYSQLQUERY:METHOD | NetErr()
METHOD NetErr() INLINE ::lError // Returns .T. if something went wrong
METHOD Error() // Returns textual description of last error and clears ::lError
METHOD FieldName(nNum)
METHOD FieldPos(cFieldName)
METHOD FieldGet(cnField)
METHOD FieldLen(nNum) // Length of field N
METHOD FieldDec(nNum) // How many decimals in field N
METHOD FieldType(nNum) // Clipper type of field N
ENDCLASS
| tmysql.prg | 316 |
TMYSQLQUERY:METHOD | New(nSocket, cQuery) CLASS TMySQLQuery
METHOD New(nSocket, cQuery) CLASS TMySQLQuery
local nI, aField, rc
::nSocket := nSocket
::cQuery := cQuery
::lError := .F.
::aFieldStruct := {}
::nCurRow := 1
::nResultHandle := nil
::nNumFields := 0
::nNumRows := 0
//DAVID:
::lBof := .T.
::lEof := .T.
::lFieldAsData := .T. //Use fields as object DATA. For compatibility
::aRow := {} //Values of fields of current row
if (rc := sqlQuery(nSocket, cQuery)) == 0
// save result set
if !Empty(::nResultHandle := sqlStoreR(nSocket))
::nNumRows := sqlNRows(::nResultHandle)
::nNumFields := sqlNumFi(::nResultHandle)
//DAVID:
::aRow := Array( ::nNumFields )
for nI := 1 to ::nNumFields
aField := sqlFetchF(::nResultHandle)
AAdd(::aFieldStruct, aField)
//DAVID:
if ::lFieldAsData
__ObjAddData(Self,::aFieldStruct[nI][MYSQL_FS_NAME])
endif
next
::getRow(::nCurRow)
else
// Should query have returned rows? (Was it a SELECT like query?)
if (::nNumFields := sqlNumFi(nSocket)) == 0
// Was not a SELECT so reset ResultHandle changed by previous sqlStoreR()
::nResultHandle := nil
else
::lError := .T.
endif
endif
else
::lError := .T.
endif
return Self
| tmysql.prg | 330 |
TMYSQLQUERY:METHOD | Refresh() CLASS TMySQLQuery
METHOD Refresh() CLASS TMySQLQuery
local rc
// free present result handle
sqlFreeR(::nResultHandle)
::lError := .F.
if (rc := sqlQuery(::nSocket, ::cQuery)) == 0
// save result set
::nResultHandle := sqlStoreR(::nSocket)
::nNumRows := sqlNRows(::nResultHandle)
// NOTE: I presume that number of fields doesn't change (that is nobody alters this table) between
// successive refreshes of the same
// But row number could very well change
if ::nCurRow > ::nNumRows
::nCurRow := ::nNumRows
endif
::getRow(::nCurRow)
else
/* ::aFieldStruct := {}
::nResultHandle := nil
::nNumFields := 0
::nNumRows := 0
*/
::lError := .T.
endif
return !::lError
| tmysql.prg | 394 |
TMYSQLQUERY:METHOD | Skip(nRows) CLASS TMySQLQuery
METHOD Skip(nRows) CLASS TMySQLQuery
//DAVID:
local lbof
// NOTE: MySQL row count starts from 0
default nRows to 1
//DAVID:
::lBof := ( EMPTY( ::LastRec() ) )
if nRows == 0
// No move
elseif nRows < 0
// Negative movement
//DAVID: ::nCurRow := Max(::nCurRow + nRows, 1)
if ( ( ::recno() + nRows ) + 0 ) < 1
nRows := - ::recno() + 1
//Clipper: only SKIP movement can set BOF() to .T.
::lBof := .T. //Try to skip before first record
endif
else
// positive movement
//DAVID: ::nCurRow := Min(::nCurRow + nRows, ::nNumRows)
if ( ( ::recno() + nRows ) + 0 ) > ::lastrec()
nRows := ::lastrec() - ::recno() + 1
endif
endif
//DAVID:
::nCurRow := ::nCurRow + nRows
//DAVID: maintain ::bof() true until next movement
//Clipper: only SKIP movement can set BOF() to .T.
lbof := ::bof()
// sqlDataS(::nResultHandle, ::nCurRow - 1)
::getRow(::nCurrow)
if lbof
::lBof := .T.
endif
//DAVID: DBSKIP() return NIL return ::nCurRow
return nil
| tmysql.prg | 432 |
STATIC FUNCTION | NMonth(cMonthValue)
static function NMonth(cMonthValue)
static cMonths := {"Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Ago", "Sep", "Oct", "Nov", "Dec" }
local nMonth
nMonth := AScan(cMonths, cMonthValue)
return PadL(nMonth, 2, "0")
| tmysql.prg | 482 |
TMYSQLQUERY:METHOD | GetRow(nRow) CLASS TMySQLQuery
METHOD GetRow(nRow) CLASS TMySQLQuery
//DAVID: replaced by ::aRow local aRow := NIL
local oRow := NIL
local i
//DAVID: use current row default nRow to 0
default nRow to ::nCurRow
if ::nResultHandle != NIL
//DAVID:
::lBof := ( EMPTY( ::LastRec() ) )
if nRow < 1 .or. nRow > ::lastrec() //Out of range
// Equal to Clipper behaviour
nRow := ::lastrec() + 1 //LASTREC()+1
::nCurRow := ::lastrec() + 1
// ::lEof := .t.
endif
if nRow >= 1 .AND. nRow <= ::nNumRows
// NOTE: row count starts from 0
sqlDataS(::nResultHandle, nRow - 1)
::nCurRow := nRow
//DAVID: else
//DAVID: use current row ::nCurRow++
endif
//DAVID:
::lEof := ( ::Recno() > ::LastRec() )
::aRow := NIL
if ::eof()
// Phantom record with empty fields
::aRow := Array( Len( ::aFieldStruct ) )
Afill( ::aRow, "" )
else
::aRow := sqlFetchR(::nResultHandle)
endif
if ::aRow != NIL
// Convert answer from text field to correct clipper types
for i := 1 to ::nNumFields
do case
case ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_TINY_TYPE
//DAVID:
if ::aRow[i]==NIL
::aRow[i] := "0"
endif
::aRow[i] := iif(Val(::aRow[i]) == 0, .F., .T.)
case ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_SHORT_TYPE .OR.;
::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_LONG_TYPE .OR.;
::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_LONGLONG_TYPE .OR.;
::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_INT24_TYPE .OR. ;
::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_DECIMAL_TYPE
//DAVID:
if ::aRow[i]==NIL
::aRow[i] := "0"
endif
::aRow[i] := Val(::aRow[i])
case ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_DOUBLE_TYPE .OR.;
::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_FLOAT_TYPE
//DAVID:
if ::aRow[i]==NIL
::aRow[i] := "0"
endif
::aRow[i] := Val(::aRow[i])
case ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_DATE_TYPE
if Empty(::aRow[i])
::aRow[i] := hb_SToD("")
else
// Date format YYYY-MM-DD
::aRow[i] := hb_SToD(Left(::aRow[i], 4) + SubStr(::aRow[i], 6, 2) + Right(::aRow[i], 2))
endif
case ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_BLOB_TYPE
// Memo field
case ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_STRING_TYPE .OR.;
::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_VAR_STRING_TYPE
// char field
case ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_DATETIME_TYPE
// DateTime field
otherwise
//DAVID: Alert("Unknown type from SQL Server Field: " + LTrim(Str(i))+" is type "+LTrim(Str(::aFieldStruct[i][MYSQL_FS_TYPE])))
// QOUT("Unknown type from SQL Server Field: " + LTrim(Str(i))+" is type "+LTrim(Str(::aFieldStruct[i][MYSQL_FS_TYPE])))
endcase
//DAVID:
if ::lFieldAsData
__objsetValuelist(Self,{{::aFieldStruct[i][MYSQL_FS_NAME],::aRow[i]}})
endif
next
oRow := TMySQLRow():New(::aRow, ::aFieldStruct)
endif
endif
//DAVID: if ::arow==nil; msginfo("::arow nil"); end
return iif(::aRow == NIL, NIL, oRow)
| tmysql.prg | 493 |
TMYSQLQUERY:METHOD | Destroy() CLASS TMySQLQuery
METHOD Destroy() CLASS TMySQLQuery
sqlFreeR(::nResultHandle)
return Self
| tmysql.prg | 610 |
TMYSQLQUERY:METHOD | FCount() CLASS TMySQLQuery
METHOD FCount() CLASS TMySQLQuery
return ::nNumFields
| tmysql.prg | 617 |
TMYSQLQUERY:METHOD | Error() CLASS TMySQLQuery
METHOD Error() CLASS TMySQLQuery
::lError := .F.
return sqlGetErr(::nSocket)
| tmysql.prg | 622 |
TMYSQLQUERY:METHOD | FieldPos(cFieldName) CLASS TMySQLQuery
METHOD FieldPos(cFieldName) CLASS TMySQLQuery
local cUpperName, nPos := 0
cUpperName := Upper(cFieldName)
//DAVID: nPos := AScan(::aFieldStruct, {|aItem| iif(Upper(aItem[MYSQL_FS_NAME]) == cUpperName, .T., .F.)})
nPos := AScan(::aFieldStruct, {|aItem| (Upper(aItem[MYSQL_FS_NAME]) == cUpperName)})
/*while ++nPos <= Len(::aFieldStruct)
if Upper(::aFieldStruct[nPos][MYSQL_FS_NAME]) == cUpperName
exit
endif
enddo
// I haven't found field name
if nPos > Len(::aFieldStruct)
nPos := 0
endif*/
return nPos
| tmysql.prg | 629 |
TMYSQLQUERY:METHOD | FieldName(nNum) CLASS TMySQLQuery
METHOD FieldName(nNum) CLASS TMySQLQuery
if nNum >=1 .AND. nNum <= Len(::aFieldStruct)
return ::aFieldStruct[nNum][MYSQL_FS_NAME]
endif
return ""
| tmysql.prg | 653 |
TMYSQLQUERY:METHOD | FieldGet(cnField) CLASS TMySQLQuery
METHOD FieldGet(cnField) CLASS TMySQLQuery
local nNum,Value
if ValType(cnField) == "C"
nNum := ::FieldPos(cnField)
else
nNum := cnField
endif
if nNum > 0 .AND. nNum <= ::nNumfields
//DAVID: Value := __objsendmsg(Self,::aFieldStruct[nNum][MYSQL_FS_NAME])
Value := ::aRow[ nNum ]
// Char fields are padded with spaces since a real .dbf field would be
if ::FieldType(nNum) == "C"
return PadR(Value,::aFieldStruct[nNum][MYSQL_FS_LENGTH])
else
return Value
endif
endif
return nil
| tmysql.prg | 661 |
TMYSQLQUERY:METHOD | FieldLen(nNum) CLASS TMySQLQuery
METHOD FieldLen(nNum) CLASS TMySQLQuery
if nNum >=1 .AND. nNum <= Len(::aFieldStruct)
return ::aFieldStruct[nNum][MYSQL_FS_LENGTH]
endif
return 0
| tmysql.prg | 687 |
TMYSQLQUERY:METHOD | FieldDec(nNum) CLASS TMySQLQuery
METHOD FieldDec(nNum) CLASS TMySQLQuery
if nNum >=1 .AND. nNum <= Len(::aFieldStruct)
if ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_FLOAT_TYPE .or. ;
::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_DOUBLE_TYPE
return set(_SET_DECIMALS)
else
return ::aFieldStruct[nNum][MYSQL_FS_DECIMALS]
endif
endif
return 0
| tmysql.prg | 695 |
TMYSQLQUERY:METHOD | FieldType(nNum) CLASS TMySQLQuery
METHOD FieldType(nNum) CLASS TMySQLQuery
local cType := "U"
if nNum >=1 .AND. nNum <= Len(::aFieldStruct)
do case
case ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_TINY_TYPE
cType := "L"
case ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_SHORT_TYPE .OR.;
::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_LONG_TYPE .OR.;
::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_LONGLONG_TYPE .OR.;
::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_FLOAT_TYPE .OR.;
::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_DOUBLE_TYPE.OR.;
::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_DECIMAL_TYPE
cType := "N"
case ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_DATE_TYPE
cType := "D"
case ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_BLOB_TYPE
cType := "M"
case ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_VAR_STRING_TYPE .OR.;
::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_STRING_TYPE .OR.;
::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_DATETIME_TYPE
cType := "C"
case ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_INT24_TYPE
cType := "N"
case ::aFieldStruct[nNum][MYSQL_FS_TYPE] == MYSQL_MEDIUM_BLOB_TYPE
cType := "M"
otherwise
cType := "U"
endcase
endif
return cType
| tmysql.prg | 709 |
CLASS | TMySQLTable FROM TMySQLQuery
CLASS TMySQLTable FROM TMySQLQuery
DATA cTable // name of table
DATA aOldValue // keeps a copy of old value
METHOD New(nSocket, cQuery, cTableName)
METHOD GetRow(nRow)
METHOD Skip(nRow)
| tmysql.prg | 759 |
TMYSQLTABLE:METHOD | GoTop()
METHOD GoTop() INLINE ::GetRow(1)
| tmysql.prg | 767 |
TMYSQLTABLE:METHOD | GoBottom()
METHOD GoBottom() INLINE ::GetRow(::nNumRows)
| tmysql.prg | 768 |
TMYSQLTABLE:METHOD | GoTo(nRow)
METHOD GoTo(nRow) INLINE ::GetRow(nRow)
//DAVID: lOldRecord, lrefresh added
METHOD Update(oRow, lOldRecord, lRefresh) // Gets an oRow and updates changed fields
| tmysql.prg | 769 |
TMYSQLTABLE:METHOD | Save()
METHOD Save() INLINE ::Update()
//DAVID: lOldRecord, lRefresh added
METHOD Delete(oRow, lOldRecord, lRefresh) // Deletes passed row from table
//DAVID: lRefresh added
METHOD Append(oRow, lRefresh) // Inserts passed row into table
//DAVID: lSetValues added
METHOD GetBlankRow( lSetValues ) // Returns an empty row with all available fields empty
| tmysql.prg | 774 |
TMYSQLTABLE:METHOD | SetBlankRow()
METHOD SetBlankRow() INLINE ::GetBlankRow( .T. ) //Compatibility
| tmysql.prg | 783 |
TMYSQLTABLE:METHOD | Blank()
METHOD Blank() INLINE ::GetBlankRow()
METHOD FieldPut(cnField, Value) // field identifier, not only a number
METHOD Refresh()
METHOD MakePrimaryKeyWhere() // returns a WHERE x=y statement which uses primary key (if available)
ENDCLASS
| tmysql.prg | 785 |
TMYSQLTABLE:METHOD | New(nSocket, cQuery, cTableName) CLASS TMySQLTable
METHOD New(nSocket, cQuery, cTableName) CLASS TMySQLTable
Local i := 0
super:New(nSocket, AllTrim(cQuery))
::cTable := Lower(cTableName)
::aOldValue:={}
for i := 1 to ::nNumFields
aadd(::aOldValue, ::fieldget(i))
next
return Self
| tmysql.prg | 793 |
TMYSQLTABLE:METHOD | GetRow(nRow) CLASS TMySQLTable
METHOD GetRow(nRow) CLASS TMySQLTable
local oRow := super:GetRow(nRow),i := 0
if oRow != NIL
oRow:cTable := ::cTable
endif
::aOldvalue:={}
for i := 1 to ::nNumFields
// ::aOldValue[i] := ::FieldGet(i)
aadd(::aOldvalue,::fieldget(i))
next
return oRow
| tmysql.prg | 809 |
TMYSQLTABLE:METHOD | Skip(nRow) CLASS TMySQLTable
METHOD Skip(nRow) CLASS TMySQLTable
Local i
super:skip(nRow)
for i := 1 to ::nNumFields
::aOldValue[i] := ::FieldGet(i)
next
//DAVID: DBSKIP() return NIL return Self
return nil
| tmysql.prg | 827 |
TMYSQLTABLE:METHOD | Update(oRow, lOldRecord, lRefresh ) CLASS TMySQLTable
METHOD Update(oRow, lOldRecord, lRefresh ) CLASS TMySQLTable
local cUpdateQuery := "UPDATE " + ::cTable + " SET "
local i
//DAVID:
local ni, cWhere := " WHERE "
default lOldRecord to .F.
//DAVID: too many ::refresh() can slow some processes, so we can desactivate it by parameter
default lRefresh to .T.
::lError := .F.
Do case
// default Current row
case oRow==nil
for i := 1 to ::nNumFields
if !( ::aOldValue[i] == ::FieldGet(i) )
cUpdateQuery += ::aFieldStruct[i][MYSQL_FS_NAME] + "=" + ClipValue2SQL(::FieldGet(i)) + ","
endif
next
// no Change
if right(cUpdateQuery,4)=="SET "; return !::lError; end
// remove last comma
cUpdateQuery := Left(cUpdateQuery, Len(cUpdateQuery) -1)
//DAVID:
if lOldRecord
// based in matching of ALL fields of old record
// WARNING: if there are more than one record of ALL fields matching, all of those records will be changed
for nI := 1 to Len(::aFieldStruct)
cWhere += ::aFieldStruct[nI][MYSQL_FS_NAME] + "="
// use original value
cWhere += ClipValue2SQL(::aOldValue[nI])
cWhere += " AND "
next
// remove last " AND "
cWhere := Left(cWhere, Len(cWhere) - 5)
cUpdateQuery += cWhere
else
//MakePrimaryKeyWhere is based in fields part of a primary key
cUpdateQuery += ::MakePrimaryKeyWhere()
endif
if sqlQuery(::nSocket, cUpdateQuery) == 0
//DAVID: Clipper maintain same record pointer
//DAVID: after refresh(), position of current record is often unpredictable
if lRefresh
::refresh()
else
//DAVID: just reset values (?)
for i := 1 to ::nNumFields
::aOldValue[i] := ::FieldGet(i)
next
endif
else
::lError := .T.
endif
Case oRow!=nil
if oRow:cTable == ::cTable
for i := 1 to Len(oRow:aRow)
if oRow:aDirty[i]
cUpdateQuery += oRow:aFieldStruct[i][MYSQL_FS_NAME] + "=" + ClipValue2SQL(oRow:aRow[i]) + ","
endif
next
// remove last comma
cUpdateQuery := Left(cUpdateQuery, Len(cUpdateQuery) -1)
//DAVID:
if lOldRecord
// based in matching of ALL fields of old record
// WARNING: if there are more than one record of ALL fields matching, all of those records will be changed
for nI := 1 to Len(oRow:aFieldStruct)
cWhere += oRow:aFieldStruct[nI][MYSQL_FS_NAME] + "="
// use original value
cWhere += ClipValue2SQL(oRow:aOriValue[nI])
cWhere += " AND "
next
// remove last " AND "
cWhere := Left(cWhere, Len(cWhere) - 5)
cUpdateQuery += cWhere
else
//MakePrimaryKeyWhere is based in fields part of a primary key
cUpdateQuery += oRow:MakePrimaryKeyWhere()
endif
if sqlQuery(::nSocket, cUpdateQuery) == 0
// All values are commited
Afill(oRow:aDirty, .F.)
Afill(oRow:aOldValue, nil)
//DAVID:
oRow:aOriValue := ACLONE( oRow:aRow )
//DAVID: Clipper maintain same record pointer
//DAVID: after refresh(), position of current record is often unpredictable
if lRefresh
::refresh()
endif
else
::lError := .T.
endif
endif
endCase
return !::lError
| tmysql.prg | 841 |
TMYSQLTABLE:METHOD | Delete(oRow, lOldRecord, lRefresh) CLASS TMySQLTable
METHOD Delete(oRow, lOldRecord, lRefresh) CLASS TMySQLTable
local cDeleteQuery := "DELETE FROM " + ::cTable , i
//DAVID:
local ni, cWhere := " WHERE "
default lOldRecord to .F.
//DAVID: too many ::refresh() can slow some processes, so we can desactivate it by parameter
default lRefresh to .T.
// is this a row of this table ?
Do Case
Case orow==nil
//DAVID:
if lOldRecord
// based in matching of ALL fields of old record
// WARNING: if there are more than one record of ALL fields matching, all of those records will be changed
for nI := 1 to Len(::aFieldStruct)
cWhere += ::aFieldStruct[nI][MYSQL_FS_NAME] + "="
// use original value
cWhere += ClipValue2SQL(::aOldValue[nI])
cWhere += " AND "
next
// remove last " AND "
cWhere := Left(cWhere, Len(cWhere) - 5)
cDeleteQuery += cWhere
else
//MakePrimaryKeyWhere is based in fields part of a primary key
cDeleteQuery += ::MakePrimaryKeyWhere()
endif
if sqlQuery(::nSocket, cDeleteQuery) == 0
::lError := .F.
//DAVID: Clipper maintain same record pointer
//DAVID: ::nCurRow--
//DAVID: after refresh(), position of current record is often unpredictable
if lRefresh
::refresh()
else
//DAVID: just reset values (?)
for i := 1 to ::nNumFields
::aOldValue[i] := ::FieldGet(i)
next
endif
else
::lError := .T.
endif
Case oRow!=nil
if oRow:cTable == ::cTable
//DAVID:
if lOldRecord
// based in matching of ALL fields of old record
// WARNING: if there are more than one record of ALL fields matching, all of those records will be changed
for nI := 1 to Len(oRow:aFieldStruct)
cWhere += oRow:aFieldStruct[nI][MYSQL_FS_NAME] + "="
// use original value
cWhere += ClipValue2SQL(oRow:aOriValue[nI])
cWhere += " AND "
next
// remove last " AND "
cWhere := Left(cWhere, Len(cWhere) - 5)
cDeleteQuery += cWhere
else
//MakePrimaryKeyWhere is based in fields part of a primary key
cDeleteQuery += oRow:MakePrimaryKeyWhere()
endif
if sqlQuery(::nSocket, cDeleteQuery) == 0
::lError := .F.
//DAVID: after refresh(), position of current record is often unpredictable
if lRefresh
::refresh()
endif
else
::lError := .T.
endif
endif
EndCase
return !::lError
| tmysql.prg | 970 |
TMYSQLTABLE:METHOD | Append(oRow, lRefresh) CLASS TMySQLTable
METHOD Append(oRow, lRefresh) CLASS TMySQLTable
local cInsertQuery := "INSERT INTO " + ::cTable + " ("
local i
//DAVID: too many ::refresh() can slow some processes, so we can desactivate it by parameter
default lRefresh to .T.
Do Case
// default Current row
Case oRow==nil
// field names
for i := 1 to ::nNumFields
if ::aFieldStruct[i][MYSQL_FS_FLAGS]!=AUTO_INCREMENT_FLAG
cInsertQuery += ::aFieldStruct[i][MYSQL_FS_NAME] + ","
endif
next
// remove last comma from list
cInsertQuery := Left(cInsertQuery, Len(cInsertQuery) -1) + ") VALUES ("
// field values
for i := 1 to ::nNumFields
if ::aFieldStruct[i][MYSQL_FS_FLAGS]!=AUTO_INCREMENT_FLAG
cInsertQuery += ClipValue2SQL(::FieldGet(i)) + ","
endif
next
// remove last comma from list of values and add closing parenthesis
cInsertQuery := Left(cInsertQuery, Len(cInsertQuery) -1) + ")"
if sqlQuery(::nSocket, cInsertQuery) == 0
::lError := .F.
//DAVID: Clipper add record at end
::nCurRow := ::lastrec() + 1
//DAVID: after refresh(), position of current record is often unpredictable
if lRefresh
::refresh()
else
//DAVID: just reset values in memory (?)
/* was same values from fieldget(i) !
for i := 1 to ::nNumFields
::aOldValue[i] := ::FieldGet(i)
next
*/
endif
return .T.
else
::lError := .T.
endif
Case oRow!=nil
if oRow:cTable == ::cTable
// field names
for i := 1 to Len(oRow:aRow)
if oRow:aFieldStruct[i][MYSQL_FS_FLAGS]!=AUTO_INCREMENT_FLAG
cInsertQuery += oRow:aFieldStruct[i][MYSQL_FS_NAME] + ","
endif
next
// remove last comma from list
cInsertQuery := Left(cInsertQuery, Len(cInsertQuery) -1) + ") VALUES ("
// field values
for i := 1 to Len(oRow:aRow)
if oRow:aFieldStruct[i][MYSQL_FS_FLAGS]!=AUTO_INCREMENT_FLAG
cInsertQuery += ClipValue2SQL(oRow:aRow[i]) + ","
endif
next
// remove last comma from list of values and add closing parenthesis
cInsertQuery := Left(cInsertQuery, Len(cInsertQuery) -1) + ")"
if sqlQuery(::nSocket, cInsertQuery) == 0
//DAVID:
::lError := .F.
//DAVID:
// All values are commited
Afill(oRow:aDirty, .F.)
Afill(oRow:aOldValue, nil)
//DAVID:
oRow:aOriValue := ACLONE( oRow:aRow )
//DAVID: Clipper add record at end
::nCurRow := ::lastrec() + 1
//DAVID: after refresh(), position of current record is often unpredictable
if lRefresh
::refresh()
endif
return .T.
else
::lError := .T.
endif
endif
Endcase
return .F.
| tmysql.prg | 1068 |
TMYSQLTABLE:METHOD | GetBlankRow( lSetValues ) CLASS TMySQLTable
METHOD GetBlankRow( lSetValues ) CLASS TMySQLTable
local i
local aRow := Array(::nNumFields)
//DAVID: It is not current row, so do not change it
default lSetValues to .F.
// crate an array of empty fields
for i := 1 to ::nNumFields
do case
case ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_STRING_TYPE .OR.;
::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_VAR_STRING_TYPE .OR.;
::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_BLOB_TYPE .OR.;
::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_DATETIME_TYPE
aRow[i] := ""
case ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_SHORT_TYPE .OR.;
::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_LONG_TYPE .OR.;
::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_LONGLONG_TYPE .OR.;
::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_INT24_TYPE .OR. ;
::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_DECIMAL_TYPE
aRow[i] := 0
case ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_TINY_TYPE
aRow[i] := .F.
case ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_DOUBLE_TYPE .OR.;
::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_FLOAT_TYPE
aRow[i] := 0.0
case ::aFieldStruct[i][MYSQL_FS_TYPE] == MYSQL_DATE_TYPE
aRow[i] := hb_SToD("")
otherwise
aRow[i] := nil
endcase
next
//DAVID:
if lSetValues //Assign values as current row values
for i := 1 to ::nNumFields
::FieldPut(i, aRow[i])
::aOldValue[i] := aRow[i]
next
endif
return TMySQLRow():New(aRow, ::aFieldStruct, ::cTable, .F.)
| tmysql.prg | 1175 |
TMYSQLTABLE:METHOD | FieldPut(cnField, Value) CLASS TMySQLTable
METHOD FieldPut(cnField, Value) CLASS TMySQLTable
local nNum
if ValType(cnField) == "C"
nNum := ::FieldPos(cnField)
else
nNum := cnField
endif
if nNum > 0 .AND. nNum <= ::nNumFields
//DAVID: if Valtype(Value) == Valtype(::FieldGet(nNum)) .OR. Empty(::Fieldget(nNum))
if Valtype(Value) == Valtype(::aRow[nNum]) .OR. ::aRow[nNum]==NIL
// if it is a char field remove trailing spaces
if ValType(Value) == "C"
Value := RTrim(Value)
endif
//DAVID:
::aRow[ nNum ] := Value
if ::lFieldAsData
__objsetValueList(Self,{{::aFieldStruct[nNum][MYSQL_FS_NAME],Value}})
endif
return Value
endif
endif
return nil
| tmysql.prg | 1227 |
TMYSQLTABLE:METHOD | Refresh() CLASS TMySQLTABLE
METHOD Refresh() CLASS TMySQLTABLE
local rc
// free present result handle
sqlFreeR(::nResultHandle)
::lError := .F.
if (rc := sqlQuery(::nSocket, ::cQuery)) == 0
// save result set
::nResultHandle := sqlStoreR(::nSocket)
::nNumRows := sqlNRows(::nResultHandle)
// NOTE: I presume that number of fields doesn't change (that is nobody alters this table) between
// successive refreshes of the same
// But row number could very well change
if ::nCurRow > ::nNumRows
::nCurRow := ::nNumRows
endif
::getRow(::nCurRow)
else
/* ::aFieldStruct := {}
::nResultHandle := nil
::nNumFields := 0
::nNumRows := 0
::aOldValue:={}
*/
::lError := .T.
endif
return !::lError
| tmysql.prg | 1260 |
TMYSQLTABLE:METHOD | MakePrimaryKeyWhere() CLASS TMySQLTable
METHOD MakePrimaryKeyWhere() CLASS TMySQLTable
local ni, cWhere := " WHERE "
for nI := 1 to Len(::aFieldStruct)
// search for fields part of a primary key
if (sqlAND(::aFieldStruct[nI][MYSQL_FS_FLAGS], PRI_KEY_FLAG) == PRI_KEY_FLAG) .OR.;
(sqlAND(::aFieldStruct[nI][MYSQL_FS_FLAGS], MULTIPLE_KEY_FLAG) == MULTIPLE_KEY_FLAG)
cWhere += ::aFieldStruct[nI][MYSQL_FS_NAME] + "="
// if a part of a primary key has been changed, use original value
cWhere += ClipValue2SQL(::aOldValue[nI])
cWhere += " AND "
endif
next
// remove last " AND "
cWhere := Left(cWhere, Len(cWhere) - 5)
return cWhere
| tmysql.prg | 1300 |
CLASS | TMySQLServer
CLASS TMySQLServer
DATA nSocket // connection handle to server (currently pointer to a MYSQL structure)
DATA cServer // server name
DATA cDBName // Selected DB
DATA cUser // user accessing db
DATA cPassword // his/her password
DATA lError // .T. if occurred an error
DATA cCreateQuery
METHOD New(cServer, cUser, cPassword) // Opens connection to a server, returns a server object
METHOD Destroy() // Closes connection to server
METHOD SelectDB(cDBName) // Which data base I will use for subsequent queries
METHOD CreateTable(cTable, aStruct,cPrimaryKey,cUniqueKey,cAuto) // Create new table using the same syntax of dbCreate()
METHOD DeleteTable(cTable) // delete table
METHOD TableStruct(cTable) // returns a structure array compatible with clipper's dbStruct() ones
METHOD CreateIndex(cName, cTable, aFNames, lUnique) // Create an index (unique) on field name(s) passed as an array of strings aFNames
METHOD DeleteIndex(cName, cTable) // Delete index cName from cTable
METHOD ListDBs() // returns an array with list of data bases available
METHOD ListTables() // returns an array with list of available tables in current database
METHOD Query(cQuery) // Gets a textual query and returns a TMySQLQuery or TMySQLTable object
| tmysql.prg | 1332 |
TMYSQLSERVER:METHOD | NetErr()
METHOD NetErr() INLINE ::lError // Returns .T. if something went wrong
METHOD Error() // Returns textual description of last error
METHOD CreateDatabase( cDataBase ) // Create an New Mysql Database
//Mitja
METHOD sql_Commit() // Commits transaction
METHOD sql_Rollback() // Rollbacks transaction
METHOD sql_Version() // server version as numeric
ENDCLASS
| tmysql.prg | 1358 |
TMYSQLSERVER:METHOD | New(cServer, cUser, cPassword) CLASS TMySQLServer
METHOD New(cServer, cUser, cPassword) CLASS TMySQLServer
::cServer := cServer
::cUser := cUser
::cPassword := cPassword
::nSocket := sqlConnect(cServer, cUser, cPassword)
::lError := .F.
if Empty( ::nSocket )
::lError := .T.
endif
return Self
| tmysql.prg | 1368 |
TMYSQLSERVER:METHOD | Destroy() CLASS TMySQLServer
METHOD Destroy() CLASS TMySQLServer
sqlClose(::nSocket)
return Self
| tmysql.prg | 1384 |
TMYSQLSERVER:METHOD | sql_commit() CLASS TMySQLServer
METHOD sql_commit() CLASS TMySQLServer
if sqlCommit(::nSocket) == 0
Return .T.
endif
return .F.
| tmysql.prg | 1390 |
TMYSQLSERVER:METHOD | sql_rollback() CLASS TMySQLServer
METHOD sql_rollback() CLASS TMySQLServer
if sqlRollback(::nSocket) == 0
Return .T.
endif
return .F.
| tmysql.prg | 1398 |
TMYSQLSERVER:METHOD | sql_version() CLASS TMySQLServer
METHOD sql_version() CLASS TMySQLServer
local nVer
nVer:=sqlversion(::nSocket)
return nVer
*METHOD SelectDB(cDBName) CLASS TMySQLServer
*
* if sqlSelectD(::nSocket, cDBName) == 0
* ::cDBName := cDBName
* return .T.
* else
* ::cDBName := ""
* endif
*
*return .F.
*****************alterado
| tmysql.prg | 1405 |
TMYSQLSERVER:METHOD | SelectDB(cDBName) CLASS TMySQLServer
METHOD SelectDB(cDBName) CLASS TMySQLServer
::lError := .F.
if sqlSelectD(::nSocket, cDBName) != 0 && tabela nao existe
::cDBName :=""
::lError := .T.
else && tabela existe
::cDBName :=cDBName
::lError := .F.
return .T.
endif
return .F.
| tmysql.prg | 1425 |
TMYSQLSERVER:METHOD | CreateDatabase ( cDataBase ) CLASS TMySQLServer
METHOD CreateDatabase ( cDataBase ) CLASS TMySQLServer
local cCreateQuery := "CREATE DATABASE "+ lower(cDatabase)
if sqlQuery(::nSocket, cCreateQuery) == 0
return .T.
endif
return .F.
| tmysql.prg | 1441 |
TMYSQLSERVER:METHOD | CreateTable(cTable, aStruct,cPrimaryKey,cUniqueKey,cAuto) CLASS TMySQLServer
METHOD CreateTable(cTable, aStruct,cPrimaryKey,cUniqueKey,cAuto) CLASS TMySQLServer
/* NOTE: all table names are created with lower case */
local i
// returns NOT NULL if extended structure has DBS_NOTNULL field to true
local cNN := {|aArr| iif(Len(aArr) > DBS_DEC, iif(aArr[DBS_NOTNULL], " NOT NULL ", ""), "")}
::cCreateQuery := "CREATE TABLE " + Lower(cTable) + " ("
for i := 1 to Len(aStruct)
do case
case aStruct[i][DBS_TYPE] == "C"
::cCreateQuery += aStruct[i][DBS_NAME] + " char(" + AllTrim(Str(aStruct[i][DBS_LEN])) + ")" + Eval(cNN, aStruct[i])+ if(aStruct[i][DBS_NAME]==cPrimaryKey," NOT NULL ",'' )+ ","
case aStruct[i][DBS_TYPE] == "M"
::cCreateQuery += aStruct[i][DBS_NAME] + " text" + Eval(cNN, aStruct[i]) + ","
case aStruct[i][DBS_TYPE] == "N"
/*
if aStruct[i][DBS_DEC] == 0
::cCreateQuery += aStruct[i][DBS_NAME] + " int(" + AllTrim(Str(aStruct[i][DBS_LEN])) + ")" + Eval(cNN, aStruct[i]) + if(aStruct[i][DBS_NAME]==cPrimaryKey," NOT NULL ",'' )+ if(aStruct[i][DBS_NAME]==cAuto," auto_increment ",'' ) + ","
else
::cCreateQuery += aStruct[i][DBS_NAME] + " real(" + AllTrim(Str(aStruct[i][DBS_LEN])) + "," + AllTrim(Str(aStruct[i][DBS_DEC])) + ")" + Eval(cNN, aStruct[i]) + ","
endif
*/
if (aStruct[i][DBS_DEC] == 0) .and. (aStruct[i][DBS_LEN] <= 18)
do case
case (aStruct[i][DBS_LEN] <= 4)
::cCreateQuery += aStruct[i][DBS_NAME] + " smallint(" + AllTrim(Str(aStruct[i][DBS_LEN])) + ")"
case (aStruct[i][DBS_LEN] <= 6)
::cCreateQuery += aStruct[i][DBS_NAME] + " mediumint(" + AllTrim(Str(aStruct[i][DBS_LEN])) + ")"
case (aStruct[i][DBS_LEN] <= 9)
::cCreateQuery += aStruct[i][DBS_NAME] + " int(" + AllTrim(Str(aStruct[i][DBS_LEN])) + ")"
otherwise
::cCreateQuery += aStruct[i][DBS_NAME] + " bigint(" + AllTrim(Str(aStruct[i][DBS_LEN])) + ")"
endcase
::cCreateQuery += Eval(cNN, aStruct[i]) + if(aStruct[i][DBS_NAME]==cPrimaryKey," NOT NULL ",'' )+ if(aStruct[i][DBS_NAME]==cAuto," auto_increment ",'' ) + ","
else
::cCreateQuery += aStruct[i][DBS_NAME] + " real(" + AllTrim(Str(aStruct[i][DBS_LEN])) + "," + AllTrim(Str(aStruct[i][DBS_DEC])) + ")" + Eval(cNN, aStruct[i]) + ","
endif
case aStruct[i][DBS_TYPE] == "D"
::cCreateQuery += aStruct[i][DBS_NAME] + " date " + Eval(cNN, aStruct[i]) + ","
case aStruct[i][DBS_TYPE] == "L"
::cCreateQuery += aStruct[i][DBS_NAME] + " tinyint " + Eval(cNN, aStruct[i]) + ","
case aStruct[i][DBS_TYPE] == "B"
::cCreateQuery += aStruct[i][DBS_NAME] + " mediumblob " + Eval(cNN, aStruct[i]) + ","
case aStruct[i][DBS_TYPE] == "I"
::cCreateQuery += aStruct[i][DBS_NAME] + " mediumint " + Eval(cNN, aStruct[i]) + ","
otherwise
::cCreateQuery += aStruct[i][DBS_NAME] + " char(" + AllTrim(Str(aStruct[i][DBS_LEN])) + ")" + Eval(cNN, aStruct[i]) + ","
endcase
next
if cPrimarykey != NIL
::cCreateQuery += ' PRIMARY KEY ('+cPrimaryKey+'),'
endif
if cUniquekey != NIL
::cCreateQuery += ' UNIQUE '+cUniquekey +' ('+cUniqueKey+'),'
endif
// remove last comma from list
::cCreateQuery := Left(::cCreateQuery, Len(::cCreateQuery) -1) + ");"
if sqlQuery(::nSocket, ::cCreateQuery) == 0
return .T.
else
::lError := .T.
endif
return .F.
| tmysql.prg | 1454 |
TMYSQLSERVER:METHOD | CreateIndex(cName, cTable, aFNames, lUnique) CLASS TMySQLServer
METHOD CreateIndex(cName, cTable, aFNames, lUnique) CLASS TMySQLServer
local cCreateQuery := "CREATE "
local i
default lUnique to .F.
if lUnique
cCreateQuery += "UNIQUE INDEX "
else
cCreateQuery += "INDEX "
endif
cCreateQuery += cName + " ON " + Lower(cTable) + " ("
for i := 1 to Len(aFNames)
cCreateQuery += aFNames[i] + ","
next
// remove last comma from list
cCreateQuery := Left(cCreateQuery, Len(cCreateQuery) -1) + ")"
if sqlQuery(::nSocket, cCreateQuery) == 0
return .T.
endif
return .F.
| tmysql.prg | 1530 |
TMYSQLSERVER:METHOD | DeleteIndex(cName, cTable) CLASS TMySQLServer
METHOD DeleteIndex(cName, cTable) CLASS TMySQLServer
local cDropQuery := "DROP INDEX " + cName + " FROM " + Lower(cTable)
if sqlQuery(::nSocket, cDropQuery) == 0
return .T.
endif
return .F.
| tmysql.prg | 1560 |
TMYSQLSERVER:METHOD | DeleteTable(cTable) CLASS TMySQLServer
METHOD DeleteTable(cTable) CLASS TMySQLServer
local cDropQuery := "DROP TABLE " + Lower(cTable)
if sqlQuery(::nSocket, cDropQuery) == 0
return .T.
endif
return .F.
| tmysql.prg | 1571 |
TMYSQLSERVER:METHOD | Query(cQuery) CLASS TMySQLServer
METHOD Query(cQuery) CLASS TMySQLServer
local oQuery, cTableName, i, cUpperQuery, nNumTables, cToken
default cQuery to ""
cUpperQuery := Upper(AllTrim(cQuery))
i := 1
nNumTables := 1
while !( (cToken := __StrToken(cUpperQuery, i++, " ")) == "FROM" ) .AND. !Empty(cToken)
enddo
// first token after "FROM" is a table name
// NOTE: SubSelects ?
cTableName := __StrToken(cUpperQuery, i++, " ")
while !( (cToken := __StrToken(cUpperQuery, i++, " ")) == "WHERE" ) .AND. !Empty(cToken)
// do we have more than one table referenced ?
if cToken == "," .OR. cToken == "JOIN"
nNumTables++
endif
enddo
if nNumTables == 1
oQuery := TMySQLTable():New(::nSocket, cQuery, cTableName)
else
oQuery := TMySQLQuery():New(::nSocket, cQuery)
endif
if oQuery:NetErr()
::lError := .T.
endif
return oQuery
| tmysql.prg | 1583 |
TMYSQLSERVER:METHOD | Error() CLASS TMySQLServer
METHOD Error() CLASS TMySQLServer
::lError := .F.
return iif(Empty( ::nSocket ), "No connection to server", sqlGetErr(::nSocket))
| tmysql.prg | 1621 |
TMYSQLSERVER:METHOD | ListDBs() CLASS TMySQLServer
METHOD ListDBs() CLASS TMySQLServer
local aList
aList := sqlListDB(::nSocket)
return aList
| tmysql.prg | 1628 |
TMYSQLSERVER:METHOD | ListTables() CLASS TMySQLServer
METHOD ListTables() CLASS TMySQLServer
local aList
aList := sqlListTbl(::nSocket)
return aList
| tmysql.prg | 1637 |
TMYSQLSERVER:METHOD | TableStruct(cTable) CLASS TMySQLServer
METHOD TableStruct(cTable) CLASS TMySQLServer
local aStruct := {}
HB_SYMBOL_UNUSED( cTable )
/* TODO: rewrite for MySQL
local nRes, aField, aStruct, aSField, i
aStruct := {}
nRes := sqlListF(::nSocket, cTable)
if !Empty( nRes )
for i := 1 to sqlNumFi(nRes)
aField := sqlFetchF(nRes)
aSField := Array(DBS_DEC)
// don't count indexes as real fields
if aField[MSQL_FS_TYPE] <= MSQL_LAST_REAL_TYPE
aSField[DBS_NAME] := Left(aField[MSQL_FS_NAME], 10)
aSField[DBS_DEC] := 0
do case
case aField[MSQL_FS_TYPE] == MSQL_INT_TYPE
aSField[DBS_TYPE] := "N"
aSField[DBS_LEN] := 11
case aField[MSQL_FS_TYPE] == MSQL_UINT_TYPE
aSField[DBS_TYPE] := "L"
aSField[DBS_LEN] := 1
case aField[MSQL_FS_TYPE] == MSQL_CHAR_TYPE
aSField[DBS_TYPE] := "C"
aSField[DBS_LEN] := aField[MSQL_FS_LENGTH]
case aField[MSQL_FS_TYPE] == MSQL_DATE_TYPE
aSField[DBS_TYPE] := "D"
aSField[DBS_LEN] := aField[MSQL_FS_LENGTH]
case aField[MSQL_FS_TYPE] == MSQL_REAL_TYPE
aSField[DBS_TYPE] := "N"
aSField[DBS_LEN] := 12
aSFIeld[DBS_DEC] := 8
case aField[MSQL_FS_TYPE] == MYSQL_MEDIUM_BLOB_TYPE
aSField[DBS_TYPE] := "B"
aSField[DBS_LEN] := aField[MSQL_FS_LENGTH]
case aField[MSQL_FS_TYPE] == FIELD_TYPE_INT24
aSField[DBS_TYPE] := "I"
aSField[DBS_LEN] := aField[MSQL_FS_LENGTH]
aSFIeld[DBS_DEC] := aField[MYSQL_FS_DECIMALS]
otherwise
endcase
AAdd(aStruct, aSField)
endif
next
sqlFreeR(nRes)
endif*/
return aStruct
| tmysql.prg | 1647 |
STATIC FUNCTION | ClipValue2SQL(Value)
static function ClipValue2SQL(Value)
local cValue
do case
case Valtype(Value) == "N"
cValue := AllTrim(Str(Value))
case Valtype(Value) == "D"
if !Empty(Value)
// MySQL dates are like YYYY-MM-DD
cValue := "'"+StrZero(Year(Value), 4) + "-" + StrZero(Month(Value), 2) + "-" + StrZero(Day(Value), 2) + "'"
else
cValue := "''"
endif
case Valtype(Value) $ "CM"
IF Empty( Value)
cValue="''"
ELSE
cValue := "'"
Value:=DATATOSQL(value)
cValue+= value+ "'"
ENDIF
case Valtype(Value) == "L"
cValue := AllTrim(Str(iif(Value == .F., 0, 1)))
otherwise
cValue := "''" // NOTE: Here we lose values we cannot convert
endcase
return cValue
| tmysql.prg | 1717 |
tsqlbrw.prg |
Type | Function | Source | Line |
CLASS | TBColumnSQL from TBColumn
CLASS TBColumnSQL from TBColumn
DATA oBrw // pointer to Browser containing this column, needed to be able to
// retreive field values from Browse instance variable oCurRow
//DATA Picture // From clipper 5.3
DATA nFieldNum // This column maps field num from query
MESSAGE Block METHOD Block() // When evaluating code block to get data from source this method
// gets called. I need this since inside TBColumn Block I cannot
// reference Column or Browser instance variables
METHOD New(cHeading, bBlock, oBrw) // Saves inside column a copy of container browser
ENDCLASS
| tsqlbrw.prg | 77 |
TBCOLUMNSQL:METHOD | New(cHeading, bBlock, oBrw) CLASS TBColumnSQL
METHOD New(cHeading, bBlock, oBrw) CLASS TBColumnSQL
super:New(cHeading, bBlock)
::oBrw := oBrw
return Self
| tsqlbrw.prg | 93 |
TBCOLUMNSQL:METHOD | Block() CLASS TBColumnSQL
METHOD Block() CLASS TBColumnSQL
local xValue := ::oBrw:oCurRow:FieldGet(::nFieldNum)
local xType := ::oBrw:oCurRow:FieldType(::nFieldNum)
do case
case xType == "N"
xValue := "'"+Str(xValue, ::oBrw:oCurRow:FieldLen(::nFieldNum), ::oBrw:oCurRow:FieldDec(::nFieldNum))+"'"
case xType == "D"
xValue := "'" + DToC(xValue) + "'"
case xType == "L"
xValue := iif(xValue, ".T.", ".F.")
case xType == "C"
// Chr(34) is a double quote
// That is: if there is a double quote inside text substitute it with a string
// which gets converted back to a double quote by macro operator. If not it would
// give an error because of unbalanced double quotes.
xValue := Chr(34) + StrTran(xValue, Chr(34), Chr(34) + "+Chr(34)+" + Chr(34)) + Chr(34)
case xType == "M"
xValue := "' '"
otherwise
xValue := "'"+xValue+"'"
endcase
return &("{||" + xValue + "}")
/*--------------------------------------------------------------------------------------------------*/
| tsqlbrw.prg | 101 |
CLASS | TBrowseSQL from TBrowse
CLASS TBrowseSQL from TBrowse
DATA oCurRow // Active row inside table / sql query
DATA oQuery // Query / table object which we are browsing
METHOD New(nTop, nLeft, nBottom, nRight, oServer, oQuery, cTable)
METHOD EditField() // Editing of hilighted field, after editing does an update of
// corresponding row inside table
METHOD BrowseTable(lCanEdit, aExitKeys) // Handles standard moving inside table and if lCanEdit == .T.
// allows editing of field. It is the stock ApplyKey() moved inside a table
// if lCanEdit K_DEL deletes current row
// When a key is pressed which is present inside aExitKeys it leaves editing loop
METHOD KeyboardHook(nKey) // Where do all unknown keys go?
ENDCLASS
| tsqlbrw.prg | 140 |
TBROWSESQL:METHOD | New(nTop, nLeft, nBottom, nRight, oServer, oQuery, cTable) CLASS TBrowseSQL
METHOD New(nTop, nLeft, nBottom, nRight, oServer, oQuery, cTable) CLASS TBrowseSQL
local i, oCol
HB_SYMBOL_UNUSED( oServer )
HB_SYMBOL_UNUSED( cTable )
super:New(nTop, nLeft, nBottom, nRight)
::oQuery := oQuery
// Let's get a row to build needed columns
::oCurRow := ::oQuery:GetRow(1)
// positioning blocks
::SkipBlock := {|n| ::oCurRow := Skipper(@n, ::oQuery), n }
::GoBottomBlock := {|| ::oCurRow := ::oQuery:GetRow(::oQuery:LastRec()), 1 }
::GoTopBlock := {|| ::oCurRow := ::oQuery:GetRow(1), 1 }
// Add a column for each field
for i := 1 to ::oQuery:FCount()
// No bBlock now since New() would use it to find column length, but column is not ready yet at this point
oCol := TBColumnSQL():New(::oCurRow:FieldName(i),, Self)
if !( ::oCurRow:FieldType(i) == "M" )
oCol:Width := Max(::oCurRow:FieldLen(i), Len(oCol:Heading))
else
oCol:Width := 10
endif
// which field does this column display
oCol:nFieldNum := i
// Add a picture
do case
case ::oCurRow:FieldType(i) == "N"
oCol:picture := replicate("9", oCol:Width)
case ::oCurRow:FieldType(i) $ "CM"
oCol:picture := replicate("!", oCol:Width)
endcase
::AddColumn(oCol)
next
return Self
| tsqlbrw.prg | 160 |
STATIC FUNCTION | Skipper(nSkip, oQuery)
static function Skipper(nSkip, oQuery)
local i := 0
do case
case (nSkip == 0 .OR. oQuery:LastRec() == 0)
oQuery:Skip(0)
case (nSkip > 0)
while ( i < nSkip ) // Skip Foward
//DAVID: change in TMySQLquery:eof() definition if oQuery:eof()
if oQuery:recno() == oQuery:lastrec()
exit
endif
oQuery:Skip(1)
i++
enddo
case ( nSkip < 0 )
while ( i > nSkip ) // Skip backward
//DAVID: change in TMySQLquery:bof() definition if oQuery:bof()
if oQuery:recno() == 1
exit
endif
oQuery:Skip(-1)
i--
enddo
endcase
nSkip := i
return oQuery:GetRow(oQuery:RecNo())
| tsqlbrw.prg | 209 |
TBROWSESQL:METHOD | EditField() CLASS TBrowseSQL
METHOD EditField() CLASS TBrowseSQL
local oCol
local aGetList
local nKey
local cMemoBuff, cMemo
// Get the current column object from the browse
oCol := ::getColumn(::colPos)
// Editing of a memo field requires a MemoEdit() window
if ::oCurRow:FieldType(oCol:nFieldNum) == "M"
/* save, clear, and frame window for memoedit */
cMemoBuff := SaveScreen(10, 10, 22, 69)
Scroll(10, 10, 22, 69, 0)
DispBox(10, 10, 22, 69)
/* use fieldspec for title */
//@ 10,((76 - Len(::oCurRow:FieldName(oCol:nFieldNum)) / 2) SAY " " + (::oCurRow:FieldName(oCol:nFieldNum)) + " "
/* edit the memo field */
cMemo := MemoEdit(::oCurRow:FieldGet(oCol:nFieldNum), 11, 11, 21, 68, .T.)
if Lastkey() == K_CTRL_END
::oCurRow:FieldPut(oCol:nFieldNum, cMemo)
/* NOTE: To do in a better way */
if !::oQuery:Update(::oCurRow)
Alert(Left(::oQuery:Error(), 60))
endif
endif
RestScreen(10, 10, 22, 69, cMemoBuff)
else
// Create a corresponding GET
// NOTE: I need to use ::oCurRow:FieldPut(...) when changing values since message redirection doesn't work at present
// time for write access to instance variables but only for reading them
aGetList := { getnew( row(), col(), ;
{|xValue| iif(xValue == nil, Eval(oCol:Block), ::oCurRow:FieldPut(oCol:nFieldNum, xValue))} ,;
oCol:heading, ;
oCol:picture, ;
::colorSpec ) }
// Set initial cursor shape
//setcursor( iif( ReadInsert(), SC_INSERT, SC_NORMAL ) )
ReadModal(aGetList)
//setcursor( SC_NONE )
/* NOTE: To do in a better way */
if !::oQuery:Update(::oCurRow)
Alert(Left(::oQuery:Error(), 60))
endif
endif
if !::oQuery:Refresh()
Alert(::oQuery:Error())
endif
::RefreshAll()
// Check exit key from get
nKey := LastKey()
if nKey == K_UP .or. nKey == K_DOWN .or. ;
nKey == K_PGUP .or. nKey == K_PGDN
// Ugh
keyboard( chr( nKey ) )
endif
RETURN Self
| tsqlbrw.prg | 248 |
TBROWSESQL:METHOD | BrowseTable(lCanEdit, aExitKeys) CLASS TBrowseSQL
METHOD BrowseTable(lCanEdit, aExitKeys) CLASS TBrowseSQL
local nKey
local lKeepGoing := .T.
default nKey to nil
default lCanEdit to .F.
default aExitKeys to {K_ESC}
while lKeepGoing
while !::Stabilize() .and. NextKey() == 0
enddo
nKey := Inkey(0)
if AScan(aExitKeys, nKey) > 0
lKeepGoing := .F.
LOOP
endif
do case
case nKey == K_DOWN
::down()
case nKey == K_PGDN
::pageDown()
case nKey == K_CTRL_PGDN
::goBottom()
case nKey == K_UP
::up()
case nKey == K_PGUP
::pageUp()
case nKey == K_CTRL_PGUP
::goTop()
case nKey == K_RIGHT
::right()
case nKey == K_LEFT
::left()
case nKey == K_HOME
::home()
case nKey == K_END
::end()
case nKey == K_CTRL_LEFT
::panLeft()
case nKey == K_CTRL_RIGHT
::panRight()
case nKey == K_CTRL_HOME
::panHome()
case nKey == K_CTRL_END
::panEnd()
case nKey == K_RETURN .AND. lCanEdit
::EditField()
/*case nKey == K_DEL
if lCanEdit
if ! ::oQuery:Delete(::oCurRow)
Alert("not deleted " + ::oQuery:Error())
endif
if !::oQuery:Refresh()
Alert(::oQuery:Error())
endif
::inValidate()
::refreshAll():forceStable()
endif*/
otherwise
::KeyboardHook(nKey)
endcase
enddo
return Self
| tsqlbrw.prg | 325 |
TBROWSESQL:METHOD | KeyboardHook(nKey) CLASS TBrowseSQL
METHOD KeyboardHook(nKey) CLASS TBrowseSQL
HB_SYMBOL_UNUSED( nKey )
return Self
| tsqlbrw.prg | 416 |
|