* -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
*  文件名: MAIN.PRG(主文件) <-- 本文件由 UnFoxAll 創建
* -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-


 SET ESCAPE ON
 SET SYSMENU TO
 SET TALK OFF
 SET ECHO OFF
 SET STEP OFF
 SET SAFETY OFF
 SET EXCLUSIVE OFF
 SET DATE TO ANSI
 SET CENTURY ON
 SET HOURS TO 24
 SET MULTILOCKS ON
 SET DELETED ON
 SET COMPATIBLE ON
 LCTEMP = SYS(2023)
 LNTEMP = LEN(LCTEMP)
 LCDEFA = SET('DEFAULT')
 LCDEFAULTNOW = JUSTPATH(SYS(16))
 IF RIGHT(LCDEFAULTNOW,1) <> '\'
    LCDEFAULTNOW = LCDEFAULTNOW + '\'
 ENDIF 
 LLCALLAPP = IIF(TYPE('LCCALLAPP') = 'C',LCCALLAPP == 'CALLAPP',.F.)
 IF  .NOT. LLCALLAPP
    ON SHUTDOWN DO ONSHUTD
    ON ESCAPE DO ONESCAPE
    ON ERROR DO ONERROR WITH ERROR(), MESSAGE(), MESSAGE(1), PROGRAM(), LINENO(1)
    ON READERROR DO ONERROR WITH ERROR(), MESSAGE(), MESSAGE(1), PROGRAM(), LINENO(1)
    ON KEY LABEL F12 DO ONESCAPEF12
    _SCREEN.WINDOWSTATE = 2
    _SCREEN.CAPTION = '數據報送'
    _SCREEN.ICON = 'DATAREPO.ICO'
 ENDIF 
 CLOSE DATABASES ALL
 CLOSE TABLE ALL
 PUBLIC USERNAME , SHORTNAME , FULLNAME , ADDR
 SELECT 0
  USEDBFCOMPANY()
 M.SHORTNAME = COMPANY.NAME
 M.FULLNAME = COMPANY.FULLNAME
 M.ADDR = COMPANY.ADDR
 USE 
 USERNAME = ''
 DO FORM MAINFORM NAME FORMMAINFORM LINKED 
 SET SYSMENU TO DEFAULT
 CLOSE DATABASES ALL
 CLOSE TABLE ALL
 IF LLCALLAPP
    RETURN 
 ELSE 
    ON SHUTDOWN 
    QUIT 
 ENDIF 

PROCEDURE ONERROR
 PARAMETER MERROR , MESS , MESS1 , MPROG , MLINENO
 DO CASE 
 CASE MERROR = 0
    WAIT WINDOW TIMEOUT 6  ;
         '錯 誤 號：' + ALLTRIM(STR(MERROR)) + '  出錯信息：' + MESS +  ;
   '  數據超出指定范圍，需要重新輸入。'
    RETURN 
 CASE MERROR = 1707
    WAIT WINDOW TIMEOUT 6  ;
         '錯 誤 號：' + ALLTRIM(STR(MERROR)) + '  出錯信息：' + MESS + '  忽略索引。'
    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) +  ;
'(建議終止本程序并與程序設計或數據管理人員聯系)    ',50,'出錯信息')
 DO CASE 
 CASE ERRMSG = 4
    SET DEBUG ON
    SET ECHO ON
    RETRY  
 CASE ERRMSG = 5
    SET DEBUG ON
    SET ECHO ON
    RETURN 
 CASE ERRMSG = 3
    DO ONSHUTD
 ENDCASE 
 RETURN 
ENDPROC
*------
PROCEDURE ONSHUTD
 IF MESSAGEBOX('是否要退出本系統?    ',33,'退出') = 1
    CLEAR WINDOW
    CLOSE ALTERNATE 
    CLOSE DATABASES ALL
    CLOSE FORM
    CLOSE INDEXES 
    CLOSE TABLE ALL
    CLEAR READ ALL
    CLEAR EVENTS 
    SET SYSMENU TO DEFAULT
    ON SHUTDOWN 
    QUIT 
 ENDIF 
ENDPROC
*------
PROCEDURE ONESCAPE
 = MESSAGEBOX('ESCAPE鍵中止！    ',52,'中止')
 DO ONSHUTD
 RETURN 
ENDPROC
*------
PROCEDURE ONESCAPEF12
 = MESSAGEBOX('F12 鍵中止！    ',52,'中止')
 DO ONSHUTD
 RETURN 
ENDPROC
*------
PROCEDURE USEDBF
 PARAMETER LCFN1 , LCALI , LCFN2 , LCFN3 , LCFN4 , LCFN5 , LCCMD , LNSELE
 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',SUBSTR(LCFN1,RAT('\',LCFN1) + 1,IIF('.DBF' $ UPPER(LCFN1),RAT('.DBF',UPPER(LCFN1)) - RAT('\',LCFN1) - 1,LEN(LCFN1) - RAT('\',LCFN1))),' '))
 LCFN1 =  ;
      IIF(TYPE('LCFN1') = 'C',IIF('.DBF' $ UPPER(LCFN1),LCFN1,IIF(LEN(ALLTRIM(LCFN1)) > 0,LCFN1 + '.DBF',' ')),' ')
 LNDSELE = IIF(TYPE('LNSELE') = 'N',LNSELE,0)
 SELECT (LNDSELE)
 IF USED(LCDAL)
    SELECT (LCDAL)
 ELSE 
    LCDAL = IIF(LEN(ALLTRIM(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)
     &LCDCMD
 ENDIF 
  ON ERROR &LCERR
 IF  .NOT. USED()
    = MESSAGEBOX('需要的數據文件未能打開!!! 本程序結束。    ',48,'警告')
    CLEAR WINDOW
    CLOSE ALTERNATE 
    CLOSE DATABASES ALL
    CLOSE FORM
    CLOSE INDEXES 
    CLOSE TABLE ALL
    CLEAR READ ALL
    CLEAR EVENTS 
    SET SYSMENU TO DEFAULT
    ON SHUTDOWN 
    QUIT 
 ENDIF 
 RETURN 
ENDPROC
*------
PROCEDURE ONERRORUSEDBF
 PARAMETER MERROR , MESS , MESS1 , MPROG , MLINENO
 IF LEFT(ALLTRIM(MESS1),1) = '&'
    MESS1 = RIGHT(MESS1,LEN(MESS1) - 1)
    MESS1 = EVALUATE(MESS1)
 ENDIF 
 DO CASE 
 CASE MERROR = 0
    WAIT WINDOW TIMEOUT 6  ;
         '錯 誤 號：' + ALLTRIM(STR(MERROR)) + '  出錯信息：' + MESS +  ;
   '  數據超出指定范圍，需要重新輸入。'
    RETURN 
 CASE MERROR = 1
    IF '.DBC' $ UPPER(MESS) AND '.DBF' $ UPPER(LCFN)
       WAIT WINDOW TIMEOUT 6  ;
            '錯 誤 號：' + ALLTRIM(STR(MERROR)) + '  出錯信息：' + MESS + ' 釋放數據表。'
        FREE TABLE &LCFN
       RETRY  
    ENDIF 
 CASE MERROR = 41
    WAIT WINDOW TIMEOUT 6  ;
         '錯 誤 號：' + ALLTRIM(STR(MERROR)) + '  出錯信息：' + MESS + ' 重建備注文件。'
    IF '.FPT' $ UPPER(MESS) AND '.DBF' $ UPPER(LCFN)
       CREATE TABLE 0 ( M M )
       USE 
       C = 'COPY FILE 0.FPT TO ' + LEFT(LCFN,LEN(LCFN) - 4) + '.FPT'
        &C
       DELETE File 0.DBF
       DELETE File 0.FPT
       RETRY  
    ENDIF 
 CASE MERROR = 114
    WAIT WINDOW TIMEOUT 6  ;
         '錯 誤 號：' + ALLTRIM(STR(MERROR)) + '  出錯信息：' + MESS + '  刪除索引。'
    DELETE File (LEFT(LCFN,LEN(LCFN) - 4) + '.CDX')
    RETRY  
 CASE MERROR = 1707
    WAIT WINDOW TIMEOUT 6  ;
         '錯 誤 號：' + ALLTRIM(STR(MERROR)) + '  出錯信息：' + MESS + '  忽略索引。'
    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) +  ;
'(建議終止本程序并與程序設計或數據管理人員聯系)    ',50,'出錯信息')
 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 
    DO ONSHUTD
 ENDCASE 
 RETURN 
ENDPROC
*------*