Welcome To The Home Of The Visual FoxPro Experts  
home. signup. forum. archives. search. google. articles. downloads. faq. members. weblogs. file info. rss.
 From: Koen Piller
  Where is Koen Piller?
 Santpoort-Zuid
 Netherlands
 Koen Piller
 To: mk sharma
  Where is mk sharma?
 mumbai
 India
 mk sharma
 Tags
Subject: RE: Procedure for TABLEUPDATE
Thread ID: 330904 Message ID: 330954 # Views: 35 # Ratings: 1
Version: Visual FoxPro 9 SP2 Category: Forms
Date: Saturday, December 24, 2011 8:59:11 PM         
   


> Which is good ?
>
> Update Procedure1
>
>
> proc upd1
> ****
> lnNextRec = 0
> Do While .T.
>    lnNextRec = Getnextmodified( lnNextRec )
>    If lnNextRec = 0
>       Exit
>    Endif
>    = CheckRow( lnNextRec, lcTable )
> Enddo
> 
> *** Update all the Buffered Records
> If Reccount( "curcflix") = 0
>    llRetval = Tableupdate( .T., .T., lcTable)   && No conflict  so update all the records.
> Else
>    llRetval = Tableupdate( .T., .T., lcTable )  && Conflict but update as per latest changes.
> Endif
> Return llRetval
> 
> Function CheckRow
> ****
> Parameters tnRecNum, tcTable
> Local lnCnt, luCurVal, luOldVal, lnRows, llRetval, lcFldList, lcFldName, luUsrVal
> 
> Select (tcTable)
> If Recno() # tnRecNum
>    Goto tnRecNum
> Endif
> 
> lcFldList = ""
> *lcFldList = GetUserChanges( tcTable )
> lcFldList = GetUserChanges()
> 
> For lnCnt = 1 To Fcount()
>    lcFldName = Field( lnCnt )
>    luCurVal = Curval( Field( lnCnt ))
>    luOldVal = Oldval( Field( lnCnt ))
>    luUsrVal = Eval( Field( lnCnt ))
> 
>    If luCurVal == luOldVal
>    Else
>       If ! Field( lnCnt ) $ lcFldList
>          If Not Isnull(luCurVal)
>             Replace (Field(lnCnt)) With luCurVal
>          Endif
>       Else
>          If Eval( Field(lnCnt) ) == luCurVal
>             Loop
>          Else
>             Insert Into curcflix ( cfxRecNum, cfxFldNam, cfxOldVal, cfxCurVal, cfxUsrVal, cfxForcit);
>             VALUES ( Transform(Recno()), lcFldName, Transform(luOldVal), Transform(luCurVal), ;
>             TRANSFORM(luUsrVal), 2 )
>          Endif
>       Endif
>    Endif
> Next
> 
> *** Update Log Data
> updlog(ttdatetime,tclogfile)
> 
> 

>
>
> Update Procedure2
>
>
> proc upd2
> ****
> lnNextRec = 0
> Do While .T.
>    lnNextRec = Getnextmodified( lnNextRec )
>    If lnNextRec = 0
>       Exit
>    Endif
>    = CheckRow( lnNextRec, lcTable )
> Enddo
> 
> Function CheckRow
> ****
> Parameters tnRecNum, tcTable
> Local lnCnt, luCurVal, luOldVal, lnRows, llRetval, lcFldList, lcFldName, luUsrVal
> 
> Select (tcTable)
> If Recno() # tnRecNum
>    Goto tnRecNum
> Endif
> 
> lcFldList = ""
> *lcFldList = GetUserChanges( tcTable )
> lcFldList = GetUserChanges()
> 
> For lnCnt = 1 To Fcount()
>    lcFldName = Field( lnCnt )
>    luCurVal = Curval( Field( lnCnt ))
>    luOldVal = Oldval( Field( lnCnt ))
>    luUsrVal = Eval( Field( lnCnt ))
> 
>    If luCurVal == luOldVal
>    Else
>       If ! Field( lnCnt ) $ lcFldList
>          If Not Isnull(luCurVal)
>             Replace (Field(lnCnt)) With luCurVal
>          Endif
>       Else
>          If Eval( Field(lnCnt) ) == luCurVal
>             Loop
>          Else
>             Insert Into curcflix ( cfxRecNum, cfxFldNam, cfxOldVal, cfxCurVal, cfxUsrVal, cfxForcit);
>             VALUES ( Transform(Recno()), lcFldName, Transform(luOldVal), Transform(luCurVal), ;
>             TRANSFORM(luUsrVal), 2 )
>          Endif
>       Endif
>    Endif
> Next
> 
> ****  Update Single Record
> If Reccount( "curcflix") = 0
>    llRetval = Tableupdate( 0, .T., lcTable)   && No conflict  so update the current Record.
> Else
>    llRetval = Tableupdate( 0, .T., lcTable )  && Conflict but update the current Record as per latest changes.
> Endif
> 
> *** Update Log Data
> updlog(ttdatetime,tclogfile)
> 
> 

