Select islemDosyasi
Delete
If Not Tableupdate(1,.T.,islemDosyasi)
Aerror(laUpdErr1)
Do ErrLog With 0,Lineno(),"","Tableupdate Failed: "+Trans(laUpdErr1[1])+": "+laUpdErr1[2]
Endif
*********************************************************************
*procedure ERRLOG
* (c) B. Peisch for Peisch Custom Software, Inc., 1990-2002
local ldErr_Dt, lcErr_Tm, lnErr_N, lcErr_OFil, lcErr_Mess, loErr_Wind, ;
lcErr_Call, lnErr_Num, lcErr_Prt, lcErr_Cons, lcErr_Talk, lcCmd, ;
llErr_Evnt, lcErr_Path, lnErr_DS, lnLineNo, lcUserId, lcAns
* Check for parameters
if empty(tnLineNo)
lnLineNo = 0
ELSE
lnLineNo = tnLineNo
endif
if empty(tcUserID)
lcUserID = ''
ELSE
lcUserId = tcUserId
endif
if empty(tcErr_Mess)
llErr_Evnt = .F. && logging a problem
lcErr_Mess = message()
else
llErr_Evnt = .T. && recording an event
lcErr_Mess = tcErr_Mess
endif
lnErr_Num = error()
if lnErr_Num = 1707 && STRUCTURAL CDX FILE NOT FOUND
* This is a workaround for earlier versions of 2.0 where an error
* would occur on a Use command if the CDX was missing. Issuing a
* retry will remove the structure CDX reference from the file and
* open the database.
retry
endif
lcErr_Call = on('Error')
on error && Turn off error logging so it's not called recursively
do case
case empty(tnDataSess) or type('tnDataSess') <> 'N'
lnErr_DS = 0
case type('tnDataSess') = 'N' and tnDataSess <> 0
lnErr_DS = set('DataSession')
set datasession to tnDataSess
case type('thisform.Datasessionid') <> 'U'
lnErr_Ds = thisform.DatasessionId
otherwise
lnErr_Ds = 0
endcase
* Save settings in case we are logging an event
lnErr_Prt = set('Print')
set print off
lnErr_Cons = set('Console')
set console on
lnErr_Talk = set('Talk')
set talk off
if type('_screen.activeform') = 'O'
loErr_Wind = _screen.activeform
else
loErr_Wind = .null.
endif
ldErr_Dt = date()
lcErr_Tm = time()
lcErr_OFil = select()
if lnErr_Num = 15 && NOT A DATABASE FILE
clear
?? chr(7)
wait 'ONE OF YOUR DATA FILES IS DAMAGED' window
quit
endif
if lnErr_Num = 125 or lnErr_Num = 1958 && PRINTER NOT READY or Error loading printer driver
IF NOT EMPTY(MESSAGE(1)) AND "REPORT FORM" $ UPPER(MESSAGE(1))
DO FORM NoPrinter WITH .T. TO lcAns
ELSE
DO FORM NoPrinter TO lcAns
ENDIF
do CASE
CASE lcAns = "Quit"
quit
CASE lcAns = "Retry"
on error &lcErr_Call
lcCmd = 'retry'
OTHERWISE
* The display option was selected
lcCmd = MESSAGE(1)+' preview'
&lcCmd
&lcCmd = 'return'
ENDCASE
on error &lcErr_Call
set print &lcErr_Prt
set console &lcErr_Cons
set talk &lcErr_Talk
set datasession to lnErr_DS
&lcCmd
endif
* Turn off the path so we don't find an ERRORLOG.DBF somewhere else.
lcErr_Path = set('Path')
set path to
IF USED('Errorlog')
SELECT ErrorLog
ELSE
select 0
if not file('ERRORLOG.DBF')
create table ERRORLOG (DATE D, TIME C (8), ERRNUM N (4), ERRMESS C (79), LINE N (6), SOURCE C (80), OPERATOR C (20), ;
ERRSTAT M, MEMDUMP M, PROGRAM M)
ENDIF
use ERRORLOG
ENDIF
set path to (lcErr_Path)
activate screen
clear typeahead
if not llErr_Evnt
?? chr(7)
Wait 'SYSTEM PROBLEM ENCOUNTERED. CONTACT PROGRAMMER!...Press a key' window timeout 3
endif
select Errorlog
if reccount()+1 > 20
wait 'ERROR LOG IS GETTING VERY LARGE. CONTACT PROGRAMMER IMMEDIATELY!' window timeout 3
endif
append blank
if rlock()
save to memo MEMDUMP && save all memory variables
endif
if not llErr_Evnt
? 'SAVING STATUS AND MEMORY...'
endif
set alternate to ERRTEMP.TXT
set alternate on
if llErr_Evnt
set console off && don't want user to see status if logging an event
endif
for lnErr_N = 1 to 2551
if used(lnErr_N)
? 'AREA '+ltrim(str(lnErr_N))+': REC# '
select (lnErr_N)
?? str(recno(),6)+' EOF: '+iif(eof(),'.T.','.F.')+' BOF: '+iif(bof(),'.T.','.F.')
endif
endfor
select (lcErr_OFil) && so we can tell which file was selected when we display status
list status
? replicate('*',70)
? 'MEMORY DUMP:'
list memory
? replicate('*',70)
set alternate off
set alternate to
set console on
select ERRORLOG && record still locked
append memo ERRSTAT from ERRTEMP.TXT sdf
delete file ERRTEMP.TXT
if not llErr_Evnt
? 'LOGGING PROBLEM...'
endif
replace date with ldErr_Dt, ;
time with lcErr_Tm, ;
OPERATOR with lcUserID, ;
ERRNUM with lnErr_Num, ;
ERRMESS with lcErr_Mess, ;
LINE with lnLineNo, ;
SOURCE with message(1), ;
ERRSTAT with ERRSTAT+chr(13)+chr(10)+'Calling tree:'+chr(13)+chr(10)+sys(16,1)
lnErr_N = 2
do while len(sys(16,lnErr_N)) <> 0
* Add each program and procedure called to the ERRSTAT memo field with
* a carriage return and line feed in between.
replace ERRSTAT with ERRSTAT+chr(13)+chr(10)+sys(16,lnErr_N)
lnErr_N = lnErr_N+1
enddo
replace PROGRAM with sys(16,1)
lnErr_N = 2
do while len(sys(16,lnErr_N)) <> 0
* Add each program and procedure called to the PROGRAM memo field with
* a carriage return and line feed in between.
replace PROGRAM with PROGRAM+chr(13)+chr(10)+sys(16,lnErr_N)
lnErr_N = lnErr_N+1
enddo
use && close error log file
* if not an event, exit program
if not llErr_Evnt
quit
endif
* reselect original file and reset environment
select (lcErr_OFil)
on error &lcErr_Call
set print &lcErr_Prt
set console &lcErr_Cons
set talk &lcErr_Talk
set datasess to lnErr_DS
if not ISNULL(loErr_Wind)
&loErr_Wind..activate()
endif
return
*-------------------------------------------------------------------------
