by Compuin » Thu Feb 28, 2013 6:28 pm
#INCLUDE "FIVEWIN.CH"
#define _DbSkipper DbSkipper
//----------------------------------------------------------------------------//
CLASS TDb
DATA nArea AS NUMERIC INIT 0
DATA lBuffer
DATA lShared AS LOGICAL INIT .t.
DATA aBuffer
DATA bBoF, bEoF, bNetError AS CODEBLOCK
DATA cAlias, cFile, cDriver AS String INIT ""
DATA lReadOnly AS LOGICAL INIT .f.
DATA lOemAnsi
DATA lTenChars AS LOGICAL INIT .t.
DATA aFldNames AS Array
DATA oBookMark AS OBJECT
DATA lBlank AS LOGICAL INIT .f.
METHOD New( cAlias ) CONSTRUCTOR
METHOD Activate()
METHOD AddIndex( cFile, cTag ) INLINE ( ::nArea )->( OrdListAdd( cFile, cTag ) )
MESSAGE AnsiToOem METHOD _AnsiToOem()
METHOD Append() INLINE ( ::nArea )->( DbAppend() )
METHOD Blank( nRecNo ) INLINE ( ::nArea )->( nRecNo := RecNo(),;
DBGoBottom(), ;
DBSkip( 1 ), ;
::Load(.t.),;
DBGoTo( nRecNo ),;
::lBlank := .t. )
METHOD Bof() INLINE ( ::nArea )->( BoF() )
METHOD Close() INLINE ( ::nArea )->( DbCloseArea() )
METHOD SetScope( n, xVar) INLINE ( ::nArea )->( OrdScope( n, xVar ) )
METHOD OrdKeyNo( n, xVar) INLINE ( ::nArea )->( OrdKeyNo() )
METHOD ClrScope( n ) INLINE ( ::nArea )->( OrdScope( n, NIL ) )
METHOD CloseIndex() INLINE ( ::nArea )->( OrdListClear() )
METHOD Commit() INLINE ( ::nArea )->( DBCommit() )
METHOD Create( cFile, aStruct, cDriver ) ;
INLINE DbCreate( cFile, aStruct, cDriver )
METHOD CreateIndex( cFile, cTag, cKey, bKey, lUnique) INLINE ;
( ::nArea )->( OrdCreate( cFile, cTag, cKey, bKey, lUnique ) )
METHOD ClearRelation() INLINE ( ::nArea )->( DbClearRelation() )
METHOD DbCreate( aStruct ) INLINE DbCreate( ::cFile, aStruct, ::cDriver )
METHOD Deactivate() INLINE ( ::nArea )->( DbCloseArea() ), ::nArea := 0
METHOD Eval( bBlock, bFor, bWhile, nNext, nRecord, lRest ) ;
INLINE ( ::nArea )->( DBEval( bBlock, bFor, ;
bWhile, nNext, nRecord, ;
lRest ) )
MESSAGE Delete METHOD _Delete()
METHOD Deleted() INLINE ( ::nArea )->( Deleted() )
METHOD DeleteIndex( cTag, cFile ) INLINE ( ::nArea )->( OrdDestroy( cTag, cFile ) )
METHOD Eof() INLINE ( ::nArea )->( EoF() )
METHOD FCount() INLINE ( ::nArea )->( FCount() )
MESSAGE FieldGet METHOD _FieldGet( nField )
METHOD FieldName( nField ) INLINE ( ::nArea )->( FieldName( nField ) )
METHOD FieldPos( cFieldName ) INLINE ( ::nArea )->( FieldPos( cFieldName ) )
MESSAGE FieldPut METHOD _FieldPut( nField, uVal )
METHOD Found() INLINE ( ::nArea )->( Found() )
METHOD GetBookMark()
METHOD GoTo( nRecNo ) INLINE ( ::nArea )->( DBGoTo( nRecNo ) ),;
If( ::lBuffer, ::Load(), )
METHOD GoTop() INLINE ( ::nArea )->( DBGoTop() ),;
If( ::lBuffer, ::Load(), )
METHOD GoBottom() INLINE ( ::nArea )->( DBGoBottom() ),;
If( ::lBuffer, ::Load(), )
METHOD IndexKey( ncTag, cFile ) INLINE ( ::nArea )->( OrdKey( ncTag, cFile ) )
METHOD IndexName( nTag, cFile ) INLINE ( ::nArea )->( OrdName( nTag, cFile ) )
METHOD IndexBagName( nInd ) INLINE ( ::nArea )->( OrdBagName( nInd ) )
METHOD IndexOrder( cTag, cFile ) INLINE ( ::nArea )->( OrdNumber( cTag, cFile ) )
METHOD LastRec( nRec ) INLINE ( ::nArea )->( LastRec() )
METHOD Load()
METHOD Lock() INLINE ( ::nArea )->( FLock() )
METHOD Modified()
MESSAGE OemToAnsi METHOD _OemToAnsi()
METHOD Pack() INLINE ( ::nArea )->( DbPack() )
METHOD ReCall() INLINE ( ::nArea )->( DBRecall() )
METHOD RecCount() INLINE ( ::nArea )->( RecCount() )
METHOD RecLock() INLINE ( ::nArea )->( RLock() )
METHOD RecNo() INLINE ( ::nArea )->( RecNo() )
METHOD Save()
METHOD SetBuffer( lOnOff )
METHOD SetBookMark()
METHOD Seek( uExp, lSoft )
METHOD SetOrder( cnTag, cFile ) INLINE ( ( ::nArea )->( OrdSetFocus( cnTag, cFile ) ) )
METHOD SetRelation( ncArea, cExp ) INLINE ;
( ::nArea )->( DbSetRelation( ncArea, Compile( cExp ), cExp ) )
METHOD Skip( nRecords )
METHOD Skipper( nRecords )
METHOD UnLock() INLINE ( ::nArea )->( DBUnLock() )
METHOD Used() INLINE ( ::nArea )->( Used() )
METHOD Insert()
METHOD Zap() INLINE ( ::nArea )->( DbZap() )
METHOD Debug()
METHOD NewObj()
METHOD LoadObj()
METHOD SaveObj()
METHOD SetBrowse()
METHOD Count() INLINE (::nArea)->(RecCount())
METHOD Fin() INLINE (::nArea)->(DBCloseArea())
METHOD SetFocus() INLINE (Select(::cAlias))
ERROR HANDLER OnError( uParam1 )
ENDCLASS
//---------------------------------------------------------------------------//
METHOD New( cAlias ) CLASS TDb
local n, oClass, aDatas := {}, aMethods := {}
local nWorkArea
nWorkArea := Select( cAlias )
::nArea = nWorkArea
::cAlias = Alias( nWorkArea )
::cFile = Alias( nWorkArea )
::cDriver = ( Alias( nWorkArea ) )->( DbSetDriver() )
::lShared = .t.
::lReadOnly = .f.
::lBuffer = .t.
::lOemAnsi = .f.
::bNetError = { || MsgStop( "Record in use", "Please, retry" ) }
::aFldNames = {}
for n = 1 to ( ::cAlias )->( FCount() )
AAdd( ::aFldNames, ( ::cAlias )->( FieldName( n ) ) )
next
::Load()
return Self
//----------------------------------------------------------------------------//
METHOD Activate() CLASS TDb
local nOldArea:= Select()
Select ( ::nArea )
if ! Used()
DbUseArea( .f., ::cDriver, ::cFile, ::cAlias, ::lShared, ::lReadOnly )
endif
Select ( nOldArea )
return nil
//----------------------------------------------------------------------------//
METHOD _AnsiToOem() CLASS TDb
local n
for n = 1 to Len( ::aBuffer )
if ValType( ::aBuffer[ n ] ) == "C"
::aBuffer[ n ] = AnsiToOem( ::aBuffer[ n ] )
endif
next
return nil
//----------------------------------------------------------------------------//
METHOD _Delete() CLASS TDb
if ::lShared
if ::Lock()
( ::nArea )->( DbDelete() )
::UnLock()
else
MsgAlert( "DataBase in use", "Please try again" )
endif
else
( ::nArea )->( DbDelete() )
endif
return nil
//---------------------------------------------------------------------------//
METHOD _FieldPut( nPos, uValue ) CLASS TDb
if ::lBuffer
::aBuffer[ nPos ] := uValue
else
if ::lShared
if ::RecLock()
( ::nArea )->( FieldPut( nPos, uValue ) )
::UnLock()
else
if ! Empty( ::bNetError )
return Eval( ::bNetError, Self )
endif
endif
else
( ::nArea )->( FieldPut( nPos, uValue ) )
endif
endif
return nil
//----------------------------------------------------------------------------//
METHOD _FieldGet( nPos ) CLASS TDb
if ::lBuffer
return ::aBuffer[ nPos ]
else
return ( ::nArea )->( FieldGet( nPos ) )
endif
return nil
//---------------------------------------------------------------------------//
static function Compile( cExp )
return &( "{||" + cExp + "}" )
//----------------------------------------------------------------------------//
METHOD Load() CLASS TDb
local n
if ::lBuffer
if Empty( ::aBuffer )
::aBuffer = Array( ::FCount() )
endif
for n = 1 to Len( ::aBuffer )
::aBuffer[ n ] = ( ::nArea )->( FieldGet( n ) )
next
if ::lOemAnsi
::OemToAnsi()
endif
endif
return nil
//----------------------------------------------------------------------------//
METHOD Modified() CLASS TDb
local cField, nFor
for nFor := 1 to Len( ::aFldNames )
cField = ( ::cAlias )->( FieldName( nFor ) )
if ( ::cAlias )->( FieldGet( nFor ) ) != ::aBuffer[ nFor ]
return .t.
endif
next
return .f.
//----------------------------------------------------------------------------//
METHOD _OemToAnsi() CLASS TDb
local n
for n = 1 to Len( ::aBuffer )
if ValType( ::aBuffer[ n ] ) == "C"
::aBuffer[ n ] = OemToAnsi( ::aBuffer[ n ] )
endif
next
return nil
//----------------------------------------------------------------------------//
METHOD OnError( uParam1 ) CLASS TDb
local cMsg := __GetMessage()
local nError := If( SubStr( cMsg, 1, 1 ) == "_", 1005, 1004 )
local nField
if ::lTenChars .and. Len( SubStr( cMsg, 2 ) ) == 9
cMsg = Upper( cMsg )
if SubStr( cMsg, 1, 1 ) == "_"
if ( nField := AScan( ::aFldNames,;
{ | cField | SubStr( cMsg, 2 ) == ;
RTrim( SubStr( cField, 1, 9 ) ) } ) ) != 0
::FieldPut( nField, uParam1 )
else
_ClsSetError( _GenError( nError, ::ClassName(), SubStr( cMsg, 2 ) ) )
endif
else
if( ( nField := ::FieldPos( cMsg ) ) != 0 )
return ::FieldGet( nField )
else
_ClsSetError( _GenError( nError, ::ClassName(), cMsg ) )
endif
endif
return nil
endif
if SubStr( cMsg, 1, 1 ) == "_"
if( ( nField := ::FieldPos( SubStr( cMsg, 2 ) ) ) != 0 )
::FieldPut( nField, uParam1 )
else
_ClsSetError( _GenError( nError, ::ClassName(), SubStr( cMsg, 2 ) ) )
endif
else
if( ( nField := ::FieldPos( cMsg ) ) != 0 )
return ::FieldGet( nField )
else
_ClsSetError( _GenError( nError, ::ClassName(), cMsg ) )
endif
endif
return nil
//----------------------------------------------------------------------------//
METHOD Seek( uExpr, lSoft ) CLASS TDb
local lFound
DEFAULT lSoft := Set( _SET_SOFTSEEK )
lFound = ( ::nArea )->( DbSeek( uExpr, lSoft ) )
if ::lBuffer
::Load()
endif
return lFound
//----------------------------------------------------------------------------//
METHOD SetBuffer( lOnOff ) CLASS TDb
DEFAULT lOnOff := .t.
if lOnOff != nil
::lBuffer = lOnOff
endif
if ::lBuffer
::Load()
else
::aBuffer := nil
endif
return ::lBuffer
//----------------------------------------------------------------------------//
METHOD Save() CLASS TDb
local n
if ::lBuffer
if ! ( ::nArea )->( EoF() )
if ::lShared
if ::RecLock()
for n := 1 to Len( ::aBuffer )
if ::lOemAnsi .and. ValType( ::aBuffer[ n ] ) == "C"
( ::nArea )->( FieldPut( n, AnsiToOem( ::aBuffer[ n ] ) ) )
else
( ::nArea )->( FieldPut( n, ::aBuffer[ n ] ) )
endif
next
::UnLock()
else
if ! Empty( ::bNetError )
return Eval( ::bNetError, Self )
else
MsgAlert( "Record in use", "Please, retry" )
endif
endif
else
for n := 1 to Len( ::aBuffer )
if ::lOemAnsi .and. ValType( ::aBuffer[ n ] ) == "C"
( ::nArea )->( FieldPut( n, AnsiToOem( ::aBuffer[ n ] ) ) )
else
( ::nArea )->( FieldPut( n, ::aBuffer[ n ] ) )
endif
next
endif
endif
endif
return nil
//----------------------------------------------------------------------------//
METHOD Skip( nRecords ) CLASS TDb
local n
DEFAULT nRecords := 1
( ::nArea )->( DbSkip( nRecords ) )
if ::lBuffer
::Load()
endif
if ::Eof()
if ::bEoF != nil
Eval( ::bEoF, Self )
endif
endif
if ::BoF()
if ::bBoF != nil
Eval( ::bBoF, Self )
endif
endif
return nil
//----------------------------------------------------------------------------//
METHOD Skipper( nRecords ) CLASS TDb
local nSkipped
DEFAULT nRecords := 1
nSkipped = ( ::nArea )->( _DbSkipper( nRecords ) )
if ::lBuffer
::Load()
endif
return nSkipped
//----------------------------------------------------------------------------//
METHOD SetBookMark() CLASS TDb
//::Load()
//::Debug()
::oBookMark := TBookMark():New( Self )
::oBookMark:Set()
RETURN Self
//----------------------------------------------------------------------------//
METHOD GetBookMark() CLASS TDb
::cAlias := ::oBookMark:cAlias
::SetOrder( ::oBookMark:cnIndex )
::goto( ::oBookMark:nRecno )
::aBuffer := AClone( ::oBookMark:aBuffer )
//Self := ::oBookMark:oDb
//::Debug()
RETURN Self
//----------------------------------------------------------------------------//
METHOD Debug() CLASS TDb
LOCAL i, cText
cText := ""
FOR i := 1 TO LEN( ::aBuffer )
//cText += xType( ::aBuffer[i] ) + CRLF
NEXT i
MsgInfo( cText )
RETURN .T.
//----------------------------------------------------------------------------//
METHOD NewObj() CLASS TDb
::Blank()
::SetBookMark()
RETURN TObjDb():New( Self, .T. )
//----------------------------------------------------------------------------//
METHOD LoadObj() CLASS TDb
::Load()
::SetBookMark()
RETURN TObjDb():New( Self, .F. )
//----------------------------------------------------------------------------//
METHOD SaveObj( oData ) CLASS TDb
::GetBookMark()
::aBuffer := AClone( oData:aBuffer )
IF oData:lNuevo
::Append()
ENDIF
::Save()
RETURN NIL
//----------------------------------------------------------------------------//
METHOD SetBrowse(oLbx) CLASS TDb
oLbx:bGotop := { || ::GoTop() }
oLbx:bGoBottom := { || ::GoBottom()}
oLbx:bSkip := { |nRec| ::Skipper( nRec ) }
oLbx:bLogicLen := { || ::RecCount() }
// oLbx:nHeaderHeight := 20
// oLbx:nLineHeight := 20
RETURN oLbx
//----------------------------------------------------------------------------//
METHOD Insert() CLASS TDb
LOCAL lOk:=.f.
(::nArea)->(DBAppend())
IF !NetErr()
::Save()
lOk:=.t.
ENDIF
RETURN lOk
FUNCTION DbPack()
PACK
RETURN NIL
FUNCTION DbZap()
ZAP
RETURN NIL
function DbSkipper( x )
return __DbSkipper( x )
FWH 20.12
Hbmk2 32/64 Bits (Build 19.29.30133)
Microsoft Visual C 32 Bits
MySql 8.0.24 32/64 Bits
VS Code