>
> Warm Regards,
> mk.


Hi,

instead of puzzling/checking and rechecking your code I will give you my 'tableupdate' routine - which I borrowed from one of the VFP wizzard's - you may check your code against this one yourselve :)

Regards,

Koen
* Local Defines for errorhandling
* will only come into live when global errorhandler is not installed
#Define	E_FAIL_LOC			"Failed to update table: "
#Define E_PRIMARYKEY_LOC	"Unique primary key violation."
#Define	E_TRIGGERFAIL_LOC	"Trigger failed."
#Define	E_FIELDNULL_LOC		"Field doesn't accept NULL"
#Define	E_FIELDRULE_LOC		"Field rule violated"
#Define	E_RECORDLOCK_LOC	"Record in use by another user"
#Define	E_ROWRULE_LOC		"Row rule violated"
#Define	E_UNIQUEINDEX_LOC	"Unique index violation"
#Define	E_DIRTYREC_LOC		"Data has been changed by another user. Overwrite changes with your edits?"
#Define	E_NOFORCE_LOC		"Could not force table updates."
#Define E_PROMPT_LOC	 	"Error: "
#Define MSGBOX_YES		6

Local lcErrorMessage, lnTablesUsed, lnTotErr, lcOldErrorSetting, llExternErrorCatch
Local lnFld,lnTable, lnOldArea,lnSuccess,llinDBC,llOverwrite,llHadMessage
Local llnChildFirst, lnModRecord, liFile
Local Array aErrors[1]
Local Array aTablesUsed[1]
 
 
lcOldErrorSetting = ''
Dimension aTablesUsed[1]
Dimension aErrors[1]
m.lcErrorMessage=""
m.lnSuccess = .T.
m.lnOldArea = Select()
m.lnTablesUsed = Aused(aTablesUsed)
lcOldErrorSetting = On('Error')

If !Empty(lcOldErrorSetting)
	llExternErrorCatch = .T.
Endif


* Need to sort in proper order in case of DBC triggers
* Insert - parent must go first
* Delete/Updates - child must go first
llnChildFirst=0
If !Empty(This.ChildAlias) And !Empty(This.ParentAlias)
	For lnTable = 1 To m.lnTablesUsed
		If Upper(aTablesUsed[m.lnTable,1])==Upper(This.ChildAlias)
			llnChildFirst=1
			Exit
		Endif
		If Upper(aTablesUsed[m.lnTable,1])==Upper(This.ParentAlias)
			llnChildFirst=2
			Exit
		Endif
	Endfor
Endif

** kill non structural indexes
For liFile = 1 To m.lnTablesUsed
	This.Structuralindex(( aTablesUsed[m.liFile,1]) )
Endfor

