Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
*********
PROCEDURE chktable
PARAMETERS p_file, p_skip_eof, p_details
* (CHARS) (LOGICAL) (LOGICAL)
PRIVATE c_Talk, c_Exact, chkMsg, chkMsg1, chkMsg2, chkMsg3, chkMsg_ok
IF SET("TALK")="ON"
SET TALK OFF
c_Talk="ON"
ELSE
c_Talk="OFF"
ENDIF
IF SET("EXACT")="OFF"
SET EXACT ON
c_Exact="OFF"
ELSE
c_Exact="ON"
ENDIF
STORE "" TO chkMsg, chkMsg1, chkMsg2, chkMsg3
chkMsg_ok=chk_table(p_file, p_skip_eof, p_details)
IF LEN(chkMsg1)+LEN(chkMsg2)+LEN(chkMsg3)>0
? chkMsg && FILENAME
ELSE
IF c_Talk="ON" && IF TALK WAS ON BUT NO MSG THEN SAY IF OK OR FAILED
? "Check "+IIF(chkMsg_ok=.T.,"was OK","FAILED")
ENDIF
ENDIF
IF LEN(chkMsg1)>0
? chkMsg1 && PROBABLE BAD DATA IN TABLE
ENDIF
IF LEN(chkMsg2)>0
? chkMsg2 && RECORD COUNT MISMATCH
ENDIF
IF LEN(chkMsg3)>0
? chkMsg3 && FILE SIZE MISMATCH
ENDIF
IF c_Exact="OFF"
SET EXACT OFF
ENDIF
IF c_Talk="ON"
SET TALK ON
ENDIF
RETURN
********
FUNCTION chk_table
PARAMETERS p_name, p_skip_eof, p_details
* (CHARS) (LOGICAL) (LOGICAL)
* THIS PROGRAM SCANS A TABLE AT LOW LEVEL TO EXAMINE ACTUAL CONTENTS
* SINCE WE MAY NOT DETECT INVALID CHARACTERS WHEN OPENED AS TABLE
* EXAMPLE: WE CAN BROWSE AND VIEW SOME INVALID CHARS IN NUMERIC FIELDS
* BUT CANNOT DETECT THEM PROGRAMMATICALLY SINCE DBASE EVALUATES
* THE FIELD CONTENTS (STRING DATA) INTO NUMERIC VALUES
* NOTE: chkMsg IS _NOT_ PRIVATE
PRIVATE c_table, ne, np, in_path, in_name, in_ext
c_table=UPPER(p_name)
PRIVATE n_sele
n_sele = SELECT(ALIAS()) && SAVE CURRENT WORKAREA LOCATION FOR RETURN
* NO WAY TO DETERMINE CURRENT WORK AREA # IF NO TABLE IN USE
IF n_sele > 0 .AND. .NOT. ALIAS() $ c_table && ANOTHER TABLE IS OPEN IN CURRENT WORK AREA
SELECT SELECT() && GO TO EMPTY WORK AREA
ENDIF
IF LEN(RTRIM(c_table))=0 && EMPTY STRING WOULD CAUSE AN ERROR
chkMsg="PARAMETER FOR TABLE NAME IS EMPTY"
RETURN .F.
ENDIF
ne=AT(".",c_table)
in_ext =IIF(ne>0,SUBSTR(c_table,ne),".DBF")
np=RAT("\",c_table)
in_path=IIF(np>0,SUBSTR(c_table,1,np),"")
in_name=SUBSTR(c_table,np+1,IIF(ne=0,LEN(c_table)+1,ne)-(np+1))
PRIVATE x, y, z, c_print
PRIVATE FX, num_files, x_name, x_size, x_rec_cnt, x_rec_size, x_rec_eof
PRIVATE f_handle, f_size, f_hlen, f_rcnt, f_rlen, f_base, f_data, calc_rec
* DECLARE dir_dbf[1,5] && ADIR() CREATES ARRAY
num_files=ADIR(dir_dbf,in_path+in_name+in_ext)
IF num_files=0
chkMsg="FILE NOT FOUND"
RETURN .F.
ENDIF
x=ASORT(dir_dbf)
FOR FX=1 TO num_files
STORE "" TO chkMsg, chkMsg1, chkMsg2, chkMsg3
x_name =dir_dbf[FX,1] && FORMAT IS FILENAME.EXT (NO PATH!)
x_size=dir_dbf[FX,2] && FILE SIZE
USE (in_path+x_name) NOUP && NOTE: WILL ERROR IF IN USE OR NOT A TABLE
IF LEN(ALIAS())>0
* REFER TO x AS M->x IN CASE TABLE HAS A FIELD NAMED "X"
x_rec_cnt=RECCOUNT()
x_rec_size=RECSIZE()
IF RECCOUNT()>0
M->x=IIF(RECCOUNT()<2001,1,x_rec_cnt-2000)
GO M->x && MOVE TO NEAR EOF TO REDUCE TIME SCANNING HUGE TABLES
ENDIF
M->x=x_rec_cnt+1000 && ALWAYS LOOK FOR MORE RECORDS THAN YOU EXPECT
c_print=SET("PRINT")
SET PRINT OFF
SET CONSOLE OFF
LIST NEXT M->x FIELD EVAL(FIELD(1)) && LIST ONE FIELD TO FIND TRUE EOF
SET CONSOLE ON
SET PRINT &c_print
x_rec_eof=RECNO()-1
USE
chkMsg=in_path+x_name
ELSE
chkMsg=in_path+x_name+" COULD NOT BE OPENED (IN USE OR BAD TABLE)"
IF num_files>1
? chkMsg
ELSE
RETURN .F.
ENDIF
LOOP && GET NEXT TABLE
ENDIF
f_handle=FOPEN(in_path+x_name)
IF f_handle=0
chkMsg=in_path+x_name+" COULD NOT BE OPENED AT LOW LEVEL"
IF num_files>1
? chkMsg
ELSE
RETURN .F.
ENDIF
LOOP && GET NEXT TABLE
ENDIF
* CHARS 5+(6*256)+(7*256^2) ARE NUMBER OF RECORDS
* CHARS (8*256)+9 ARE LENGTH OF HEADER
* CHARS (10*256)+11 ARE LENGTH OF EACH RECORD (INCLUDES DELETED FLAG)
* LAST CHAR IN HEADER IS CHR(13)
* LAST CHAR IN FILE (EOF) IS CHR(26)
f_data=FREAD(f_handle,12)
f_rcnt=ASC(SUBSTR(f_data,5,1)) ;
+ASC(SUBSTR(f_data,6,1))*256 ;
+ASC(SUBSTR(f_data,7,1))*256^2 && GET RECORD COUNT (UP TO 16M)
f_hlen=ASC(SUBSTR(f_data,9,1)) ;
+ASC(SUBSTR(f_data,10,1))*256 && GET HEADER LENGTH
f_rlen=ASC(SUBSTR(f_data,11,1)) ;
+ASC(SUBSTR(f_data,12,1))*256 && GET RECORD LENGTH (ONE)
f_size=f_hlen+(f_rcnt*f_rlen)+1
IF f_rcnt<>x_rec_cnt .OR. x_rec_eof<>x_rec_cnt
chkMsg2="RECORD COUNT MISMATCH: LIST="+LTRIM(STR(x_rec_eof)) ;
+" RECORD COUNT="+LTRIM(STR(x_rec_cnt)) ;
+" HEADER CALC="+LTRIM(STR(f_rcnt))
ENDIF
IF f_size<>x_size
* MOST MISMATCHES ARE THAT EOF MARKER IS MISSING FROM DOS SIZE
IF f_size<>x_size+1 .OR. .NOT. p_skip_eof
chkMsg3="FILE SIZE MISMATCH BY "+LTRIM(STR(x_size-f_size)) ;
+": ACTUAL="+LTRIM(STR(x_size)) ;
+" CALC="+LTRIM(STR(f_size))
ENDIF
ENDIF
IF p_details
? "TABLE DETAILS: "+in_path+x_name
? "TABLE SIZE (BYTES): "+LTRIM(STR(x_size))
? "TABLE RECORD FOUND: "+LTRIM(STR(x_rec_eof))
? "TABLE RECORD COUNT: "+LTRIM(STR(x_rec_cnt))
? "(HDR) RECORD COUNT: "+LTRIM(STR(f_rcnt))
? "TABLE RECORD SIZE: "+LTRIM(STR(x_rec_size))
? "(HDR) RECORD SIZE: "+LTRIM(STR(f_rlen))
? "HEADER LENGTH: "+LTRIM(STR(f_hlen))
?
ENDIF
x=FSEEK(f_handle,f_hlen) && MOVE POINTER TO FIRST RECORD
DO WHILE .NOT. FEOF(f_handle)
f_base=FSEEK(f_handle,0,1) && GET CURRENT LOCATION
f_data=FREAD(f_handle,240)
FOR y=1 TO LEN(f_data)
IF "(MORE BAD!)" $ chkMsg1
EXIT && SKIP SEARCHING SINCE STRING IS FULL
ENDIF
z=ASC(SUBSTR(f_data,y,1))
IF ( z<32 .OR. z>126 ) .AND. ;
.NOT. ( FEOF(f_handle) .AND. y=LEN(f_data) )
* PROBABLY BAD DATA
* ? f_base, y, f_hlen, f_rlen, z
calc_rec=LTRIM(STR(INT(((f_base+y-1)-f_hlen)/f_rlen)+1))
IF LEN(chkMsg1)=0 .OR. ;
LEN(chkMsg1)>0 .AND. " "+calc_rec<>RIGHT(chkMsg1,LEN(calc_rec)+1)
IF LEN(chkMsg1)>230
chkMsg1=chkMsg1+" ... (MORE BAD!)" && NO ROOM FOR MORE
ELSE
chkMsg1=chkMsg1+IIF(LEN(chkMsg1)=0,"BAD REC # ",", ")+calc_rec
ENDIF
ENDIF
ENDIF
NEXT
IF FEOF(f_handle)
IF RIGHT(f_data,1)<>CHR(26)
* MOST LENGTH MISMATCHES ARE THAT EOF MARKER IS MISSING
IF f_size=x_size .OR. .NOT. p_skip_eof
chkMsg3=IIF(LEN(chkMsg3)=0,"",chkMsg3+"; ")+"CHR(26) NOT AT EOF"
IF num_files>1
* ? "LENGTH OF LAST PACKET: "+LTRIM(STR(LEN(f_data)))
? "LAST CHAR (ASC) IN FILE: "+LTRIM(STR(ASC(RIGHT(f_data,1))))
ENDIF
ENDIF
ENDIF
ENDIF
ENDDO
x=FCLOSE(f_handle)
IF num_files>1
IF LEN(chkMsg1)+LEN(chkMsg2)+LEN(chkMsg3)>0
? chkMsg && FILENAME
ENDIF
IF LEN(chkMsg1)>0
? chkMsg1 && PROBABLE BAD DATA IN TABLE
ENDIF
IF LEN(chkMsg2)>0
? chkMsg2 && RECORD COUNT MISMATCH
ENDIF
IF LEN(chkMsg3)>0
? chkMsg3 && FILE SIZE MISMATCH
ENDIF
ENDIF
NEXT && NEXT MATCHING FILE
IF n_sele > 0 && GO BACK TO WHERE WE STARTED
SELECT (n_sele)
ENDIF
RETURN IIF(LEN(chkMsg1)+LEN(chkMsg2)+LEN(chkMsg3)=0,.T.,.F.)