?? usedbf.prg
字號:
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -