errorhand.prg

物业收费管理软件

*PROCEDURE ErrorHand
 PARAMETER NERRCODE , CERRMSG , CERRMSG1 , CERRPRG , CERRPRG1 , NERRLINE
 PNERRORNO = NERRCODE

 IF CERRPRG <> CERRPRG1
    CERRPRG = CERRPRG1 + ' -> ' + CERRPRG
 ENDIF 
 PUBLIC MSGINFO as String 
 MSGINFO = MSGINFO-'一旦发生类似意外错误，请务必联系系统维护员：王振基，谢谢！'
 ANS = MESSAGEBOX(MSGINFO,274,'系统程序意外错误')
 LCOLDALIAS = ALIAS()

 IF  .NOT. FILE('ErrorLog.dbf')
      CREATE TABLE ErrorLog.dbf ( ERRTIME T , ERRCODE N ( 5 ) , PRGLINE N ( 5 ) , ERRCMD C (  ;
                                 254 ) , ERRINFO C ( 254 ) , ERRPRG C ( 254 ) , ANSCODE N ( 1 ) ,  ;
                                 LOG_USER C ( 10 ) , STATION C ( 30 ) )
 ENDIF 

 IF OPENDB('ErrorLog')
 IF TYPE('pcUser') <> 'C'
 PCUSER = 'System'
 ENDIF 
 INSERT INTO ErrorLog ( ERRTIME , ERRCODE , PRGLINE , ERRCMD , ERRINFO , ERRPRG ,  ;
      ANSCODE , LOG_USER , STATION ) VALUES ( DATETIME() , NERRCODE , NERRLINE ,  ;
      CERRMSG1 , CERRMSG , CERRPRG , ANS , PCUSER , SYS(0) )
 ENDIF 
  CLOSEDB('ErrorLog')
 
 IF  .NOT. EMPTY(LCOLDALIAS)
     sele "&lcOldAlias"
 ENDIF 
 
 DO CASE 
    CASE ANS = 3
	 ON SHUTDOWN quit
	  _SCREEN.HIDE
	 CANCEL 
	 CLEAR EVENTS 
	 RETURN TO MASTER 
    CASE ANS = 4
	 RETRY  
    CASE ANS = 5
 ENDCASE 
 RETURN 
ENDPROC



PROCEDURE OpenDB
 PARAMETER DB_NAME , ALIAS_NAME , ISEXCLUSIVE
 LCERRORHANDEXP = ON('error')
 DO WHILE .T.
 ISNOERROR = .T.
 ISOPENERROR = .F.
 LCERRORMSG = ''
 IF TYPE('alias_name') <> 'C'
 ALIAS_NAME = DB_NAME
 IF UPPER(RIGHT(DB_NAME,4)) <> '.DBF'
 DB_NAME = DB_NAME + '.dbf'
 ENDIF 
 ELSE 
 ENDIF 
  if	used("&alias_name")
  sele "&alias_name"
 IF ISEXCLUSIVE
 USE 
 ELSE 
 ISNOERROR = .T.
 EXIT 
 ENDIF 
 ENDIF 
 LNERRORNO = -1
 ON ERROR lnErrorNo = error()	
  if !file("&db_name")
  lcErrorMsg	= "指定的文件“&db_name.”不存在！ "
 ISOPENERROR = .T.
 ELSE 
 IF ISEXCLUSIVE
  use "&db_name" alias "&alias_name" again in 0 exclusive
 ELSE 
  use "&db_name" alias "&alias_name" again in 0 share
 ENDIF 
 IF LNERRORNO = 1707
  messagebox("缺少数据文件“&db_name.”的索引文件，已忽略！",48,"警告")	
 LOOP 
 ENDIF 
 LCERRMSG = MESSAGE()
  sele "&alias_name"
 IF LNERRORNO > 0
 IF ISEXCLUSIVE
  lcErrorMsg	= "不能独占打开文件“&db_name.”！"
 ELSE 
  lcErrorMsg	= "不能共享打开文件“&db_name.”！"
 ENDIF 
 LCERRORMSG = LCERRORMSG + CHR(13) + '(' + LCERRMSG + ')'
 ENDIF 
 ENDIF 
 IF EMPTY(LCERRORMSG)
 ISNOERROR = .T.
 EXIT 
 ELSE 
 IF MESSAGEBOX(LCERRORMSG + CHR(13) + CHR(13) + '这可能会影响下面的计算，是否重试？',21,'错误') =  ;
2
 ISNOERROR = .F.
 EXIT 
 ELSE 
 LOOP 
 ENDIF 
 ENDIF 
 ENDDO 
  on error &lcErrorHandExp
 RETURN ISNOERROR
ENDPROC
*-


PROCEDURE CloseDB
 PARAMETER DB_NAME
  if used("&db_name")
  sele "&db_name"
 USE 
 ENDIF 
 RETURN 
ENDPROC