* Can wrap everything in transaction if using strictly DBCs
For lnTable = 1 To m.lnTablesUsed
	Select (aTablesUsed[m.lnTable,1])

	m.llinDBC = !Empty(CursorGetProp("Database"))
	m.lcErrorMessage = ""
	m.llOverwrite = .F.
	m.llHadMessage = .F.

	Do Case
	Case CursorGetProp("Buffering") = 1
        * Skip if buffering not on
		Loop
	Case Getfldstate(0) = 2			&&deleted record
        * Only delete current record and force it
		m.lnSuccess = Tableupdate(.F.,.T.)
		If m.lnSuccess				&&successful update
			Loop
		Endif
	Case !m.llinDBC And ;
			(Atc("2",Getfldstate(-1))#0 Or ;
			ATC("3",Getfldstate(-1))#0)
            * Field was edited - in Free Table
            * Since free tables are not supported by transactions,
            * we must process record by record

		m.lnModRecord = Getnextmod(0)
		Do While m.lnModRecord # 0	&&loop locks all records
			Go m.lnModRecord
			m.lnSuccess = Rlock()	&&try to lock record
			If !m.lnSuccess			&&failed to lock record
				m.lcErrorMessage = E_RECORDLOCK_LOC
				Unlock All
				Exit
			Endif
			If !m.llHadMessage	&&so we don't repeat alert
                * See if record(s) modified by another user
				For m.lnFld = 1 To Fcount()
					If Type(Field(m.lnFld)) = "G"	&&skip for General fields
						Loop
					Endif
					If Oldval(Field(m.lnFld)) # Curval(Field(m.lnFld))
						m.llHadMessage = .T.
						If Messagebox(E_DIRTYREC_LOC,4+48) = MSGBOX_YES
							m.llOverwrite = .T.
						Else
							m.lnSuccess = .F.
							Unlock All
							Exit
						Endif
					Endif
				Endfor
			Endif
			m.lnModRecord = Getnextmod(m.lnModRecord)
		Enddo
		If m.lnSuccess 	&&was able to lock all records

			m.lnSuccess = Tableupdate(.T.,m.llOverwrite)
			If m.lnSuccess &&was able to update all records
				Loop
			Endif
			Unlock All
		Endif
	Case m.llinDBC


		Begin Transaction
			* Need to sort in proper order in case of DBC triggers
			* Insert - parent must go first
			* Delete/Updates - child must go first
		If llnChildFirst=1  &&child first
			Select (This.ParentAlias)
			m.lnSuccess = Tableupdate(.T.,.F.)	&&successful update
			llnChildFirst=0
			Select (aTablesUsed[m.lnTable,1])
		Endif

		* Try to update all records in selected table
		m.lnSuccess = Tableupdate(.T.,.F.)	&&successful update
		If m.lnSuccess
			End Transaction
			Loop
		Endif
		Rollback
	Endcase

	* If no global error handler installed than handle errors:
	If llExternErrorCatch = .F.
		lnTotErr =Aerror(aErrors)
		Do Case
		Case lnTotErr = 0
		Case aErrors[1,1] = 1547				&& Unique primary key violation
			m.lcErrorMessage = E_PRIMARYKEY_LOC
		Case aErrors[1,1] = 1539				&& Trigger failed
			m.lcErrorMessage = E_TRIGGERFAIL_LOC
		Case aErrors[1,1] = 1581				&& Field doesn't accept NULL
			m.lcErrorMessage = E_FIELDNULL_LOC
		Case aErrors[1,1] = 1582				&& Field rule violated
			m.lcErrorMessage = E_FIELDRULE_LOC
		Case aErrors[1,1] = 1700				&& Record in use by another user
			m.lcErrorMessage = E_RECORDLOCK_LOC
		Case aErrors[1,1] = 1583				&& Row rule violated
			m.lcErrorMessage = E_ROWRULE_LOC
		Case aErrors[1,1] = 1884				&& Unique index violation
			m.lcErrorMessage = E_UNIQUEINDEX_LOC
		Case aErrors[1,1] = 1585				&& Record changed by another user
			If m.llinDBC		&&handle free tables above
				* Display conflict alert
				If Messagebox(E_DIRTYREC_LOC,4+48) = MSGBOX_YES
					* Try to force update
					Begin Transaction
					m.lnSuccess = Tableupdate(.T.,.T.)
					If m.lnSuccess
						End Transaction
						Loop
					Else
						Rollback
						=Messagebox(E_NOFORCE_LOC)
					Endif
				Endif
			Endif

		Otherwise
			If !Empty(m.lcErrorMessage)	&&for free table handling above
				m.lcErrorMessage = E_PROMPT_LOC+aErrors[1,2]
			Endif
		Endcase
	Endif

	* Had an error we couldn't handle
	Tablerevert(.T.)  &&revert all records
	m.lnSuccess = .F.
	If !Empty(m.lcErrorMessage)
		Messagebox(E_FAIL_LOC+m.lcErrorMessage)
	Endif

Endfor

Unlock All &&  New code

Select (m.lnOldArea)
Return m.lnSuccess

Coding without the use of m. is not generic and should be qualified as recreational

ENTIRE THREAD

Procedure for TABLEUPDATE Posted by mk sharma @ 12/24/2011 11:04:13 AM
RE: Procedure for TABLEUPDATE Posted by Koen Piller @ 12/24/2011 8:59:11 PM