· 8 years ago · Nov 18, 2017, 02:46 PM
1REBUILD.PRG
2
3#IF .f.
4**** REBUILD.PRG
5* ------------------------------------------------------------------------------
6* Filename: REBUILD.prg
7* Please see documentation below.
8*
9* Author : Froilan C. Yu Yap
10*
11* Note to maintenance programmer :
12* This program actually consists of several source files gathered
13* into one. A utility program, INTEG.prg automates the gathering
14* process.
15*
16* Created on March 22, 1993
17*
18* Copyright(C) 1993, Ng Khai Development Corp.
19*
20* Modification log:
21*
22*
23*
24* ------------------------------------------------------------------------------
25
26 ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
27 ³þ Rebuild ³
28 ³ ³
29 ³ Bad files : Report file : ³
30 ³ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ³
31 ³ ³CUSTOMER.DBF ³ ³ < Choose... > REBUILD.REP ³ ³
32 ³ ³ ³ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ³
33 ³ ³ ³ [X] Rebuild All ³
34 ³ ³ ³ [ ] Scan only ³
35 ³ ³ ³ [ ] Halt on error ³
36 ³ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ [ ] Overwrite damaged file ³
37 ³ ³
38 ³ ® Rebuild ¯ ³
39 ³ Ú Progress indicator ÄÄÄÄÄÄÄÄÄÄÄ¿ ³
40 ³ ³ ³ < Cancel > ³
41 ³ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ ³
42 ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
43
44 Rebuild attempts to reconstruct any damaged database files found in
45directory it is run.
46
47 Only DBF files defined in the STR file passed as parameter are checked
48for possible damage. DBF files found in the directory but not defined
49in the STR file are not examined.
50
51 During the course of scanning a damaged file, Rebuild regularly reports
52any record/field it considers to contain invalid data to a text file.
53This reporting cannot be disabled.
54
55Rebuild options :
56[X] Rebuild All
57 Checking this box processes all files determined to be damaged.
58 This is the default. If unchecked, only the file marked with '' will
59 be processed.
60[ ] Scan only
61 Disables rebuilding when checked, but still produces a report file.
62[ ] Halt on error
63 If checked, processing continues until a record containing bad data is
64 encountered. Otherwise, the whole file is processed.
65[ ] Overwrite damaged file
66 Damaged files are, by default, not overwritten but instead rebuilt to
67 a file with the same base name as the damaged file but with a '.REB'
68 extension. Checking this rebuilds and overwrites the damaged file.
69
70Rebuild supports the following data types :
71 Character, Numeric, Date, Logical, Memo
72
73How Rebuild determines invalid data :
74
75 1. For Character fields, any character with an ASCII value not within
76 32 and 126 makes the entire field invalid.
77 2. For Numeric fields, any character which is not in the character set
78 for numerics makes the entire field invalid. Specifically, TYPE()
79 must evaluate to 'N' for the field to be considered valid.
80 3. For Logical fields, any character other than 'T', 'F' or ' ' (space)
81 makes the entire field invalid.
82 4. For Memo and Date fields, any non-numeric character makes the entire
83 field invalid.
84
85It must be noted that for a field of ANY type, a value of spaces (ASCII 32)
86constitutes a (valid) null value corresponding to that of the field's type.
87#ENDIF
88* ÖÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ·
89* º º
90* º 03/22/94 REBUILD.SPR 16:02:27 º
91* º º
92* ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ
93* º º
94* º Froilan C. Yu Yap º
95* º º
96* º Copyright (c) 1994 Ng Khai Development Corporation º
97* º Hernan Cortes St., Banilad, Mandaue, Cebu º
98* º City, Zip º
99* º º
100* º Description: º
101* º This program was automatically generated by GENSCRN. º
102* º º
103* ÓÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĽ
104
105* For comments or feedbacks, pls. contact Wilson Ng, EVP
106* Ng Khai Development Corp. 73751.1012 @ Compuserve.com
107* FAX (63-32)86241
108
109PARAMETERS cstrfile
110
111* ÖÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ·
112* º º
113* º REBUILD/MS-DOS Setup Code - SECTION 1 º
114* º º
115* ÓÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĽ
116*
117
118#REGION 1
119
120 cStrFile = upper(alltrim(cStrFile))
121 if at('.', cStrFile) = 0
122 cStrFile = cStrFile + '.STR'
123 endif
124 cStrFile = padr(cStrFile, 12)
125
126 if !file(cStrFile)
127 do alert with 'STR file not found.', 7, padl('OK', 8)
128 return
129 endif
130
131
132#REGION 0
133REGIONAL m.currarea, m.talkstat, m.compstat
134
135IF SET("TALK") = "ON"
136 SET TALK OFF
137 m.talkstat = "ON"
138ELSE
139 m.talkstat = "OFF"
140ENDIF
141m.compstat = SET("COMPATIBLE")
142SET COMPATIBLE FOXPLUS
143
144m.currarea = SELECT()
145
146
147* ÖÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ·
148* º º
149* º MS-DOS Window definitions º
150* º º
151* ÓÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĽ
152*
153
154IF NOT WEXIST("rebuild") ;
155 OR UPPER(WTITLE("REBUILD")) == "REBUILD.PJX" ;
156 OR UPPER(WTITLE("REBUILD")) == "REBUILD.SCX" ;
157 OR UPPER(WTITLE("REBUILD")) == "REBUILD.MNX" ;
158 OR UPPER(WTITLE("REBUILD")) == "REBUILD.PRG" ;
159 OR UPPER(WTITLE("REBUILD")) == "REBUILD.FRX" ;
160 OR UPPER(WTITLE("REBUILD")) == "REBUILD.QPR"
161 DEFINE WINDOW rebuild ;
162 FROM INT((SROW()-16)/2),INT((SCOL()-55)/2) ;
163 TO INT((SROW()-16)/2)+15,INT((SCOL()-55)/2)+54 ;
164 TITLE "Rebuild" ;
165 FLOAT ;
166 CLOSE ;
167 SHADOW ;
168 MINIMIZE ;
169 SYSTEM ;
170 COLOR SCHEME 5
171ENDIF
172
173
174* ÖÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ·
175* º º
176* º REBUILD/MS-DOS Setup Code - SECTION 2 º
177* º º
178* ÓÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĽ
179*
180
181#REGION 1
182
183*:: Parameters to main Rebuild routine ----- :
184#Define REP_FILE aRParms[1]
185#Define REB_ALL aRParms[2]
186#Define SCAN_ONLY aRParms[3]
187#Define BRK_ONERR aRParms[4]
188#Define OVERWRITE aRParms[5]
189
190*:: Default extension of report file ----- :
191#Define REP_EXT ".REP"
192
193*:: Name of default report file ----- :
194#Define DFAULTREP "REBUILD"+REP_EXT
195private cSafety
196
197 dimension aBadFiles[1] && List of bad tables
198 dimension aRParms[5] && Parameters to rebuild routine.
199
200 REP_FILE = DFAULTREP && Default report file name.
201 REB_ALL = .t.
202
203 aBadFiles[1] = ' '
204
205 cSafety = set('SAFETY')
206 set safety off
207
208* ÖÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ·
209* º º
210* º REBUILD/MS-DOS Screen Layout º
211* º º
212* ÓÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĽ
213*
214
215#REGION 1
216IF WVISIBLE("rebuild")
217 ACTIVATE WINDOW rebuild SAME
218ELSE
219 ACTIVATE WINDOW rebuild NOSHOW
220ENDIF
221@ 2,21 TO 4,51
222@ 1,22 SAY "Report file :" ;
223 SIZE 1,13, 0
224@ 1,3 SAY "Bad files :" ;
225 SIZE 1,11, 0
226@ 11,1 TO 13,33
227@ 11,2 SAY " Progress indicator " ;
228 SIZE 1,20, 0
229@ 2,1 GET m.cBadFile ;
230 PICTURE "@&N" ;
231 FROM aBadFiles ;
232 SIZE 7,16 ;
233 DEFAULT 1 ;
234 COLOR SCHEME 2
235@ 3,23 GET m.cDir0 ;
236 PICTURE "@*HN \<Choose..." ;
237 SIZE 1,13,1 ;
238 DEFAULT 1 ;
239 VALID _qoj0ydrf4()
240@ 3,37 GET REP_FILE ;
241 SIZE 1,13 ;
242 DEFAULT " " ;
243 PICTURE "@K!" ;
244 VALID _qoj0ydrjy()
245@ 5,22 GET REB_ALL ;
246 PICTURE "@*C Rebuild \<All" ;
247 SIZE 1,15 ;
248 DEFAULT 1
249@ 6,22 GET SCAN_ONLY ;
250 PICTURE "@*C \<Scan only" ;
251 SIZE 1,13 ;
252 DEFAULT 0 ;
253 VALID _qoj0ydrp4()
254@ 7,22 GET BRK_ONERR ;
255 PICTURE "@*C \<Halt on error" ;
256 SIZE 1,17 ;
257 DEFAULT 0
258@ 8,22 GET OVERWRITE ;
259 PICTURE "@*C \<Overwrite damaged file" ;
260 SIZE 1,26 ;
261 DEFAULT 0
262@ 10,38 GET m.nExec ;
263 PICTURE "@*VN \!\<Rebuild;Cance\<l" ;
264 SIZE 1,11,1 ;
265 DEFAULT 1 ;
266 VALID _qoj0ydrx3()
267
268IF NOT WVISIBLE("rebuild")
269 ACTIVATE WINDOW rebuild
270ENDIF
271
272
273* ÖÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ·
274* º º
275* º MS-DOSREAD contains clauses from SCREEN rebuild º
276* º º
277* ÓÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĽ
278*
279
280READ CYCLE ;
281 WHEN _qoj0yds40() ;
282 ACTIVATE _qoj0yds44() ;
283 DEACTIVATE iif(wvisible('Rebuild'), .F., .T.) ;
284 MODAL
285
286RELEASE WINDOW rebuild
287SELECT (m.currarea)
288
289
290#REGION 0
291IF m.talkstat = "ON"
292 SET TALK ON
293ENDIF
294IF m.compstat = "ON"
295 SET COMPATIBLE ON
296ENDIF
297
298
299* ÖÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ·
300* º º
301* º REBUILD/MS-DOS Cleanup Code º
302* º º
303* ÓÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĽ
304*
305
306#REGION 1
307close all
308
309if cSafety = 'ON'
310 set safety on
311else
312 set safety off
313endif
314
315* ÖÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ·
316* º º
317* º _QOJ0YDRF4 m.cDir0 VALID º
318* º º
319* º Function Origin: º
320* º º
321* º From Platform: MS-DOS º
322* º From Screen: REBUILD, Record Number: 8 º
323* º Variable: m.cDir0 º
324* º Called By: VALID Clause º
325* º Snippet Number: 1 º
326* º º
327* ÓÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĽ
328*
329FUNCTION _qoj0ydrf4 && m.cDir0 VALID
330#REGION 1
331private cTemp
332cTemp = sys(2014, getfile('REP','Choose a file :','Open',0))
333if !empty(cTemp)
334 REP_FILE = cTemp
335endif
336show get REP_FILE
337
338
339* ÖÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ·
340* º º
341* º _QOJ0YDRJY REP_FILE VALID º
342* º º
343* º Function Origin: º
344* º º
345* º From Platform: MS-DOS º
346* º From Screen: REBUILD, Record Number: 9 º
347* º Variable: REP_FILE º
348* º Called By: VALID Clause º
349* º Snippet Number: 2 º
350* º º
351* ÓÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĽ
352*
353FUNCTION _qoj0ydrjy && REP_FILE VALID
354#REGION 1
355if empty(REP_FILE)
356 REP_FILE = DFAULTREP
357else
358 if at('.', REP_FILE) = 0
359 REP_FILE = alltrim(REP_FILE) + REP_EXT
360 endif
361endif
362show get REP_FILE
363
364
365* ÖÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ·
366* º º
367* º _QOJ0YDRP4 SCAN_ONLY VALID º
368* º º
369* º Function Origin: º
370* º º
371* º From Platform: MS-DOS º
372* º From Screen: REBUILD, Record Number: 11 º
373* º Variable: SCAN_ONLY º
374* º Called By: VALID Clause º
375* º Snippet Number: 3 º
376* º º
377* ÓÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĽ
378*
379FUNCTION _qoj0ydrp4 && SCAN_ONLY VALID
380#REGION 1
381private cPrompt
382
383if SCAN_ONLY
384 cPrompt = 'Scan \<All'
385
386 show get OVERWRITE disable
387 show get m.nExec, 1 prompt '\!Sca\<n'
388
389 if alen(aBadFiles) = 1
390 show get REB_ALL, 1 prompt cPrompt disable
391 else
392 show get REB_ALL, 1 prompt cPrompt enable
393 endif
394else
395 cPrompt = 'Rebuild \<All'
396
397 show get OVERWRITE enable
398 show get m.nExec, 1 prompt '\!\<Rebuild'
399
400 if alen(aBadFiles) = 1
401 show get REB_ALL, 1 prompt cPrompt disable
402 else
403 show get REB_ALL, 1 prompt cPrompt enable
404 endif
405endif
406return .T.
407
408* ÖÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ·
409* º º
410* º _QOJ0YDRX3 m.nExec VALID º
411* º º
412* º Function Origin: º
413* º º
414* º From Platform: MS-DOS º
415* º From Screen: REBUILD, Record Number: 14 º
416* º Variable: m.nExec º
417* º Called By: VALID Clause º
418* º Snippet Number: 4 º
419* º º
420* ÓÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĽ
421*
422FUNCTION _qoj0ydrx3 && m.nExec VALID
423#REGION 1
424if m.nExec = 1
425 if file(REP_FILE) and alert('Report file exists. Overwrite?', 7, '\!\<Yes;\?\<No') = 1
426 erase (REP_FILE)
427 endif
428 do CreaTemp with aBadFiles, aRParms, m.cBadFile
429 if REB_ALL
430 private nI
431
432 for nI = 1 to alen(aBadFiles)
433 do FixFile with aBadFiles[nI]
434 next
435 else
436 do FixFile with m.cBadFile
437 endif
438endif
439clear read
440return .T.
441
442* ÖÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ·
443* º º
444* º _QOJ0YDS40 Read Level When º
445* º º
446* º Function Origin: º
447* º º
448* º º
449* º From Platform: MS-DOS º
450* º From Screen: REBUILD º
451* º Called By: READ Statement º
452* º Snippet Number: 5 º
453* º º
454* ÓÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĽ
455*
456FUNCTION _qoj0yds40 && Read Level When
457*
458* When Code from screen: REBUILD
459*
460#REGION 1
461 dimension aStrTables[1]
462
463
464 if !GetFiles(cStrFile, @aStrTables)
465 do alert with 'No table names found in STR file.', 7, padl('OK', 8)
466 return .F.
467 endif
468
469
470 do GetBads with aBadFiles, aStrTables
471
472 release aStrTables && No longer needed.
473
474 if empty(aBadFiles[1])
475 do alert with 'No defective database files found.', 7, padl('OK', 8)
476 return .F.
477 endif
478
479
480 m.cBadFile = aBadFiles[1] && Bad file GET list var.
481 show get m.cBadFile
482
483 return .T.
484
485* ÖÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ·
486* º º
487* º _QOJ0YDS44 Read Level Activate º
488* º º
489* º Function Origin: º
490* º º
491* º º
492* º From Platform: MS-DOS º
493* º From Screen: REBUILD º
494* º Called By: READ Statement º
495* º Snippet Number: 6 º
496* º º
497* ÓÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĽ
498*
499FUNCTION _qoj0yds44 && Read Level Activate
500*
501* Activate Code from screen: REBUILD
502*
503#REGION 1
504
505if alen(aBadFiles) = 1
506 show get REB_ALL disable
507endif
508
509return 0
510#Define REP_FILE aRParms[1]
511#Define REB_ALL aRParms[2]
512#Define SCAN_ONLY aRParms[3]
513#Define BRK_ONERR aRParms[4]
514#Define OVERWRITE aRParms[5]
515
516#Define REB_EXT ".REB"
517
518* ------------------------------------------------------------------------------
519procedure FixFile && Main rebuild routine.
520* ------------------------------------------------------------------------------
521parameters cBadFile
522
523private i, j
524private nBadFile && File handles
525private cHeader, cRecord, cRawField && Buffers
526private nHdrRecCnt, nHeadSize, nRecLen && Derived constants
527private nFldCnt, aFld, nFPos, nRecno, bRecNoPrinted
528private cRepFile, cGoodFile, cTextMDeli, nErrorType, cField, nRecCnt
529private bBadField, bBadRecord, bDeleted
530external array aRParms
531
532 do ThermMsg with iif(SCAN_ONLY, 'Scanning ', 'Rebuilding ')+alltrim(m.cBadFile)+'.dbf'+' ' && Thermometer message.
533
534 *:: Open temporary copy of damaged dbf ----- :
535
536 cGoodFile = alltrim(m.cBadFile) + REB_EXT
537* cGoodFile = left(cBadFile, at('.', cBadFile) - 1) + '.REB'
538 use (cGoodFile) exclusive alias GOOD
539 nFldCnt = afields(aFld)
540
541 *:: Setup report file ----- :
542
543 cTextMDeli = set('textmerge', 2)
544 set textmerge delimiters to ''
545 set textmerge to (REP_FILE) additive
546 set textmerge on noshow
547
548 *:: Open damaged dbf ----- :
549
550 nBadFile = fopen(alltrim(m.cBadFile)+'.dbf', 2)
551 if nBadFile = -1
552 wait window 'Error in opening.' nowait
553 return
554 endif
555
556 *:: Read the dbf header ----- :
557
558 cHeader = fread(nBadFile, 32)
559
560 *:: Get dbf info stored in header ----- :
561
562 nFSize = FileSize(alltrim(m.cBadFile)+'.dbf') && File size.
563 nHdrRecCnt = RecordCount(cHeader) && Record count.
564 nHeadSize = HeadSize(cHeader) && Offset to data section. (Hdr size)
565 nRecLen = RecLen(cHeader) && Record len (+delete flag).
566 nRecCnt = (nFSize - header('GOOD') - 1) / recsize('GOOD') && Computed reccount.
567
568 *:: Report header's condition ----- :
569
570 do diagnose with cHeader, alltrim(m.cBadFile)+'.dbf', REP_FILE
571
572 nRecno = 0
573 =fseek(nBadFile, header('GOOD')) && Go to first data byte.
574
575 *:: If no records, merely upate thermo ----- :
576
577 if nRecCnt < 1
578 do UpdTherm with 1, 1
579 endif
580
581 *:: Scan the file and validate field data ----- :
582
583 bBadRecord = .F.
584 do while !feof(nBadFile) and iif(BRK_ONERR, !bBadRecord, .T.)
585 nRecno = nRecno + 1
586 cRecord = fread(nBadFile, recsize('GOOD'))
587 bDeleted = iif(left(cRecord,1) = '*', .T., .F.)
588 cRecord = substr(cRecord, 2)
589 if len(cRecord)+1 != recsize('GOOD')
590 exit
591 else
592 do UpdTherm with nRecno, nRecCnt
593 endif
594 nFPos = 1
595 bRecNoPrinted = .F.
596 bBadRecord = .F.
597
598 for i = 1 to nFldCnt
599 cRawField = substr(cRecord, nFPos, aFld[i,3])
600 cField = cRawField
601 bBadField = .F.
602 do case
603 case aFld[i,2] = 'C'
604 cField = alltrim(cField)
605 for j = 1 to len(cField)
606 if asc(substr(cField,j,1)) < 32 or asc(substr(cField,j,1)) >= 126
607 bBadField = .T.
608 nErrorType = 2
609 exit
610 endif
611 next
612 store iif(bBadField, space(len(cRawField)), cRawField) to ('m.'+aFld[i,1])
613 case aFld[i,2] = 'N'
614 if !empty(cField) and type(cField) != 'N'
615 bBadField = .T.
616 nErrorType = 1
617 endif
618 store iif(bBadField, 0, val(cRawField)) to ('m.'+aFld[i,1])
619 case inlist(aFld[i,2], 'D', 'M')
620 if !empty(cField) and type(cField) != 'N'
621 bBadField = .T.
622 nErrorType = 1
623 endif
624 if aFld[i,2] = 'D'
625 store iif(bBadField, {}, StrToD(cRawField)) to ('m.'+aFld[i,1])
626 endif
627 case aFld[i,2] = 'L'
628 if !inlist(cField, 'T', 'F', ' ')
629 nErrorType = 1
630 bBadField = .T.
631 endif
632 store iif(bBadField, .F., iif(cRawField='T', .T., .F.)) to ('m.'+aFld[i,1])
633 endcase
634 if bBadField
635 bBadRecord = .T.
636 if !bRecNoPrinted
637 \* ---- Record no. nRecno
638 bRecNoPrinted = .T.
639 endif
640 do case
641 case nErrorType = 1
642 \Invalid data in field aFld[i,1] : cRawField
643 case nErrorType = 2
644 \Suspicious character(s) in field aFld[i,1] : cRawField
645 endcase
646 endif
647
648 nFPos = nFPos + aFld[i,3]
649 next
650
651 * Stop if made to stop on error ----- :
652
653 if BRK_ONERR and bBadRecord
654 wait window 'Bad record encountered.' nowait
655 \
656 \TEST TERMINATED DUE TO ERRONEOUS DATA IN RECORD.
657 loop
658 endif
659
660 * Transfer to temp dbf ----- :
661
662 if !SCAN_ONLY
663 insert into (cGoodFile) from memvar
664 if bDeleted or bBadRecord
665 delete
666 endif
667 endif
668
669 enddo
670
671 set textmerge delimiters to cTextMDeli
672 set textmerge to
673 set textmerge off
674
675 close all
676
677 if SCAN_ONLY
678 erase (cGoodFile)
679 else
680 if OVERWRITE
681 erase (alltrim(m.cBadFile)+'.dbf')
682 rename (cGoodFile) to (alltrim(m.cBadFile)+'.dbf')
683 endif
684 endif
685
686****** FixFile ENDP
687
688* ------------------------------------------------------------------------------
689function RecordCount && Get record count according to dbf header.
690* ------------------------------------------------------------------------------
691parameters cHeader
692private nHdrRecCnt, i
693
694 nHdrRecCnt = 0
695 for i = 0 to 3
696 nHdrRecCnt = nHdrRecCnt + asc(substr(cHeader,5+i,1))*(256^i)
697 next
698 return round(nHdrRecCnt, 0)
699***** RecordCount ENDP
700
701* ------------------------------------------------------------------------------
702function HeadSize && Get offset to first byte of data.
703* ------------------------------------------------------------------------------
704parameters cHeader
705private nHeadSize, i
706
707 nHeadSize = asc(substr(cHeader,9,1))
708 nHeadSize = nHeadSize + asc(substr(cHeader,10,1)) * 256
709 return nHeadSize
710***** HeadSize ENDP
711
712* ------------------------------------------------------------------------------
713function RecLen && Get record length (including delete flag)
714* ------------------------------------------------------------------------------
715parameters cHeader
716private nRecLen, i
717
718 nRecLen = asc(substr(cHeader,11,1))
719 nRecLen = nRecLen + asc(substr(cHeader,12,1)) * 256
720 return nRecLen
721***** RecLen ENDP
722
723* ------------------------------------------------------------------------------
724function FileSize
725* Returns a file's size. Parameter must be the name of an existing file.
726* Wildcards are not allowed.
727* ------------------------------------------------------------------------------
728parameters cFileName
729private aDirInfo
730
731 if adir(aDirInfo, cFileName) = 1
732 return aDirInfo[1, 2]
733 else
734 return 0
735 endif
736
737***** FileSize ENDP
738
739* ------------------------------------------------------------------------------
740procedure Diagnose
741* ------------------------------------------------------------------------------
742parameters cHeader, cBadFile, cRepFile
743private x, cMode
744
745 dimension x(4)
746
747 *:: Build array for textmerge expression ----- :
748
749 x(1) = iif(header('GOOD') = nHeadSize, 'O.K.', 'Failed' )
750 x(2) = iif(recsize('GOOD') = nRecLen, 'O.K.', 'Failed' )
751 x(3) = round(nRecCnt, 0)
752 x(4) = iif(x(3) = nHdrRecCnt, 'O.K.', 'Failed' )
753 cMode = iif(SCAN_ONLY, 'Scan Only; ', 'Scan & Rebuild; ') + ;
754 iif(BRK_ONERR, 'Process Until Error', 'Process Whole File') + ;
755 iif(SCAN_ONLY, '', iif(OVERWRITE, '; Overwrite Bad File', '; Do Not Overwrite Bad File'))
756 cDestFileMsg = iif(!SCAN_ONLY and !OVERWRITE, ;
757 'Damaged file rebuilt to ' + cGoodFile, '')
758TEXT
759--------------------------------------------------------------------------------
760File : cBadFile
761
762Time of test : time(), date()
763Test mode : cMode
764
765Header size test - x(1)
766Record size test - x(2)
767Record count test - nHdrRecCnt record(s), computed at x(3) record(s) : x(4)
768
769cDestFileMsg
770
771ENDTEXT
772
773***** Diagnose ENDP
774
775* ------------------------------------------------------------------------------
776function StrToD && Converts a YYYYMMDD date string to date.
777* ------------------------------------------------------------------------------
778parameters cDtStr
779private dDate
780
781 dDate = ctod(substr(cDtStr, 5, 2)+'/'+right(cDtStr, 2)+'/'+substr(cDtStr, 3, 2))
782 return iif(empty(dtoc(dDate)), {}, dDate)
783
784***** StrToD ENDP
785
786* ------------------------------------------------------------------------------
787procedure GetBads && Get unreadable dbf files from current directory.
788* Filenames are stored in a one-dimensional array passed as parameter.
789* The array passed must be uninitialized. A value of .F. for the first
790* element of the array after this procedure is called indicates 0
791* bad files found.
792* ------------------------------------------------------------------------------
793parameters aBadTables, aStrTables
794private i, aDbf, nFiles, bUseError, nBadFileCnt
795private cOnError
796
797 cOnError = on('ERROR')
798 on error do TestIfBad with 'bUseError' && Detects 'Not a Database File.'
799
800 nFiles = alen(aStrTables) && No. of files to check.
801
802 nBadFileCnt = 0 && No. of bad files.
803 do ThermMsg with 'Checking files '
804 select 0
805 for i = 1 to nFiles
806 do UpdTherm with i, nFiles
807 bUseError = .F.
808 use (aStrTables[i])
809 if bUseError
810 nBadFileCnt = nBadFileCnt + 1
811 dimension aBadTables[nBadFileCnt]
812 aBadTables[nBadFileCnt] = aStrTables[i]
813 endif
814 next
815
816 on error &cOnError
817
818****** GetBads ENDP
819
820* ------------------------------------------------------------------------------
821function TestIfBad
822* Sets a flag if most recent USE resulted in a 'Not a database file' error.
823* ------------------------------------------------------------------------------
824parameters cFlagName && Name of flag as a character expression.
825
826#Define NADF_CODE 15 && Error code for 'Not a database file'.
827
828 store iif(error()=NADF_CODE, .T., .F.) to (cFlagName)
829***** TestIfBad ENDP
830
831#Define REP_FILE aRParms[1]
832#Define REB_ALL aRParms[2]
833#Define SCAN_ONLY aRParms[3]
834#Define BRK_ONERR aRParms[4]
835#Define OVERWRITE aRParms[5]
836
837#Define REB_EXT ".REB"
838
839* ------------------------------------------------------------------------------
840function CreaTemp && Creates temporary dbf's for each damaged file.
841* ------------------------------------------------------------------------------
842parameters aBadFiles, aRParms, m.cBadFile
843external array aBadFiles, aRParms
844private aTemp, nStrFound, i, cDbfFile
845
846* nStrFound = adir(aTemp, '*.str')
847
848* if nStrFound = 0
849* return 0
850* endif
851
852* create cursor STR (Line C(80))
853* append from (aTemp[1, 1]) sdf
854
855 do ThermMsg with 'Creating temps '
856 if REB_ALL
857 for i = 1 to alen(aBadFiles)
858 do UpdTherm with i, alen(aBadFiles)
859 do CreaOne with aBadFiles[i], alltrim(aBadFiles[i]) + REB_EXT
860* cDbfFile = upper(left(aBadFiles[i], at('.', aBadFiles[i]) - 1))
861* do CreaOne with cDbfFile, cDbfFile + '.REB'
862 next
863 else
864 do UpdTherm with 1, 1
865 do CreaOne with m.cBadFile, alltrim(m.cBadFile) + REB_EXT
866* cDbfFile = upper(left(cBadFile, at('.', cBadFile) - 1))
867* do CreaOne with cDbfFile, cDbfFile + '.REB'
868 endif
869
870 close databases
871
872* return 1
873***** CreaTemp ENDP
874
875* ------------------------------------------------------------------------------
876procedure CreaOne
877* ------------------------------------------------------------------------------
878parameters cDbfFile, cTempDbf
879private all
880
881 cDbfFile = alltrim(cDbfFile)
882 cTempDbf = alltrim(cTempDbf)
883 dimension structure(255, 4) && Max of 255 fields.
884 dimension indextags(20, 2) && Max of 20 tags.
885 m.fld_ctr = 1 && Indexer for 'structure'
886 m.ndx_ctr = 1 && Indexer for 'indextags'
887
888 select STR
889 scan for at('FILE@', Line) != 0 ;
890 and substr(Line, 10, 8) = padr(cDbfFile,8)
891
892 m.fname_pos = at('FILE@', line) && DBF file name.
893 if m.fname_pos != 0
894 m.fld_ctr = 1
895 m.ndx_ctr = 1
896
897 m.dbf_file = alltrim(substr(line, 10, 8))
898
899 do while .T.
900 m.tag_pos = at('INDEX@', line) && Index tag.
901 m.fld_pos = at('~', line) && Field definition.
902
903 if m.tag_pos != 0
904 indextags(m.ndx_ctr, 1) = upper(alltrim(substr(line, 10, 10)))
905 indextags(m.ndx_ctr, 2) = upper(alltrim(substr(line, 21, 43)))
906 m.ndx_ctr = m.ndx_ctr + 1
907 endif
908 if m.fld_pos != 0
909 structure(m.fld_ctr, 1) = upper(left(alltrim(substr(line, 3, 11)),10))
910 structure(m.fld_ctr, 2) = upper(alltrim(substr(line, 15, 5)))
911 structure(m.fld_ctr, 3) = val(substr(line, 21, 5))
912 structure(m.fld_ctr, 4) = val(substr(line, 27, 5))
913 m.fld_ctr = m.fld_ctr + 1
914 endif
915
916 if !eof()
917 skip
918 endif
919 if at('FILE@', line) != 0 or eof()
920 m.fields = m.fld_ctr - 1
921 m.indexes = m.ndx_ctr - 1
922
923 dimension structure(m.fields, 4)
924 create table (cTempDbf) from array structure
925 erase (upper(left(cTempDbf, at('.', cTempDbf) - 1)) + '.CDX')
926 for m.ndx_ctr = 1 to m.indexes
927 m.index_tag = indextags(m.ndx_ctr, 1)
928 m.index_expr = indextags(m.ndx_ctr, 2)
929 index on &index_expr tag (m.index_tag) additive
930 next
931 use in (cTempDbf)
932 select STR
933
934 dimension structure(255, 4)
935 skip -1
936 exit
937 endif
938 enddo
939 endif
940 endscan
941
942***** CreaOne ENDP
943
944* ------------------------------------------------------------------------------
945function GetFiles
946* Creates the STR temp table, scans for table names and places them into an
947* array. Returns .T. if table name(s) are found, .F. otherwise.
948* ------------------------------------------------------------------------------
949parameters cStrFile, aFiles
950private nFiles
951
952 do ThermMsg with 'Setting up ... '
953
954 create cursor STR (Line C(80))
955 append from (cStrFile) sdf
956
957 count for at('FILE@', Line) != 0 to nFilesInStr && For thermo
958 nFiles = 0 && No. of files found.
959 do ThermMsg with 'Reading STR file ... '
960 scan for at('FILE@', Line) != 0
961 nFiles = nFiles + 1
962 dimension aFiles[nFiles]
963 aFiles[nFiles] = substr(Line, 10, 8)
964 do UpdTherm with nFiles, nFilesInStr && Update progress meter.
965 endscan
966 if nFiles > 0
967 return .T.
968 else
969 return .F.
970 endif
971
972***** GetFiles ENDP
973
974* ------------------------------------------------------------------------------
975procedure ThermMsg && Show message above thermometer.
976* ------------------------------------------------------------------------------
977parameters cMsg
978
979 @wrows()-4, 2 say cMsg
980***** ThermMsg ENDP
981#Define THERMWIDTH 30
982#Define THERMCOL 2
983#Define THERMROW (wrows()-2)
984
985* THERWIDTH * 2 :
986#Define THERMSEGMENTS 60
987
988* THERMCOL + THERMWIDTH :
989#Define THERMLASTCOL 32
990
991* ------------------------------------------------------------------------------
992procedure UpdTherm && Task progress thermometer.
993* ------------------------------------------------------------------------------
994parameters nPart, nWhole
995
996 if type('_nPerRow') = 'U'
997 public _nPerRow, _nPerCol
998
999 _nPerRow = row()
1000 _nPerCol = col()
1001 endif
1002 if nWhole < THERMSEGMENTS
1003 private nBlocks
1004
1005 @_nPerRow,_nPerCol say transform(nPart / nWhole * 100, '999%')
1006 nBlocks = nPart / nWhole * THERMWIDTH
1007 @THERMROW,THERMCOL say replicate('Û', int(nBlocks))
1008 if col() < THERMLASTCOL
1009 @ $, $ say iif(nBlocks - int(nBlocks) < 0.5, 'Ã', 'Û')
1010 endif
1011 else
1012 private nFrac
1013
1014 if type('_nThermCtr') = 'U'
1015 public _nThermCtr
1016 _nThermCtr = 0
1017 endif
1018 nFrac = nWhole / THERMSEGMENTS
1019 if nPart >= _nThermCtr * nFrac
1020 private nBlocks
1021
1022 @_nPerRow,_nPerCol say transform(nPart / nWhole * 100, '999%')
1023 nBlocks = _nThermCtr / 2
1024 @THERMROW,THERMCOL say replicate('Û', int(nBlocks))
1025 if nBlocks - int(nBlocks) != 0
1026 @$,$ say 'Ã'
1027 endif
1028 _nThermCtr = _nThermCtr + 1
1029 endif
1030 endif
1031 if nPart >= nWhole
1032 =inkey(0.5, 'H')
1033 @THERMROW,THERMCOL clear to THERMROW,THERMCOL+THERMWIDTH
1034 @_nPerRow,2 clear to _nPerRow, _nPerCol + 3
1035 if type('_nThermCtr') != 'U'
1036 release _nThermCtr
1037 endif
1038 release _nPerRow, _nPerCol
1039 endif
1040
1041***** UpdTherm ENDP
1042*:*********************************************************************
1043*:
1044*: Procedure file: C:\FOXPRO2\SNIPFMT\ALERT.PRG
1045*:
1046*: System: SnipFmt
1047*: Author: Walter J. Kennamer
1048*: Copyright (c) 1991, Fox Holdings, Inc.
1049*: Last modified: 05/05/91 15:49
1050*:
1051*: Set by: SNIP.PRG
1052*: : FMT (procedure in SNIP.PRG)
1053*:
1054*: Documented 05/16/91 at 16:07 FoxDoc version 2.07á
1055*:*********************************************************************
1056*!*****************************************************************
1057*!
1058*! Procedure: ALERT
1059*!
1060*!*****************************************************************
1061procedure Alert
1062PARAMETERS strg, cscheme, buttons
1063
1064PRIVATE ALL
1065
1066SET TALK OFF
1067
1068in_cons = SET('CONSOLE')
1069
1070numparams = 4
1071DIMENSION dflts[numparams,2]
1072dflts[1,1] = "STRG"
1073dflts[2,1] = "CSCHEME"
1074dflts[3,1] = "BUTTONS"
1075dflts[4,1] = "ACTION"
1076dflts[1,2] = ''
1077dflts[2,2] = 7
1078dflts[3,2] =''
1079dflts[4,2] = 0
1080
1081action = 0
1082
1083FOR i = 1 TO numparams
1084 IF PARAMETERS() < i
1085 vname = dflts[i,1]
1086 &vname = dflts[i,2]
1087 ENDIF
1088ENDFOR
1089
1090m.numlines = OCCURS(';',strg) + 1 && number of message lines
1091IF !EMPTY(buttons)
1092 m.numbuts = OCCURS(';',buttons) + 1 && number of buttons
1093ELSE
1094 m.numbuts = 0
1095ENDIF
1096
1097DIMENSION alert_arry[numlines]
1098
1099IF numbuts > 0
1100 DIMENSION but_arry[numbuts]
1101ELSE
1102 DIMENSION but_arry[1]
1103ENDIF
1104
1105m.remain = m.strg
1106m.maxlen = 0
1107FOR i = 1 TO m.numlines
1108 IF AT(';',m.remain) > 0
1109 alert_arry[i] = SUBSTR(m.remain,1,AT(';',m.remain)-1)
1110 alert_arry[i] = CHRTRAN(alert_arry[i],';','')
1111 m.remain = SUBSTR(m.remain,AT(';',m.remain)+1)
1112 ELSE
1113 alert_arry[i] = m.remain
1114 m.remain = ''
1115 ENDIF
1116 IF LEN(alert_arry[i]) > SCOLS() - 6
1117 alert_arry[i] = SUBSTR(alert_arry[i],1,SCOLS()-6)
1118 ENDIF
1119 IF LEN(alert_arry[i]) > m.maxlen
1120 m.maxlen = LEN(alert_arry[i])
1121 ENDIF
1122ENDFOR
1123
1124m.remain = m.buttons
1125m.maxbut = 0
1126FOR i = 1 TO m.numbuts
1127 IF AT(';',m.remain) > 0
1128 but_arry[i] = SUBSTR(m.remain,1,AT(';',m.remain)-1)
1129 but_arry[i] = CHRTRAN(but_arry[i],';','')
1130 m.remain = SUBSTR(m.remain,AT(';',m.remain)+1)
1131 ELSE
1132 but_arry[i] = m.remain
1133 m.remain = ''
1134 ENDIF
1135 IF LEN(but_arry[i]) > m.maxbut
1136 m.maxbut = LEN(but_arry[i])
1137 ENDIF
1138ENDFOR
1139
1140IF !EMPTY(buttons)
1141 m.numlines = m.numlines + 2
1142ENDIF
1143
1144m.butsize = m.numbuts * (m.maxbut + 3) && chevrons + space
1145IF m.butsize > m.maxlen
1146 m.maxlen = m.butsize
1147ENDIF
1148
1149m.top_row = INT( (SROWS() - 4 - m.numlines) / 2)
1150m.bot_row = m.top_row + 3 + m.numlines
1151
1152m.top_col = INT((SCOLS() - m.maxlen - 6) / 2)
1153m.bot_col = m.top_col + m.maxlen + 6
1154
1155DEFINE WINDOW alert FROM m.top_row,m.top_col TO m.bot_row,m.bot_col;
1156 SYSTEM FLOAT SHADOW COLOR SCHEME (cscheme)
1157ACTIVATE WINDOW alert
1158
1159IF !EMPTY(buttons)
1160 FOR i = 1 TO m.numlines - 2
1161 @ i,3 SAY PADC(alert_arry[i],m.maxlen)
1162 ENDFOR
1163 m.butpos = 3 + (m.maxlen - m.butsize)/2
1164 @ m.numlines,m.butpos GET action FUNCTION '*HT' PICTURE buttons SIZE 1,m.maxbut+2,1
1165 READ CYCLE MODAL
1166ELSE
1167 FOR i = 1 TO m.numlines
1168 @ i,3 SAY PADC(alert_arry[i],m.maxlen)
1169 ENDFOR
1170
1171 SET CONSOLE OFF
1172 =INKEY(0,'HM')
1173 SET CONSOLE ON
1174ENDIF
1175RELEASE WINDOW alert
1176
1177IF in_cons = "OFF"
1178 SET CONSOLE OFF
1179ENDIF
1180RETURN action
1181*: EOF: ALERT.PRG
1182