PROC USEDBF  &&讀取數(shù)據(jù)文件并處理相關的錯誤
PARA LCFN1,LCALI,LCFN2,LCFN3,LCFN4,LCFN5,LCCMD,LNSELE
*調用格式：=USEDBF('數(shù)據(jù)文件全名','別名','文件2','文件3','文件4','文件5','需要執(zhí)行的命令，如新創(chuàng)建數(shù)據(jù)文件')
LCDELE=SET('DELE')
LCEXCL=SET('EXCL')
SET EXCL OFF
LCDCMD=''
LCERR=ON('ERROR')
ON ERROR DO ONERRORUSEDBF WITH ERROR(), MESSAGE(), MESSAGE(1), PROGRAM(), LINENO(1)
LCDAL=IIF(TYPE('LCALI')='C',LCALI,IIF(TYPE('LCFN1')='C',SUBS(LCFN1,RAT('\',LCFN1)+1,IIF('.DBF'$UPPE(LCFN1),RAT('.DBF',UPPE(LCFN1))-RAT('\',LCFN1)-1,LEN(LCFN1)-RAT('\',LCFN1))),' '))
LCFN1=IIF(TYPE('LCFN1')='C',IIF('.DBF'$UPPE(LCFN1),LCFN1,IIF(LEN(ALLT(LCFN1))>0,LCFN1+'.DBF',' ')),' ')
LNDSELE=IIF(TYPE('LNSELE')='N',LNSELE,0)
SELE (LNDSELE)
IF USED(LCDAL)
SELE (LCDAL)
ELSE
LCDAL=IIF(LEN(ALLT(LCDAL))>0,' ALIAS '+LCDAL,' ')
LCDCMD=IIF(TYPE('LCCMD')='C',LCCMD,'')
LCFN=IIF(TYPE('LCFN5')='C',IIF(FILE(LCFN5),LCFN5,''),'')
LCFN=IIF(TYPE('LCFN4')='C',IIF(FILE(LCFN4),LCFN4,LCFN),'')
LCFN=IIF(TYPE('LCFN3')='C',IIF(FILE(LCFN3),LCFN3,LCFN),'')
LCFN=IIF(TYPE('LCFN2')='C',IIF(FILE(LCFN2),LCFN2,LCFN),'')
LCFN=IIF(TYPE('LCFN1')='C',IIF(FILE(LCFN1),LCFN1,LCFN),'')
LCDCMD=IIF(LEN(LCFN)>0,'USE '+LCFN+LCDAL,LCDCMD)
*ON ERROR DO ERRRETU
&LCDCMD
ENDI
SET DELE &LCDELE
SET EXCL &LCEXCL
ON ERROR &LCERR
IF !USED()
=MESSAGEBOX("需要的數(shù)據(jù)文件未能打開!!! 本程序結束。    "+CHR(13)+CHR(13)+"信息：'"+LCDCMD+"'",48,'警告')
CLEAR WINDOWS ALL
CLOSE ALTE ALL
CLOSE DATA ALL
CLOSE FORMAT ALL
CLOSE INDE ALL
CLOSE TABLES ALL
CLEAR READ ALL
CLEAR EVENTS
SET SYSM TO DEFA
ON SHUTDOWN
QUIT
ENDI
IF LEN(LCDCMD)>10
IF 'CREA'$LEFT(LCDCMD,10) AND ('DBF'$LEFT(LCDCMD,10) OR 'TABL'$LEFT(LCDCMD,10))
LCDBF=DBF()
USE
USE &LCDBF
ENDI
ENDI
RETU


PROC ONERRORUSEDBF  &&錯誤處理程序
PARA MERROR, MESS, MESS1, MPROG, MLINENO
IF LEFT(ALLT(MESS1),1)='&'
MESS1=RIGHT(MESS1,LEN(MESS1)-1)
MESS1=EVAL(MESS1)
ENDIF
DO CASE
  CASE MERROR=0 &&數(shù)據(jù)超出指定范圍
    WAIT WINDOW '錯 誤 號：'+ALLT(STR(MERROR))+'  出錯信息：'+MESS+'  數(shù)據(jù)超出指定范圍，需要重新輸入。' TIMEOUT 6
    RETURN
  CASE MERROR=1 &&文件不存在
    IF '.DBC'$UPPE(MESS) AND '.DBF'$UPPE(LCFN)
      WAIT WINDOW '錯 誤 號：'+ALLT(STR(MERROR))+'  出錯信息：'+MESS+' 釋放數(shù)據(jù)表。' TIMEOUT 6
      FREE TABLE &LCFN
      RETRY
    ENDIF
  CASE MERROR=41 &&備注文件.FPT缺少或無效
    WAIT WINDOW '錯 誤 號：'+ALLT(STR(MERROR))+'  出錯信息：'+MESS+' 重建備注文件。' TIMEOUT 6
    IF '.FPT'$UPPE(MESS) AND '.DBF'$UPPE(LCFN)
      CREA DBF 0(M M)
      USE
      C='COPY FILE 0.FPT TO '+LEFT(LCFN,LEN(LCFN)-4)+'.FPT'
      &C
      DELE FILE 0.DBF
      DELE FILE 0.FPT
      RETRY
    ENDIF
  CASE MERROR=114 &&索引與表不匹配
    WAIT WINDOW '錯 誤 號：'+ALLT(STR(MERROR))+'  出錯信息：'+MESS+'  刪除索引。' TIMEOUT 6
    DELE FILE (LEFT(LCFN,LEN(LCFN)-4)+'.CDX')
    RETRY
  CASE MERROR=1707 &&找不到結構 .CDX文件
    WAIT WINDOW '錯 誤 號：'+ALLT(STR(MERROR))+'  出錯信息：'+MESS+'  忽略索引。' TIMEOUT 6
    RETRY
ENDCASE
ERRMSG=MESSAGEBOX('錯 誤 號：'+LTRIM(STR(MERROR))+CHR(13);
 +'出錯信息：'+MESS+CHR(13)+'出錯代碼：'+MESS1+CHR(13)+'出錯程序：'+MPROG;
 +CHR(13)+'出錯行號：'+LTRIM(STR(MLINENO))+CHR(13);
 +'是否要終止？'+CHR(13);
 +'(建議終止本程序并與程序設計或數(shù)據(jù)管理人員聯(lián)系)    ',2+48+0,'出錯信息')
DO CASE
  CASE ERRMSG=4
    SET DEBUG ON
    SET ECHO ON
    RETRY
  CASE ERRMSG=5
    SET DEBUG ON
    SET ECHO ON
  CASE ERRMSG=3
IF TYPE('LCERR')='C'
ON ERROR &LCERR
ENDIF
&&執(zhí)行退出程序
=MESSAGEBOX("需要的數(shù)據(jù)文件未能打開!!! 本程序結束。    "+CHR(13)+CHR(13)+"信息：'"+LCDCMD+"'",48,'警告')
CLEAR WINDOWS ALL
CLOSE ALTE ALL
CLOSE DATA ALL
CLOSE FORMAT ALL
CLOSE INDE ALL
CLOSE TABLES ALL
CLEAR READ ALL
CLEAR EVENTS
SET SYSM TO DEFA
ON SHUTDOWN
QUIT
ENDCASE
RETURN

PROC ERRRETU  &&錯誤處理忽略
RETU