1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
| 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
*------------------------------------------------------------------------- |
