fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2000-09-25 18:05 GMT+2 Maurilio Longo <maurilio.longo@libero.it>

Browse Source
This commit is contained in:
Maurilio Longo
2000-09-25 16:19:00 +00:00
parent 921d276423
commit 0d3d75e0a0
3 changed files with 271 additions and 28 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
harbour/ChangeLog
View File

@@ -1,4 +1,10 @@
2000-09-24 21:24 UTC+0800 Brian Hays <bhays@abacuslaw.com>
2000-09-25 18:05 GMT+2 Maurilio Longo <maurilio.longo@libero.it>
*contrib/mysql/tmysql.prg
! fixes / changes to work with tsqlbrw.prg
+contrib/mysql/tsqlbrw.prg
* fixes / changes - work in progress.
2000-09-24 21:24 UTC+0800 Brian Hays <bhays@abacuslaw.com>
* contrib/rdd_ads/ads1.c
! Fixed retrieval of logical fields
NOTICE!! before, logical fields returned incorrect values!

70
harbour/contrib/mysql/tmysql.prg
View File

@@ -123,9 +123,16 @@ return nil
METHOD FieldPut(nNum, Value) CLASS TMySQLRow
if nNum > 0 .AND. nNum <= Len(::aRow)
if Valtype(Value) == Valtype(::aRow[nNum]) .OR. Empty(::aRow[nNum])
// Save starting value for this field
if !::aDirty[nNum]
::aOldValue[nNum] := ::aRow[nNum]
::aDirty[nNum] := .T.
endif
::aRow[nNum] := Value
::aDirty[nNum] := .T.
return Value
endif
endif
@@ -172,7 +179,8 @@ METHOD MakePrimaryKeyWhere() CLASS TMySQLRow
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
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] + "="
@@ -213,6 +221,7 @@ CLASS TMySQLQuery
METHOD New(nSocket, cQuery) // New query object
METHOD Destroy()
METHOD Refresh() // ReExecutes the query (cQuery) so that changes to table are visible
METHOD GetRow(nRow) // return Row n of answer
@@ -266,6 +275,41 @@ METHOD New(nSocket, cQuery) CLASS TMySQLQuery
return Self
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
else
::aFieldStruct := {}
::nResultHandle := nil
::nNumFields := 0
::nNumRows := 0
::lError := .T.
endif
return !::lError
METHOD Skip(nRows) CLASS TMySQLQuery
// NOTE: MySQL row count starts from 0
@@ -425,6 +469,8 @@ METHOD Update(oRow) CLASS TMySQLTable
local cUpdateQuery := "UPDATE " + ::cTable + " SET "
local i, cField
::lError := .F.
// is this a row of this table ?
if oRow:cTable == ::cTable
@@ -441,9 +487,10 @@ METHOD Update(oRow) CLASS TMySQLTable
cUpdateQuery += oRow:MakePrimaryKeyWhere()
if sqlQuery(::nSocket, cUpdateQuery) == 0
// All values are commited
Afill(oRow:aDirty, .F.)
return .T.
Afill(oRow:aOldValue, nil)
else
::lError := .T.
@@ -452,7 +499,7 @@ METHOD Update(oRow) CLASS TMySQLTable
endif
return .F.
return !::lError
METHOD Delete(oRow) CLASS TMySQLTable
@@ -725,13 +772,20 @@ METHOD Query(cQuery) CLASS TMySQLServer
cUpperQuery := Upper(AllTrim(cQuery))
i := 1
nNumTables := 0
nNumTables := 1
while __StrToken(cUpperQuery, i++, " ") <> "FROM"
enddo
while (cToken := __StrToken(cUpperQuery, i++, " ")) <> "WHERE" .AND. cToken <> "LIMIT" .AND. !Empty(cToken)
cTableName := __StrToken(cQuery, i - 1, " ")
nNumTables++
// first token after "FROM" is a table name
// NOTE: SubSelects ?
cTableName := __StrToken(cQuery, 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

221
harbour/contrib/mysql/tsqlbrw.prg
View File

@@ -36,6 +36,7 @@
#include "hbclass.ch"
#include "common.ch"
#include "inkey.ch"
#include "dbstruct.ch"
#include "mysql.ch"
@@ -44,8 +45,13 @@ 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
MESSAGE Block METHOD Block() // When evaluating code block to get data from source this method gets called
METHOD New(cHeading, bBlock, oBrw) // Saves inside column a copy of container browser
ENDCLASS
@@ -62,14 +68,21 @@ return Self
METHOD Block() CLASS TBColumnSQL
local xValue := ::oBrw:oCurRow:FieldGet(::Cargo)
local xValue := ::oBrw:oCurRow:FieldGet(::nFieldNum)
local bBlock := "{|| '"
if ISNUMBER(xValue)
do case
case ValType(xValue) == "N"
xValue := Str(xValue)
elseif ISDATE(xValue)
case ValType(xValue) == "D"
xValue := DToC(xValue)
endif
case ValType(xValue) == "L"
xValue := iif(xValue, "T", "F")
otherwise
endcase
bBlock += xValue + " '}"
@@ -89,7 +102,10 @@ CLASS TBrowseSQL from TBrowse
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(nKey, lCanEdit) // Handles standard moving inside table and if lCanEdit == .T.
// allows editing of field. It is the stock ApplyKey() moved inside a table
ENDCLASS
@@ -129,9 +145,24 @@ METHOD New(nTop, nLeft, nBottom, nRight, oServer, oQuery, cTable) CLASS TBrowseS
// 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), nil, Self)
oCol := TBColumnSQL():New(::oCurRow:FieldName(i), {|val| iif(val <> nil, alert(val),)}, Self)
oCol:Width := Max(::oCurRow:aFieldStruct[i][MYSQL_FS_LENGTH], Len(oCol:Heading))
oCol:Cargo := i
// which field does this column display
oCol:nFieldNum := i
// Add a picture
do case
case ISNUMBER(::oCurRow:FieldGet(i))
oCol:picture := "999,999"
case ISCHARACTER(::oCurRow:FieldGet(i))
// For non-numeric, just use colors 3 and 4 ("B/W" and "B/BG")
oCol:picture := replicate("!", ::oCurRow:aFieldStruct[i][MYSQL_FS_LENGTH])
endcase
::AddColumn(oCol)
next
@@ -140,21 +171,17 @@ return Self
static function Skipper(nSkip, oQuery)
//LOCAL lAppend := APP_MODE_ACTIVE( oBrowse )
LOCAL i := 0
local i := 0
do case
case ( nSkip == 0 .or. oQuery:lastrec() == 0 )
// Skip 0 (significant on a network)
case (nSkip == 0 .or. oQuery:LastRec() == 0)
oQuery:Skip( 0 )
case ( nSkip > 0 .and. !oQuery:eof() )
case (nSkip > 0 .and. !oQuery:eof())
while ( i < nSkip ) // Skip Foward
if oQuery:eof()
//iif( lAppend, i++, dbskip( -1 ) )
exit
endif
oQuery:Skip( 1 )
@@ -167,20 +194,176 @@ static function Skipper(nSkip, oQuery)
if oQuery:bof()
exit
endif
oQuery:Skip( -1 )
i--
enddo
endcase
nSkip := i
//Alert(Str(oQuery:RecNo()) + " : " + str(i))
return oQuery:GetRow(oQuery:RecNo())
METHOD EditField() CLASS TBrowseSQL
LOCAL lFlag := TRUE
LOCAL oCol
LOCAL aGetList
LOCAL nKey
LOCAL nLen
LOCAL lAppend
LOCAL bSavIns
LOCAL nSavRecNo := recno()
LOCAL xNewKey
LOCAL xSavKey
LOCAL xGetValue
// If we're at EOF we're adding the first record, so turn on append mode
//if EOF()
// lAppend := APP_MODE_ON( oBrowse )
//else
// lAppend := APP_MODE_ACTIVE( oBrowse )
//endif
// Make sure screen is fully updated, dbf position is correct, etc.
//oBrowse:forceStable()
//if ( lAppend .and. ( recno() == lastrec() + 1 ) )
// dbAppend()
//endif
// Save the current record's key value (or NIL)
//xSavKey := iif( empty( indexkey() ), NIL, &( indexkey() ) )
// Get the current column object from the browse
oCol := ::getColumn(::colPos)
// Get picture len to force scrolling if var is larger than window
//nLen := ::colWidth(::colPos)
//Alert(Str(::colWidth(::colPos)))
// Create a corresponding GET
aGetList := { getnew( row(), col(), ;
{|xValue| iif(xValue == nil, ::oCurRow:FieldGet(oCol:nFieldNum), ::oCurRow:FieldPut(oCol:nFieldNum, xValue))} ,;
oCol:heading, ;
oCol:picture, ;
::colorSpec ) }
// Set insert key to toggle insert mode and cursor shape
//bSavIns := setkey( K_INS, { || InsToggle() } )
// Set initial cursor shape
//setcursor( iif( ReadInsert(), SC_INSERT, SC_NORMAL ) )
ReadModal(aGetList)
//setcursor( SC_NONE )
//setkey( K_INS, bSavIns )
// For this demo, we turn append mode off after each new record
//APP_MODE_OFF( oBrowse )
// Get the record's key value (or NIL) after the GET
//xNewKey := if( empty( indexkey() ), NIL, &( indexkey() ) )
if !::oQuery:Update(::oCurRow)
Alert(::oQuery:Error())
endif
if !::oQuery:Refresh()
Alert(::oQuery:Error())
endif
::inValidate()
::refreshAll():forceStable()
// if the key has changed (or if this is a new record)
/*if !( xNewKey == xSavKey ) .or. ( lAppend .and. xNewKey != NIL )
// do a complete refresh
oBrowse:refreshAll():forceStable()
// Make sure we're still on the right record after stabilizing
while &( indexkey() ) > xNewKey .and. !oBrowse:hitTop()
oBrowse:up():forceStable()
enddo
endif*/
// 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
METHOD BrowseTable(nKey, lCanEdit) CLASS TBrowseSQL
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
if lCanEdit
::EditField()
endif
/*otherwise
KEYBOARD chr( nKey )
DoGet( oBrowse )*/
otherwise
endcase
return Self