/* * Xailer source code: * * DataSet.prg * Clase TDataSet() * * Copyright 2003, 2007 Ignacio Ortiz de Zúńiga * Copyright 2003, 2007 Xailer.com * All rights reserved * */ #include "Xailer.ch" #include "error.ch" #include "Dataset.ch" //-------------------------------------------------------------------------- CLASS XDataSet FROM TComponent PUBLIC: PROPERTY cName INIT "" WRITE SetName PUBLISHED: PROPERTY oDataSource WRITE INLINE ::SetDataSource( Value ) AS TDataSource EDITOR PE_Component PROPERTY cProcess INIT "" PROPERTY nCursorLocation INIT adUseClient ; VALUES adUseClient, adUseServer, adUseNone PROPERTY nCursorType INIT adOpenStatic ; VALUES adOpenForwardOnly, adOpenKeySet, adOpenDynamic, adOpenStatic PROPERTY nLockType INIT adLockUnspecified ; VALUES adLockBatchOptimistic, adLockOptimistic, adLockPessimistic, adLockReadOnly, adLockUnspecified PROPERTY nMaxRecords INIT 0 PROPERTY lDisplayErrors INIT .T. PROPERTY lOpen INIT .F. WRITE INLINE IIF( Value, ::Open(), ::Close() ) PUBLIC: PROPERTY aFields INIT {} AS TDataField[] // DataField objects PROPERTY aUserFields INIT {} WRITE METHOD SetUserFields AS TDataField[] // DataField objects PROPERTY lUtfToAnsi INIT NIL WRITE METHOD SetUtfToAnsi DATA oRecords DATA aLinkedControls INIT {} DATA cLastError INIT "" DATA nLastError INIT 0 DATA lReadOnly INIT .F. DATA lUpdLinked INIT .T. DATA lFast INIT .F. DATA lOnUpdate INIT .F. RESERVED: DATA oDBBrowse AS TDBBrowse DATA aSQLParams INIT {} PROTECTED: PROPERTY lAbortOnErrors INIT .F. DATA aState INIT {} DATA lIsTable INIT .F. RESERVED: DATA nEditRecord INIT 0 DATA hFieldsList INIT 0 PUBLISHED: EVENT OnCreate( oSender ) // --> Nil EVENT OnPreDelete( oSender ) // --> lResult EVENT OnPostDelete( oSender ) // --> Nil EVENT OnPreSave( oSender ) // --> lResult EVENT OnPostSave( oSender ) // --> Nil EVENT OnPreChange( oSender, nOperation, Param ) // --> lResult EVENT OnPostChange( oSender, nOperation, Param1, Param2 ) // --> Nil EVENT OnOpen( oSender ) // --> lResult EVENT OnPostOpen( oSender ) // --> Nil EVENT OnClose( oSender ) // --> lResult EVENT OnPostClose( oSender ) // --> Nil EVENT OnAddNew( oSender ) // --> Nil EVENT OnEdit( oSender ) // --> Nil EVENT OnUpdate( oSender ) // --> Nil EVENT OnCancel( oSender ) // --> Nil METHOD Create( oParent, oDS, cName, cProcess ) CONSTRUCTOR METHOD Destroy() // --> Nil METHOD Open( lEvalEvent ) // --> lSuccess METHOD Close( lEvalEvent ) // --> lSuccess METHOD AddNew( lFast ) // --> lSuccess METHOD Edit( lFast ) // --> lSuccess METHOD Update( lFast ) // --> lSuccess METHOD Cancel( lFast ) // --> lSuccess METHOD Delete( lFast ) // --> lSuccess METHOD CanEdit() INLINE ::oRecords:CanEdit() // --> lResult METHOD CancelUpdate() INLINE ::Cancel() // --> lSuccess METHOD FastAddNew() // --> lSuccess METHOD FastEdit() // --> lSuccess METHOD FastUpdate() // --> lSuccess METHOD FastCancel() // --> lSuccess METHOD FastDelete() // --> lSuccess METHOD FieldGet( nField, lForceRecno ) // --> Value METHOD FieldPut( nField, Value, lFromDC ) // --> Nil METHOD Recno() // --> nId METHOD RecCount() // --> nCount METHOD RecordCount() // --> nCount METHOD Eof() // --> lResult METHOD Bof() // --> lResult METHOD Refresh() // --> Nil METHOD RefreshCurrent( nFlags1, nFlags2 ) // --> Nil METHOD Clone( lMode ) // --> oDataSet METHOD Deleted() // --> lResult METHOD Commit() // --> lSuccess METHOD RecLock( n ) // --> lSuccess METHOD RecUnLock() // --> lSuccess METHOD KeyCount() // --> nCount METHOD KeyNo() // --> nPosition METHOD GoTop( lUpdLinked ) // --> Nil METHOD GoBottom( lUpdLinked ) // --> Nil METHOD GoTo( Recno, lUpdLinked ) // --> Nil METHOD KeyGoto( nNewPos, lUpdLinked ) // --> Nil METHOD Skip( nSkip, lUpdLinked ) // --> Nil METHOD nSkip( nSkip, lUpdLinked ) // --> nSkipped METHOD Locate( cExp, lContinue, lUpdLinked ) // --> lResult METHOD Filter( cExp, lGoFirst, lUpdLinked ) // --> cOldFilder METHOD SetFilter( cExp, lGoFirst, lUpdLinked ) INLINE ::Filter( cExp, lGoFirst, lUpdLinked ) // --> cOldFilter METHOD ClearFilter( lGoFirst, lUpdLinked ) INLINE ::Filter( "", lGoFirst, lUpdLinked ) // --> cOldFilter METHOD Sort( cExpression, lGoFirst, lUpdLinked ) // --> lSuccess METHOD AutoSeek( cValue ) // --> lSuccess METHOD UpdateControls( nOp, Param1, Param2 ) // --> Nil METHOD AddLinkedControl( oControl ) // --> lSuccess METHOD DelLinkedControl( oControl ) // --> lSuccess METHOD lOnEdit() // --> lResult METHOD lOnAppend() // --> lResult METHOD FieldGetByName( c ) // --> Value METHOD FieldNames() // --> aFields METHOD FieldName( n ) // --> cName METHOD FieldDisplayName( n ) // --> cName METHOD FieldType( n ) // --> cType METHOD FieldSQLType( n ) // --> nType METHOD FieldLen( n ) // --> nLen METHOD FieldDec( n ) // --> nDecimals METHOD FieldPos( cField ) // --> nPosition METHOD FieldExist( c ) // --> lResult METHOD oFieldByName( c ) // --> oField METHOD FieldCount() INLINE Len( ::aFields ) // --> nCount METHOD FCount() INLINE Len( ::aFields ) // --> nCount METHOD Load() INLINE ::oRecords:LoadRecord( ::aFields ) METHOD Blank() INLINE ::oRecords:BlankRecord( ::aFields ) METHOD Modified() // --> lResult METHOD AddUserVar( cVar, Value ) // --> oField METHOD AddCalcField( cField, bBlock ) // --> oField METHOD GetRecord() // --> oRecord METHOD InitFrom( oDataSet ) // --> Nil METHOD SaveFrom( oDataSet ) // --> Nil METHOD SaveState( lStopUpdateLinked ) // --> .T. METHOD RestoreState( lRestoreUpdateLinked ) // --> lSuccess METHOD ReleaseState( lRestoreUpdateLinked ) // --> lSuccess METHOD IsReadOnly() INLINE ::lReadOnly .OR. ::nLockType == adLockReadOnly // --> lResult METHOD DelError() INLINE ( ::cLastError := "", ::nLastError := 0 ) // --> Nil METHOD GetRows() INLINE ::oRecords:GetRows() // --> aRows METHOD GetRow( nRow, lMove ) INLINE ::oRecords:GetRow( nRow, lMove ) // --> aRow METHOD GetRowsHash() METHOD GetRowHash( nRow ) METHOD Assign( oDataset ) // --> lSuccess RESERVED: EVENT OnPreAppend( oSender ) EVENT OnPostAppend( oSender ) METHOD Save( lFast ) METHOD NewError( cText, nError ) METHOD AddField( cField ) METHOD SetUserFields( aFields ) METHOD DelTempControls() METHOD CanBrowse() INLINE ::oRecords:CanBrowse() METHOD GetFilterExp( oDBBrowse ) INLINE ::oRecords:GetFilterExp( oDBBrowse ) METHOD GetSeekExp( oDBBrowse, cSeek ) INLINE ::oRecords:GetSeekExp( oDBBrowse, cSeek ) METHOD BuildSQLSt() INLINE ::oDataSource:BuildSQLSt( ::cName, ::aSQLParams ) METHOD UpdDataControlValue( nField, Value ) METHOD VarGet( n ) INLINE ::FieldGet( n ) // Deprecated METHOD VarPut( n, Value ) INLINE ::FieldPut( n, Value ) // --> Deprecated METHOD RecordID( xValue, lUpdLinked ) METHOD GesMoreData( cName, xValue ) METHOD SetUtfToAnsi( Value ) ERROR HANDLER OnError( uParam ) PROTECTED: METHOD SetDataSource( oDataSource ) METHOD ChangePos( nOp, Param ) METHOD SetName( Value ) ENDCLASS //-------------------------------------------------------------------------- METHOD GetRowsHash() CLASS XDataSet LOCAL xData := AClone( ::GetRows() ) LOCAL aFlds, aRow LOCAL nLen LOCAL hHash nLen := ::FieldCount() aFlds := Array( nLen ) AEval( aFlds, {|v,e| aFlds[ e ] := ::FieldName( e ) } ) FOR EACH aRow IN @xData hHash := HB_Hash() Aeval( aRow, {|v,e| HB_HSet( hHash, aFlds[ e ], v ) }, 1, nLen ) aRow := hHash NEXT RETURN xData //-------------------------------------------------------------------------- METHOD GetRowHash( nRow ) CLASS XDataSet LOCAL xData := ::GetRow( nRow ) LOCAL aFlds LOCAL hHash IF ValType( xData ) == "A" aFlds := Array( ::FieldCount() ) AEval( aFlds, {|v,e| aFlds[ e ] := ::FieldName( e ) } ) hHash := HB_Hash() Aeval( xData, {|v,e| HB_HSet( hHash, aFlds[ e ], v ) } ) xData := hHash ENDIF RETURN xData //-------------------------------------------------------------------------- METHOD SetName( Value ) CLASS XDataSet IF Value != ::FcName .AND. ! Empty( ::FcName ) ::Close() Aeval( ::aFields, {|v| v:Free() }) Aeval( ::aUserFields, {|v| v:Free() }) ::aFields := {} ::aUserFields := {} IF ! Empty( ::hFieldsList ) XA_WLFree( ::hFieldsList ) ::hFieldsList := XA_WLCreate() ENDIF ENDIF RETURN ::FcName := Value //-------------------------------------------------------------------------- METHOD SetUtfToAnsi( Value ) CLASS XDataSet IF ::oDataSource != NIL ::FlUtfToAnsi := Value ::Refresh() ENDIF RETURN ::FlUtfToAnsi //-------------------------------------------------------------------------- METHOD Create( oParent, oDS, cName, cProcess ) CLASS XDataSet ::Super:Create( oParent ) UPDATE ::oDataSource TO oDS UPDATE ::cName TO cName UPDATE ::cProcess TO cProcess IF ! Empty( ::hFieldsList ) XA_WLFree( ::hFieldsList ) ENDIF ::hFieldsList := XA_WLCreate() IF ::FlOpen ::FlOpen := .F. ::Open() ENDIF ::OnCreate() IF ::oParent != Nil ::oParent:InsertComponent( Self ) ENDIF RETURN Self //-------------------------------------------------------------------------- METHOD Destroy( lFree ) CLASS XDataSet DEFAULT lFree TO .F. ::Close() ::DelTempControls() Aeval( ::aFields, {|v| v:Free() }) Aeval( ::aUserFields, {|v| v:Free() }) ::aFields := {} ::aUserFields := {} IF ! Empty( ::hFieldsList ) XA_WLFree( ::hFieldsList ) ::hFieldsList := 0 ENDIF IF lFree IF ::oRecords != Nil ::oRecords:Destroy( lFree ) ENDIF ::oRecords := Nil ::oDataSource := Nil ENDIF IF ::oParent != Nil ::oParent:RemoveComponent( Self ) ENDIF ::oDBBrowse := Nil RETURN ::Super:Destroy( lFree ) //-------------------------------------------------------------------------- METHOD Open( lEvalEvent ) CLASS XDataSet LOCAL aFieldInfo LOCAL nFields LOCAL nFor LOCAL lCancel DEFAULT lEvalEvent TO .T. IF !::lCreated ::FlOpen := .T. RETURN .T. ENDIF IF Empty( ::oDataSource ) ::NewError( "No DataSource, impossible to continue" ) RETURN .F. ENDIF IF ::FlOpen ::NewError( "TDataSet " + LT( XA_MSG_YA_ESTA_ABIERTO ) ) RETURN .T. ENDIF IF !::oDataSource:lConnected .and. !::oDataSource:Connect() ::NewError( "No connection with DataSource" ) RETURN .F. ENDIF IF lEvalEvent lCancel := ::OnOpen() IF Valtype( lCancel ) == "L" .AND. ! lCancel RETURN .F. ENDIF ENDIF IF !::oRecords:Open() RETURN .F. ENDIF ::oDataSource:OnOpened( Self ) IF Len( ::aFields ) == 0 nFields := ::oRecords:FieldCount() FOR nFor := 1 TO nFields aFieldInfo := ::oRecords:FieldInfo( nFor ) WITH OBJECT ::AddField( aFieldInfo[ XA_FLDINFO_NAME ] ) :cDisplayName := :cName :cDbfName := StrPattern( :cName, " :,.$!%&?*-:;{}", .F. ) :nSQLType := aFieldInfo[ XA_FLDINFO_SQLTYPE ] :cType := aFieldInfo[ XA_FLDINFO_BASICTYPE ] :nSQLLen := aFieldInfo[ XA_FLDINFO_SQLLEN ] :nLen := aFieldInfo[ XA_FLDINFO_BASICLEN ] :nSQLDec := aFieldInfo[ XA_FLDINFO_SQLDEC ] :nDec := aFieldInfo[ XA_FLDINFO_BASICDEC ] :lAllowsNull := aFieldInfo[ XA_FLDINFO_ALLOWSNULL ] :lEditable := aFieldInfo[ XA_FLDINFO_EDITABLE ] :DefValue := aFieldInfo[ XA_FLDINFO_DEFVALUE ] :lAutoInc := aFieldInfo[ XA_FLDINFO_AUTOINC ] :lPrimaryKey := aFieldInfo[ XA_FLDINFO_PK ] :cTable := aFieldInfo[ XA_FLDINFO_TABLE ] :cFullName := IIF( Empty( :cTable ), "", :cTable + "." ) + :cName END WITH NEXT ::oRecords:CreateRecord( nFields ) ENDIF ::FlOpen := .T. AEval( ::aLinkedControls, {|v| v:SetFieldObject()} ) IF !Empty( ::oDBBrowse ) ::oDBBrowse:oDataSet := Self ENDIF ::GoTop( .F. ) ::Load() IF lEvalEvent ::OnPostOpen() ENDIF RETURN .T. //-------------------------------------------------------------------------- METHOD Close( lEvalEvent ) CLASS XDataSet LOCAL oControl LOCAL lCancel DEFAULT lEvalEvent TO .T. IF ! ::FlOpen RETURN .T. ENDIF IF lEvalEvent lCancel := ::OnClose() ENDIF IF Valtype( lCancel ) == "L" .AND. ! lCancel RETURN .F. ENDIF ::FlOpen := .F. FOR EACH oControl IN ::aLinkedControls oControl:ResetDataField() NEXT IF ::oDBBrowse != NIL FOR EACH oControl IN ::oDBBrowse:aCols oControl:ResetDataField() NEXT ::oDBBrowse:cOrgFilter := NIL ENDIF ::oRecords:Close() IF lEvalEvent ::OnPostClose() ENDIF IF ::oDBBrowse != NIL ::oDbBrowse:Refresh( .T. ) ENDIF RETURN .T. //-------------------------------------------------------------------------- METHOD AddNew( lFast ) CLASS XDataSet IF ::IsReadOnly() ::NewError( LT( XA_MSG_SET_DE_SOLO_LECTURA_ADNEW_NO_PERMITIDO ) ) RETURN .F. ENDIF IF ::lOnEdit() ::NewError( "Already in edit mode" ) RETURN .F. ENDIF DEFAULT lFast TO .F. ::lFast := lFast IF !lFast ::OnAddNew() ENDIF ::DelError() ::Blank() ::nEditRecord := -1 ::oRecords:AddNew() IF !lFast AEval( ::aLinkedControls, {|v| v:GetData(), v:Unlock() } ) ENDIF RETURN .T. //-------------------------------------------------------------------------- METHOD Edit( lFast ) CLASS XDataSet IF ::Recno() == 0 ::NewError( LT( XA_MSG_SET_VACIO_EDIT_NO_PERMITIDO ) ) RETURN .F. ENDIF IF ::IsReadOnly() ::NewError( LT( XA_MSG_SET_DE_SOLO_LECTURA_EDIT_NO_PERMITIDO ) ) RETURN .F. ENDIF IF ::lOnEdit() ::NewError( "Already in edit mode" ) RETURN .F. ENDIF DEFAULT lFast TO .F. ::lFast := lFast IF !lFast ::OnEdit() ENDIF ::DelError() ::Load() ::nEditRecord := ::Recno() ::oRecords:Edit() IF !lFast AEval( ::aLinkedControls, {|v| v:GetData(), v:Unlock() } ) ENDIF RETURN .T. //-------------------------------------------------------------------------- METHOD Update( lFast ) CLASS XDataSet LOCAL nRecno, nEditRecord LOCAL lAppend LOCAL Field nEditRecord := ::nEditRecord IF nEditRecord == 0 RETURN .F. ENDIF DEFAULT lFast TO .F. ::lOnUpdate := .T. nRecno := ::Recno() lAppend := ( nEditRecord == -1 ) IF nEditRecord != nRecno .AND. !lAppend ::NewError( LT( XA_MSG_SE_HA_MODIFICADO_LA_LINEA_EN_CURSO ) ) ::Cancel( lFast ) ::lOnUpdate := .F. RETURN .F. ENDIF IF !lFast ::OnUpdate() ENDIF IF !::Save( lFast ) //::Cancel( lFast ) IOZ: 09/01/2012 Permitir que siga la edición ::lOnUpdate := .F. RETURN .F. ENDIF IF ::nLastError != 0 .OR. ! ::oRecords:Update() // ::Cancel( lFast ) IOZ: 18/03/24 Permitir que siga la edición ::lOnUpdate := .F. RETURN .F. ENDIF ::nEditRecord := 0 IF !lFast ::OnPostSave() IF lAppend ::UpdateControls( XA_DSNAV_ADDNEW, ::Recno(), nRecno ) ELSE ::UpdateControls( XA_DSNAV_EDIT, nRecno ) ENDIF AEval( ::aLinkedControls, {|v| v:Lock(), v:Refresh() } ) ENDIF ::DelTempControls() ::lOnUpdate := .F. RETURN .T. //-------------------------------------------------------------------------- METHOD Cancel( lFast ) CLASS XDataSet LOCAL nRecord nRecord := ::nEditRecord IF nRecord == 0 ::NewError( LT( XA_MSG_USO_INVALIDO_DE_CANCEL ) ) RETURN .F. ENDIF DEFAULT lFast TO .F. IF nRecord > 0 .AND. nRecord != ::Recno() ::Goto( nRecord, .F. ) ENDIF IF !lFast ::OnCancel() ENDIF ::oRecords:Cancel() ::nEditRecord := 0 IF !lFast AEval( ::aLinkedControls, {|v| v:Lock(), v:Refresh() } ) IF nRecord > 0 ::UpdateControls( XA_DSNAV_EDIT, nRecord ) ENDIF ENDIF ::DelTempControls() RETURN .T. //-------------------------------------------------------------------------- METHOD Save( lFast ) CLASS XDataSet LOCAL lCancel IF !lFast lCancel := ::OnPreSave() IF Valtype( lCancel ) == "L" .AND. ! lCancel RETURN .F. ENDIF Aeval( ::aLinkedControls, {|v| v:SetData() } ) ENDIF RETURN ::oRecords:Save() //-------------------------------------------------------------------------- METHOD Delete( lFast ) CLASS XDataSet LOCAL nRecord LOCAL lCancel, lSuccess DEFAULT lFast TO .F. IF ::IsReadOnly() ::NewError( LT( XA_MSG_SET_DE_SOLO_LECTURA_DELETE_NO_PERMITIDO ) ) RETURN .F. ENDIF nRecord := ::Recno() IF !lFast lCancel := ::OnPreDelete() IF Valtype( lCancel ) == "L" .AND. ! lCancel RETURN .F. ENDIF ::ChangePos( XA_DSNAV_DELETE, nRecord ) ENDIF lSuccess := ::oRecords:Delete() IF !lFast ::UpdateControls( XA_DSNAV_DELETE, ::Recno(), nRecord ) ::OnPostDelete() ENDIF RETURN lSuccess //-------------------------------------------------------------------------- METHOD FastAddNew() CLASS XDataSet RETURN ::AddNew( .T. ) //-------------------------------------------------------------------------- METHOD FastEdit() CLASS XDataSet RETURN ::Edit( .T. ) //-------------------------------------------------------------------------- METHOD FastUpdate() CLASS XDataSet RETURN ::Update( .T. ) //-------------------------------------------------------------------------- METHOD FastCancel() CLASS XDataSet RETURN ::Cancel( .T. ) //-------------------------------------------------------------------------- METHOD FastDelete() CLASS XDataSet RETURN ::Delete( .T. ) //-------------------------------------------------------------------------- METHOD GoTop( lUpdLinked ) CLASS XDataSet DEFAULT lUpdLinked TO ::lUpdLinked IF lUpdLinked ::ChangePos( XA_DSNAV_GOTOP ) ENDIF ::oRecords:GoTop() IF lUpdLinked ::UpdateControls( XA_DSNAV_GOTOP ) ENDIF RETURN Nil //-------------------------------------------------------------------------- METHOD GoBottom( lUpdLinked ) CLASS XDataSet DEFAULT lUpdLinked TO ::lUpdLinked IF lUpdLinked ::ChangePos( XA_DSNAV_GOBOTTOM ) ENDIF ::oRecords:GoBottom() IF lUpdLinked ::UpdateControls( XA_DSNAV_GOBOTTOM ) ENDIF RETURN Nil //-------------------------------------------------------------------------- METHOD Goto( Recno, lUpdLinked ) CLASS XDataSet DEFAULT lUpdLinked TO ::lUpdLinked IF lUpdLinked ::ChangePos( XA_DSNAV_GOTO ) ENDIF ::oRecords:Goto( Recno ) IF lUpdLinked ::UpdateControls( XA_DSNAV_GOTO, Recno ) ENDIF RETURN Nil //-------------------------------------------------------------------------- METHOD KeyGoto( nPos, lUpdLinked ) CLASS XDataSet DEFAULT lUpdLinked TO ::lUpdLinked IF lUpdLinked ::ChangePos( XA_DSNAV_KEYGOTO ) ENDIF ::oRecords:KeyGoto( nPos ) IF lUpdLinked ::UpdateControls( XA_DSNAV_KEYGOTO, nPos ) ENDIF RETURN Nil //-------------------------------------------------------------------------- METHOD Skip( nSkip, lUpdLinked ) CLASS XDataSet DEFAULT nSkip TO 1, lUpdLinked TO ::lUpdLinked IF lUpdLinked ::ChangePos( XA_DSNAV_SKIP, nSkip ) ENDIF ::oRecords:Skip( nSkip ) IF lUpdLinked ::UpdateControls( XA_DSNAV_SKIP, nSkip, nSkip ) ENDIF RETURN Nil //-------------------------------------------------------------------------- METHOD nSkip( nSkip, lUpdLinked ) CLASS XDataSet LOCAL nSkipped DEFAULT nSkip TO 1, lUpdLinked TO ::lUpdLinked IF lUpdLinked ::ChangePos( XA_DSNAV_SKIP, nSkip ) ENDIF nSkipped := ::oRecords:nSkip( nSkip ) IF lUpdLinked ::UpdateControls( XA_DSNAV_SKIP, nSkip, nSkipped ) ENDIF RETURN nSkipped //-------------------------------------------------------------------------- METHOD Locate( cExp, lContinue, lUpdLinked ) CLASS XDataSet LOCAL lFound DEFAULT lUpdLinked TO ::lUpdLinked Application:lBusy := .T. IF lUpdLinked ::ChangePos( XA_DSNAV_LOCATE, cExp ) ENDIF lFound := ::oRecords:Locate( cExp, lContinue ) IF lUpdLinked ::UpdateControls( XA_DSNAV_LOCATE, cExp, lFound ) ENDIF Application:lBusy := .F. RETURN lFound //-------------------------------------------------------------------------- METHOD Filter( cFilter, lGoFirst, lUpdLinked, lFilterBar ) CLASS XDataSet LOCAL cOldFilter LOCAL lMsg cOldFilter := ::oRecords:Filter() IF cFilter == Nil RETURN cOldFilter ENDIF DEFAULT lGoFirst TO .T. DEFAULT lUpdLinked TO ::lUpdLinked DEFAULT lFilterBar TO .F. lMsg := .F. IF lFilterBar .AND. ::oDataSource != NIL .AND. ( lMsg := ::oDataSource:lDisplayErrors ) ::oDataSource:lDisplayErrors := .F. ENDIF IF ! lFilterBar .AND. ::oDbBrowse != Nil ::oDbBrowse:cOrgFilter := cFilter ENDIF ::oRecords:Filter( cFilter ) IF lGoFirst ::GoTop( lUpdLinked ) ENDIF IF lUpdLinked ::UpdateControls( XA_DSNAV_OTHER ) ENDIF IF lFilterBar .AND. lMsg ::oDataSource:lDisplayErrors := .T. ENDIF RETURN cOldFilter //-------------------------------------------------------------------------- METHOD Sort( cExpression, lGoFirst, lUpdLinked ) CLASS XDataSet LOCAL BookMark DEFAULT lGoFirst TO .T. DEFAULT lUpdLinked TO ::lUpdLinked BookMark := ::RecordID() IF ::oRecords:Sort( cExpression ) IF lGoFirst ::GoTop() ELSE //::GoTo( BookMark ) ::RecordID( BookMark, .F. ) ENDIF IF lUpdLinked ::UpdateControls( XA_DSNAV_OTHER ) ENDIF RETURN .T. ELSE LogDebug( "XAILER TDataSet:Sort() invalid expression (" + ToString( cExpression ) + ")" ) ENDIF RETURN .F. //-------------------------------------------------------------------------- METHOD RecordID( xValue, lUpdLinked ) CLASS XDataSet DEFAULT lUpdLinked TO ::lUpdLinked IF xValue <> NIL ::oRecords:RecordID( xValue ) IF lUpdLinked ::UpdateControls( XA_DSNAV_OTHER ) ENDIF RETURN xValue ENDIF RETURN ::oRecords:RecordID() //-------------------------------------------------------------------------- METHOD AutoSeek( cExp ) CLASS XDataSet LOCAL lFound Application:lBusy := .T. lFound := ::oRecords:AutoSeek( cExp ) Application:lBusy := .F. RETURN lFound //-------------------------------------------------------------------------- METHOD Recno() CLASS XDataSet RETURN ::oRecords:Recno() //-------------------------------------------------------------------------- METHOD RecCount() CLASS XDataSet RETURN ::oRecords:RecCount() //-------------------------------------------------------------------------- METHOD RecordCount() CLASS XDataSet RETURN ::oRecords:RecCount() //-------------------------------------------------------------------------- METHOD Eof() CLASS XDataSet RETURN ::oRecords:Eof() //-------------------------------------------------------------------------- METHOD Bof() CLASS XDataSet RETURN ::oRecords:Bof() //-------------------------------------------------------------------------- METHOD Refresh( lComplete ) CLASS XDataSet DEFAULT lComplete TO .F. IF lComplete ::oRecords:Refresh() ::UpdateControls( XA_DSNAV_FULLREFRESH ) ELSE ::SaveState( .T. ) ::oRecords:Refresh() ::RestoreState( .T. ) ::UpdateControls( XA_DSNAV_REFRESH ) ENDIF RETURN NIL //-------------------------------------------------------------------------- METHOD RefreshCurrent( nFlags1, nFlags2 ) CLASS XDataSet ::oRecords:RefreshCurrent( nFlags1, nFlags2 ) ::UpdateControls( XA_DSNAV_REFRESHCURRENT ) RETURN NIL //-------------------------------------------------------------------------- METHOD Clone( lMode ) CLASS XDataSet RETURN ::oRecords:Clone( lMode ) //-------------------------------------------------------------------------- METHOD Deleted() CLASS XDataSet RETURN ::oRecords:Deleted() //-------------------------------------------------------------------------- METHOD Commit() CLASS XDataSet RETURN ::oRecords:Commit() //-------------------------------------------------------------------------- METHOD RecLock( n ) CLASS XDataSet RETURN ::oRecords:RecLock( n ) //-------------------------------------------------------------------------- METHOD RecUnLock() CLASS XDataSet RETURN ::oRecords:RecUnLock() //-------------------------------------------------------------------------- METHOD KeyCount() CLASS XDataSet RETURN ::oRecords:KeyCount() //-------------------------------------------------------------------------- METHOD KeyNo() CLASS XDataSet RETURN ::oRecords:KeyNo() //-------------------------------------------------------------------------- METHOD FieldPut( n, v, lFromDC ) CLASS XDataSet LOCAL oError IF ::nEditRecord == 0 oError := ErrorNew() oError:Subsystem := "XAILER:FieldPut()" oError:Severity := ES_ERROR oError:Description := "Not in Edit or AddNew mode. FieldPut() not allowed" oError:Operation := "" Eval( ErrorBlock(), oError ) ENDIF IF n < 1 .OR. n > Len( ::aFields ) oError := ErrorNew() oError:Subsystem := "XAILER:FieldPut()" oError:Severity := ES_ERROR oError:Description := "Parameter out of range: " + ToString( n ) oError:Operation := "" Eval( ErrorBlock(), oError ) ENDIF v := ::oRecords:FieldPut( n, v ) ::aFields[ n ]:lModified := ::lOnAppend() .OR. ::aFields[ n ]:HasChanged( v ) /* En el caso de que la modificación no llegue a traves de un datacontrol hay que actualizar el valor de los mismos */ IF !::lFast .AND. !::lOnUpdate .AND. ( lFromDC == NIL .OR. !lFromDC ) ::UpdDataControlValue( n, v ) ENDIF RETURN v //-------------------------------------------------------------------------- METHOD FieldGet( n, lForceRecno ) CLASS XDataSet RETURN ::oRecords:FieldGet( n, lForceRecno ) //-------------------------------------------------------------------------- METHOD SetDataSource( oDataSource, lCheckType ) CLASS XDataSet LOCAL oError LOCAL lOpened DEFAULT lCheckType TO .T. IF oDataSource != Nil .AND. lCheckType .AND. oDataSource:IsKindOf( "TDbfDataSource" ) oError := ErrorNew() oError:Subsystem := "XAILER:SetDataSource" oError:Severity := ES_ERROR oError:Description := "Incorrect DataSource type, should NOT be KindOf('TDbfDataSource') " oError:Operation := "" Eval( ErrorBlock(), oError ) ENDIF lOpened := ::lOpen ::lOpen := .F. IF ::FoDataSource != Nil ::oDataSource:DelDataSet( Self, .F. ) ::FoDataSource := Nil ENDIF IF oDataSource != Nil ::FoDataSource := oDataSource ::cProcess := Upper( oDataSource:cProcess ) oDataSource:AddDataSet( Self ) ::oRecords := oDataSource:GetRecords( Self, ::lIsTable ) IF lOpened ::lOpen := .T. ENDIF ENDIF RETURN Nil //-------------------------------------------------------------------------- METHOD AddField( cName ) CLASS XDataSet LOCAL oField LOCAL nlen nLen := Len( ::aFields ) + 1 XA_WLAdd( ::hFieldsList, cName, nLen ) IF !Empty( cName ) .AND. __objHasMsg( Self, cName ) .AND. IsDebuggerPresent() LogDebug( "XAILER: Warning! TDataset:Field value: " + cName + " conflicts with a TDataset member." ) ENDIF oField := TDataField():Create( Self, nLen, cName ) AAdd( ::aFields, oField ) RETURN oField //-------------------------------------------------------------------------- METHOD AddUserVar( cVar, Value ) CLASS XDataSet LOCAL oField LOCAL nlen nLen := Len( ::aUserFields ) + 1 XA_WLAdd( ::hFieldsList, cVar, -nLen ) IF __objHasMsg( Self, cVar ) LogDebug( "XAILER: Warning! TDataset:UserVar value: " + cVar +" conflicts with a TDataset member." ) ENDIF oField := TDataField():Create( Self, nLen, cVar ) WITH OBJECT oField :OnGetValue := {|o| o:SetGetFValue() } :OnSetValue := {|o, v| o:SetGetFValue( v ) } :SetGetFValue( Value ) END WITH AAdd( ::aUserFields, oField ) RETURN oField //-------------------------------------------------------------------------- METHOD AddCalcField( cField, bBlock ) CLASS XDataSet LOCAL oField, oControl LOCAL xField LOCAL nlen nLen := Len( ::aUserFields ) + 1 XA_WLAdd( ::hFieldsList, cField, -nLen ) IF __objHasMsg( Self, cField ) LogDebug( "XAILER: Warning! TDataset:CalcField value: " + cField +" conflicts with a TDataset member." ) ENDIF oField := TDataField():Create( Self, nLen, cField ) WITH OBJECT oField :bGetValue := bBlock // lo necesito en metodo Clone() :OnGetValue := bBlock :OnSetValue := {|v| v } END WITH AAdd( ::aUserFields, oField ) FOR EACH oControl IN ::aLinkedControls xField := oControl:oDataField IF Valtype( xField ) == "C" oControl:oDataField := xField ENDIF NEXT IF ::oDBBrowse != Nil FOR EACH oControl IN ::oDBBrowse:aCols xField := oControl:oDataField IF Valtype( xField ) == "C" oControl:oDataField := xField ENDIF NEXT ENDIF RETURN oField //-------------------------------------------------------------------------- METHOD SetUserFields( aFields ) CLASS XDataSet LOCAL oField ::FaUserFields := aFields FOR EACH oField IN aFields XA_WLAdd( ::hFieldsList, oField:cName, -oField:__EnumIndex() ) NEXT RETURN Nil //-------------------------------------------------------------------------- METHOD FieldNames() CLASS XDataSet LOCAL aFields := Array( Len( ::aFields ) ) AEval( ::aFields, {|v,e| aFields[ e ] := v:cName }) RETURN aFields //-------------------------------------------------------------------------- METHOD FieldPos( cField ) CLASS XDataSet RETURN Max( XA_WLSearch( ::hFieldsList, cField ), 0 ) //-------------------------------------------------------------------------- METHOD oFieldByName( cField ) CLASS XDataSet LOCAL oField LOCAL nAt nAt := XA_WLSearch( ::hFieldsList, cField ) IF nAt > 0 oField := ::aFields[ nAt ] ELSEIF nAt < 0 oField := ::aUserFields[ -nAt ] ENDIF RETURN oField //-------------------------------------------------------------------------- METHOD lOnEdit() CLASS XDataSet RETURN ::nEditRecord != 0 //-------------------------------------------------------------------------- METHOD lOnAppend() CLASS XDataSet RETURN ::nEditRecord == -1 //-------------------------------------------------------------------------- METHOD FieldGetByName( c ) CLASS XDataSet RETURN ::FieldGet( ::FieldPos( c ) ) //-------------------------------------------------------------------------- METHOD FieldName( n ) CLASS XDataSet RETURN ::aFields[ n ]:cName //-------------------------------------------------------------------------- METHOD FieldDisplayName( n ) CLASS XDataSet RETURN ::aFields[ n ]:cDisplayName //-------------------------------------------------------------------------- METHOD FieldType( n ) CLASS XDataSet RETURN ::aFields[ n ]:cType //-------------------------------------------------------------------------- METHOD FieldSQLType( n ) CLASS XDataSet RETURN ::aFields[ n ]:nSQLType //-------------------------------------------------------------------------- METHOD FieldLen( n ) CLASS XDataSet RETURN ::aFields[ n ]:nLen //-------------------------------------------------------------------------- METHOD FieldDec( n ) CLASS XDataSet RETURN ::aFields[ n ]:nDec //-------------------------------------------------------------------------- METHOD FieldExist( c ) CLASS XDataSet RETURN ( ::FieldPos( c ) > 0 ) //-------------------------------------------------------------------------- METHOD Modified() CLASS XDataSet RETURN AScan( ::aFields, {|v| v:lModified } ) > 0 //-------------------------------------------------------------------------- METHOD UpdateControls( nOp, Param1, Param2 ) CLASS XDataSet IF nOp == Nil AEval( ::aLinkedControls, {|v| v:Refresh( , XA_DSNAV_OTHER ) } ) IF ::oDBBrowse != Nil .AND. !Empty( ::oDbBrowse:Handle ) ::oDBBrowse:DSNavigate( XA_DSNAV_OTHER ) ENDIF ELSEIF ::lUpdLinked ::OnPostChange( nOp, Param1, Param2 ) AEval( ::aLinkedControls, {|v| v:Refresh( , nOp, Param1, Param2 ) } ) IF ::oDBBrowse != Nil .AND. ! Empty( ::oDbBrowse:Handle ) ::oDBBrowse:DSNavigate( nOp, Param1, Param2 ) ENDIF ENDIF RETURN Nil //-------------------------------------------------------------------------- METHOD AddLinkedControl( oControl ) CLASS XDataSet IF AScan( ::aLinkedControls, {|v| v == oControl } ) == 0 AAdd( ::aLinkedControls, oControl ) RETURN .T. ENDIF RETURN .F. //-------------------------------------------------------------------------- METHOD DelLinkedControl( oControl ) CLASS XDataSet LOCAL nAt IF ( nAt := AScan( ::aLinkedControls, {|v| v == oControl } ) ) > 0 ADel( ::aLinkedControls, nAt ) ASize( ::aLinkedControls, Len( ::aLinkedControls ) - 1 ) ENDIF RETURN ( nAt > 0 ) //-------------------------------------------------------------------------- METHOD DelTempControls() CLASS XDataSet LOCAL oControl LOCAL nFor, nLen, nDel nLen := Len( ::aLinkedControls ) nDel := 0 nFor := 1 DO WHILE nFor <= Len( ::aLinkedControls ) oControl := ::aLinkedControls[ nFor ] IF oControl != Nil .AND. oControl:Handle == 0 ADel( ::aLinkedControls, nFor ) oControl:oDataSet := Nil nDel ++ ELSE nFor ++ ENDIF ENDDO IF nDel > 0 ASize( ::aLinkedControls, nLen - nDel ) ENDIF RETURN Nil //-------------------------------------------------------------------------- METHOD ChangePos( nOp, Param ) CLASS XDataSet IF ::lUpdLinked ::OnPreChange( nOp, Param ) IF ::oDBBrowse != Nil .AND. ! Empty( ::oDBBrowse:Handle ) ::oDBBrowse:DrawLine() ENDIF ENDIF RETURN Nil //-------------------------------------------------------------------------- METHOD SaveState( lStopUpdateLinked ) CLASS XDataSet IF lStopUpdateLinked != Nil ::lUpdLinked := !lStopUpdateLinked ENDIF IF ::nCursorType = adOpenForwardOnly RETURN .F. ENDIF AAdd( ::aState, { ::Recno(), ::Filter() } ) RETURN .T. //-------------------------------------------------------------------------- METHOD RestoreState( lRestoreUpdateLinked ) CLASS XDataSet LOCAL lUpd := ::lUpdLinked LOCAL aData LOCAL nFor IF Len( ::aState ) == 0 .OR. ::nCursorType == adOpenForwardOnly RETURN .F. ENDIF aData := ATail( ::aState ) ::lUpdLinked := .F. ::Filter( aData[ 2 ], .F., .F., .T. ) IF aData[ 1 ] > 0 .AND. aData[ 1 ] <= ::RecCount() ::Goto( aData[ 1 ] ) ELSE ::GoTop() ENDIF ASize( ::aState, Len( ::aState ) - 1 ) ::lUpdLinked := lUpd IF lRestoreUpdateLinked != Nil ::lUpdLinked := lRestoreUpdateLinked ENDIF RETURN .T. //-------------------------------------------------------------------------- METHOD ReleaseState( lRestoreUpdateLinked ) CLASS XDataSet IF Len( ::aState ) == 0 RETURN .F. ENDIF ASize( ::aState, Len( ::aState) - 1 ) IF lRestoreUpdateLinked != Nil ::lUpdLinked := lRestoreUpdateLinked ENDIF RETURN .T. //-------------------------------------------------------------------------- METHOD GetRecord() CLASS XDataSet LOCAL oRecord oRecord := TExStruct():New() AEval( ::aFields, {|v,e| oRecord:AddMember( v:cName, v:cType, ::FieldGet( e ), v:nLen ) } ) RETURN oRecord //-------------------------------------------------------------------------- METHOD InitFrom( oDataSet ) CLASS XDataSet LOCAL oTargetField, oSourceField LOCAL nFor, nlen nLen := Len( oDataSet:aFields ) FOR nFor := 1 TO nLen oSourceField := oDataSet:aFields[ nFor ] oTargetField := ::oFieldByName( oSourceField:cName ) IF oTargetField != Nil oTargetField:Value := oSourceField:Value ENDIF NEXT RETURN Nil //-------------------------------------------------------------------------- METHOD SaveFrom( oData ) CLASS XDataSet LOCAL oTargetField, oSourceField LOCAL cField LOCAL nFor, nLen IF oData:IsKindOf( "TDataSet" ) nLen := Len( oData:aFields ) FOR nFor := 1 TO nLen oSourceField := oData:aFields[ nFor ] oTargetField := ::oFieldByName( oSourceField:cName ) IF oTargetField != Nil oTargetField:Value := oSourceField:Value ENDIF NEXT ELSE // oRecord nLen := oData:Len() FOR nFor := 1 TO nLen cField := oData:GetName( nFor ) oTargetField := ::oFieldByName( cField ) IF oTargetField != Nil oTargetField:Value := oData:GetValue( nFor ) ENDIF NEXT ENDIF RETURN Nil //-------------------------------------------------------------------------- METHOD UpdDataControlValue( nField, Value ) CLASS XDataSet LOCAL oField, oControl oField := ::aFields[ nField ] IF ValType( oField ) == "O" FOR EACH oControl IN ::aLinkedControls WITH OBJECT oControl IF Valtype( :oDataField ) == "O" .and. :oDataField == oField :Value := Value EXIT ENDIF END WITH NEXT ENDIF RETURN NIL //-------------------------------------------------------------------------- METHOD OnError( uParam ) CLASS XDataSet LOCAL oError LOCAL xValue LOCAL cField LOCAL nField, nError LOCAL lField cField := __GetMessage() lField := .F. IF Left( cField, 1 ) == "_" // SET cField := Substr( cField, 2 ) IF Left( cField, 3 ) == "DF_" cField := SubStr( cField, 4 ) lField := .t. ENDIF nField := XA_WLSearch( ::hFieldsList, cField ) IF nField > 0 RETURN ::FieldPut( nField, uParam ) ELSEIF nField < 0 RETURN ::aUserFields[ -nField ]:Value := uParam ELSEIF lField .AND. uParam != NIL .AND. ::GesMoreData( cField, uParam ) RETURN uParam ENDIF nError := 1005 ELSE IF Left( cField, 3 ) == "DF_" cField := SubStr( cField, 4 ) lField := .t. ENDIF DEFAULT uParam TO dsAUTO nField := XA_WLSearch( ::hFieldsList, cField ) IF nField > 0 SWITCH uParam CASE dsAUTO CASE dsFIELD CASE dsVAR RETURN ::FieldGet( nField, uParam == dsFIELD ) CASE dsOBJECT RETURN ::aFields[ nField ] END ELSEIF nField < 0 SWITCH uParam CASE dsAUTO CASE dsFIELD CASE dsVAR RETURN ::aUserFields[ -nField ]:Value CASE dsOBJECT RETURN ::aUserFields[ -nField ] END ELSEIF lField .AND. ::GesMoreData( cField, @xValue ) RETURN xValue ENDIF nError := 1004 ENDIF oError := ErrorNew() oError:SubSystem := "BASE" oError:SubCode := nError oError:Severity := ES_ERROR oError:Description := "Message or field name not found" oError:Operation := ::ClassName() + ":" + cField oError:Args := { uParam } Eval( ErrorBlock(), oError ) RETURN Nil //-------------------------------------------------------------------------- METHOD NewError( cText, nError ) CLASS XDataSet IF ::oDataSource != Nil ::oDataSource:NewError( @cText, @nError, Self ) ELSE IF ::lDisplayErrors MsgAlert( cText, "Xailer: DataControls error") ELSE LogDebug( cText ) ENDIF IF ::lAbortOnErrors WITH OBJECT ErrorNew() :Subsystem := "XAILER" IF ! Empty( nError ) :SubCode := nError ENDIF :Severity := ES_ERROR :Description := cText Eval( ErrorBlock(), :__WithObject() ) END WITH ENDIF ENDIF ::cLastError := cText ::nLastError := IIF( nError != Nil, nError, 0 ) RETURN Nil //-------------------------------------------------------------------------- METHOD Assign( oDataset ) CLASS XDataSet LOCAL oField IF !( ::Classname == oDataset:Classname ) ::NewError( "TDataset:Assign(): Dataset should be exactly the same type" ) RETURN .F. ENDIF IF oDataset:oDataSource == NIL ::NewError( "TDataset:Assign(): Dataset:oDataSource member can not be NIL" ) RETURN .F. ENDIF ::Close() Aeval( ::aFields, {|v| v:Free() }) Aeval( ::aUserFields, {|v| v:Free() }) ::aFields := {} ::aUserFields := {} IF ::oRecords != NIL ::oRecords:ResetRecord() ENDIF IF !Empty( ::hFieldsList ) XA_WLFree( ::hFieldsList ) ENDIF ::hFieldsList := XA_WLCreate() FOR EACH oField IN oDataset:aUserFields ::AddCalcField( oField:cName, oField:bGetValue ) NEXT WITH OBJECT oDataset ::cProcess := :cProcess ::cName := :cName ::aSQLParams := :aSQLParams ::nCursorLocation := :nCursorLocation ::nCursorType := :nCursorType ::nLockType := :nLockType ::nMaxRecords := :nMaxRecords ::lDisplayErrors := :lDisplayErrors ::lUpdLinked := :lUpdLinked ::lReadOnly := :lReadOnly ::oDataSource := :oDataSource ::lOpen := :lOpen IF ::lOpen IF !Empty( :Filter() ) ::SetFilter( :Filter() ) ENDIF ::GoTo( :Recno ) ENDIF END WITH RETURN .T. //-------------------------------------------------------------------------- METHOD GesMoreData( cName, xValue ) CLASS XDataset LOCAL hHash LOCAL nField local item nField := XA_WLSearch( ::hFieldsList, "moredata" ) IF Empty( nField ) ::NewError( "TDataset:!" + cName + ": Field not found on Dataset. Impossible to continue." ) RETURN .F. ENDIF HB_JsonDecode( ::FieldGet( nField ), @hHash ) IF Empty( hHash ) hHash := HB_Hash() ELSE XA_HashFixDateTime( @hHash ) ENDIF HB_HAutoAdd( hHash, .T. ) HB_HCaseMatch( hHash, .F. ) IF xValue == NIL // Get IF HB_HHasKey( hHash, cName ) xValue := hHash[ cName ] ENDIF ELSE // Set hHash[ cName ] := xValue ::FieldPut( nField, HB_JsonEncode( hHash, .t. ) ) ENDIF RETURN .T.