VFP 愛用者社區

Ruey · 註冊時間: 2003-03-12 文章: 1698 來自: tunglo 第 1 樓

來源:myf1驕傲公主

*-- 這個過程主要處理類或物件發生的物件事件
*-- 只能將方法用於 Error 事件
*--
*!* IF Type("ThisForm.Caption") = "C"
*!* MyErrorEven( m.nError , m.cMethod , m.nLine , MESSAGE( ), MESSAGE(1) , PROGRAM() , This , ThisForm.Caption )
*!* Else
*!* MyErrorEven( m.nError , m.cMethod , m.nLine , MESSAGE( ), MESSAGE(1) , PROGRAM() , This , "<未知>" )
*!* Endi
PROC MyErrorEven
LPARA lnErrorNo , lcMethod , lnLineNo , lcMessage , lcMessage1 , lcProgram , loErrorObj , lcCaption
*-- 檢查是否屬於一般性錯誤
IF NOT MyCheckSmallErrorNo( m.lnErrorNo )
*--
*-- 運行時錯誤，顯示簡短資訊
IF m.lnLineNo = 0
Messagebox( ;
'(' + LTRIM( STR(m.lnErrorNo) ) + ") " + ;
m.lcCaption + " - " + ;
Lower(JUSTSTEM(m.lcProgram)) + "." + lcMethod + " " + ;
m.lcMessage + " " + m.lcMessage1 ;
, 64 , _Screen.Caption )
ENDI
*--
*-- 調試期錯誤，或強制顯示詳細資訊
IF (m.lnLineNo > 0) OR ( VfpGetKeyState( "CTRL" ) AND VfpGetKeyState( "ALT" ) )
= Messagebox(;
'lnErrorNo: ' + LTRIM( STR(m.lnErrorNo) ) + SPACE(100) + CHR(13) + ;
'Methods: ' + lcMethod + CHR(13) + ;
'lnLineNo: ' + LTRIM( STR(m.lnLineNo) ) + CHR(13) + ;
'Message(): ' + m.lcMessage + CHR(13) + ;
'Message(1): ' + m.lcMessage1 + CHR(13) + ;
'Program: ' + m.lcProgram + CHR(13) + ;
'ObjName: ' + loErrorObj.Name + CHR(13) + ;
'ClassLibrary: ' + loErrorObj.ClassLibrary + CHR(13) + ;
'FormCaption: ' + m.lcCaption ;
, 64 , _Screen.Caption )
ENDI
*-- 檢查是否嚴重錯誤
MyCheckBigErrorNo( m.lnErrorNo )
ENDI
* PROGRAM([nLevel]) 返回當前正在執行的程式的名稱，或者錯誤發生時所執行的程式的名稱。
* MESSAGE([1]) 以字串形式返回當前錯誤資訊，或者返回導致這個錯誤的程式列內容。
ENDPROC
* My_Error
* 這個過程主要在是 on error 常式
* 方法一(推薦)：ON ERROR DO My_Error WITH ERROR( ), MESSAGE( ), MESSAGE(1), PROGRAM(), LINENO()
* 方法二(調試)：ON ERROR My_Error ( ERROR( ), MESSAGE( ), MESSAGE(1), PROGRAM(), LINENO() )
* ----------------------------------------
* 這個過程主要在有一個無法預測的錯誤發生時直接退出 VFP
PROC My_Error
* ON ERROR DO My_Error WITH ERROR( ), MESSAGE( ), MESSAGE(1), PROGRAM(), LINENO()
* ON ERROR My_Error ( ERROR( ), MESSAGE( ), MESSAGE(1), PROGRAM(), LINENO() )
LPARA lnError , lcMessage1 , lcMessage2 , lcProgram , lnLineNo
*--
*-- 以下是始終可以忽略不記錄的錯誤
IF MyCheckSmallErrorNo( m.lnError )
= Messagebox("程式跟蹤記錄號：" + TRANSFORM(m.lnError) , 0 , _Screen.Caption )
ELSE
PRIVATE lcErrorSafe , llErrorQuit , lcErrorTextmerge
Local lcErrorSafe , llErrorQuit , lcErrorTextmerge
*-- 記錄之前的環境
lcErrorSafe = SET('SAFE')
lcErrorTextmerge = SET("TEXTMERGE")
llErrorQuit = .T.
*-- 改變環境以正常工作
SET TEXTMERGE DELIMITERS TO
SET TEXTMERGE ON
SET TEXTMERGE TO DEBUGLOG.TXT ADDITIVE NOSHOW
SET SAFE OFF
*-----------------------------------------
\不可預知的錯誤 ...
\-------------------------------------------------------
\<<DATE( )>> <<TIME( )>> 開始描繪該錯誤
\程式標題: <<_Screen.Caption>>
\程式開發版本: <<VERSION(1)>>
\ISUNIX: <<_UNIX>>
\ISWINDOWS: <<_WINDOWS>>
\主窗口寬度: <<_Screen.Width>>
\主窗口高度: <<_Screen.Height>>
\主窗口左邊距: <<_Screen.Left>>
\主窗口上邊距: <<_Screen.Top>>
DO CASE
CASE _Screen.WindowState = 0
\視窗狀態: 普通
CASE _Screen.WindowState = 1
\視窗狀態: 最小化
CASE _Screen.WindowState = 2
\視窗狀態: 最大化
ENDC
\窗口可視: <>
\視窗集合數: <<_Screen.FormCount>>
\操作員 Comment: <<_Screen.Comment>>
\操作員識別 Tag KEY: <<_Screen.Tag>>
\網路機器資訊: <<SYS(0)>>
\VFP 啟動目錄: <<SYS(2004)>>
\VFP 目錄磁碟空間: <>M
\執行程式: <<JUSTFNAME(SYS(16,1))>>
\執行程式所在目錄: <<JUSTPATH(SYS(16,1))>>
\執行程式所在目錄磁碟空間: <>M
\默認目錄: <<SYS(5)>><<SYS(2003)>>
\默認目錄磁碟空間: <>M
\檔搜尋路徑: <<SET('PATH')>>
\系統臨時目錄: <<SYS(2023)>>
\臨時目錄磁碟空間: <>M
\虛擬記憶體池大小: <>M
\資源檔案: <<SYS(2005)>>
\正在使用的工作區: <<Alias()>>
\活動欄位: <<VARREAD()>>
IF Type('_Screen.ActiveForm.Name') = 'C'
\活動表單: <<_Screen.ActiveForm.Name>>
\表單標題: <<_Screen.ActiveForm.Caption>>
\表單基類: <<_Screen.ActiveForm.BaseClass>>
\表單派生: <<_Screen.ActiveForm.Class>>
\表單派生庫: <<_Screen.ActiveForm.ClassLibrary>>
\表單位置: <<SYS(1271, _Screen.ActiveForm)>>
Else
\無活動表單
Endi
IF Type('_Screen.ActiveForm.ActiveControl') = 'O'
\活動控制: <<_Screen.ActiveForm.ActiveControl.Name>>
IF Type('_Screen.ActiveForm.ActiveControl.Caption') = 'C'
\控制標題: <<_Screen.ActiveForm.ActiveControl.Caption>>
Endi
\控制項基類: <<_Screen.ActiveForm.ActiveControl.BaseClass>>
\控制項派生: <<_Screen.ActiveForm.ActiveControl.Class>>
\控制項派生庫: <<_Screen.ActiveForm.ActiveControl.ClassLibrary>>
\控制項位置: <<SYS(1271, _Screen.ActiveForm.ActiveControl)>>
Else
\無活動控制
Endi
*-- 重點標出
\***********************
\錯誤代號: <<m.lnError>>
\所在行號: <<m.lnLineNo>>
\錯誤資訊: <<m.lcMessage1>>
\錯誤代碼: <<m.lcMessage2>>
\錯誤位置: <<m.lcProgram>>
\輸出記憶體使用情況 -> MEMORYLOG.TXT
\輸出工作環境到 -> STATUSLOG.TXT
DISPLAY MEMORY NOCONSOLE TO FILE MEMORYLOG.TXT
DISPLAY STATUS NOCONSOLE TO FILE STATUSLOG.TXT
*--
*-- 這是對己知且無害的錯誤處理
*-- 在這裏才給出提示視窗是為了能正確記錄到活動到控制項名
DO CASE
*!* CASE m.lnError = 1967
*!* *-- 資料環境己經卸載
*!* = Messagebox( "資料環境己經卸載！" , 0 , "錯誤跟蹤" )
*!* RETURN
*!* CASE m.lnError = 1001
*!* *-- 此功能不可用
*!* = Messagebox( "此功能不可用！" , 0 , "錯誤跟蹤" )
*!* RETURN
CASE m.lnError = 39
*-- 數值上溢。資料已丟失
*-- 取消程式的執行嗎
m.llErrorQuit = Messagebox(" 捕捉到一個或多個太大輸入數值或者出現除零錯誤，核實你資料的合法性。" + ;
"同時這個錯誤己被記錄，它將顯示為 * 號以提示你這個資料是非法的。" + CHR(13) + CHR(13) + ;
" 如果本錯誤發生在讀取資料時，它是無害的，如果它發生在保存資料時，建議選擇取消中止程式的運行，檢查資料的合法性。", 32 + 5 + 256 , '錯誤跟蹤') = 2

*-- 這裏對未知的可能有害的處理
OTHERWISE
= Messagebox('事件代號: ' + LTRIM( STR(m.lnError) ) + CHR(13) + ;
'程式列號: ' + LTRIM( STR(m.lnLineNo) ) + CHR(13) + ;
'事件資訊: ' + m.lcMessage1 + CHR(13) + ;
'事件代碼: ' + m.lcMessage2 + CHR(13) + ;
'事件位置: ' + m.lcProgram + CHR(13) + CHR(13) + ;
' 收到這個消息，程式己強行中止。決定處理這個錯誤，聯繫軟體發展商。' + ;
'列印或備份程式安裝目錄下的錯誤捕捉檔: Debuglog.txt , Memorylog.txt , Statuslog.txt. ' + ;
'對於及早處理您現在碰到的這個錯誤是有幫助的。' , 48 , '系統級事件')
ENDCASE
\處理方法: <>
\<<DATE( )>> <<TIME( )>> 結束對錯誤的描繪
\-------------------------------------------------------
*--
*-- 恢復之前的環境
*-- 關閉文件控制碼
SET TEXTMERGE TO
SET TEXTMERGE &lcErrorTextmerge
SET SAFE &lcErrorSafe
*-- 是否終止程式
IF ( _Vfp.StartMode = 2 OR _Vfp.StartMode = 4 ) AND m.llErrorQuit
ON ERROR
ON SHUTDOWN
CLEAR EVEN
= My_Shutdown()
CANCEL
QUIT
ENDI
ENDIF
ENDPROC
*--
*-- 是否屬於一般錯誤
PROC MyCheckSmallErrorNo
LPARA lnErrorNo
DO CASE
CASE _Vfp.StartMode = 0
*-- 調試期任何錯誤都必須處理
RETURN .F.
CASE INLIST( m.lnErrorNo , 1001 , 1967 , 1533 ,1559)
RETURN .T.
*-- 1001 此功能不可用
*-- 1967 資料環境己經卸載
*-- 1533 此屬性唯讀
*-- 1559 找不到屬性
OTHERWISE
RETURN .F.
ENDCASE
ENDPROC
*--
*-- 是否屬於嚴重錯誤號
PROC MyCheckBigErrorNo
LPARA lnErrorNo
*-- 允許現場處理的錯誤號
DO CASE
CASE m.lnErrorNo = 1585
*-- 1585 更新衝突。
TABLEREVERT( .F. )
CASE m.lnErrorNo = 1589
*-- 1589 表緩衝及行緩衝要求 SET MULTILOCKS 設置為 ON。
SET MULTILOCKS ON
CASE INLIST( m.lnErrorNo , 1549,1590,1593,1599,1593)
*-- 1549 工作期 #編號被迫回滾全部事務處理以避免鎖死。
*-- 1590 BEGIN TRANSACTION 命令失敗。嵌套層次太多。
*-- 1593 在事務處理期間不能發佈此命令
*-- 1599 不能在釋放工作期“#編號”後仍然打開著事務處理。
*-- 必須回滾事條
DO While Txnlevel() # 0
ROLLBack
EndDO
* RETRY
OTHERWISE
*-- 不可恢復錯誤強制退出 VFP
*-- 6 打開的文件太多
*-- 19 索引檔與表不匹配
*-- 47 找不到要處理欄位
*-- 56 沒有足夠的磁碟空間保存“檔”
*-- 96 嵌套錯誤
*-- More ...
IF INLIST( m.lnErrorNo , 6 , 56 ) ;
OR INLIST( m.lnErrorNo , 19 , 96) ;
OR INLIST( m.lnErrorNo , 47 )
ON ERROR
ON SHUTDOWN
CLEAR EVEN
CANCEL
IF _Vfp.StartMode = 2 OR _Vfp.StartMode = 4
QUIT
ENDI
ENDI
ENDCASE
ENDPROC
*--
*-- VfpGetKeyState( leVirKey )
*-- leVirKey 取字元型、數值型
PROCEDURE VfpGetKeyState( leVirKey )
*- SHIFT = 16 CTRL = 17 ALT = 18
PRIVATE lnVirKey , lcVirKey
Local lnVirKey , lcVirKey
DO CASE
CASE VarType(leVirKey) = "N"
lnVirKey = leVirKey
CASE VarType(leVirKey) = "C" AND LEN(leVirKey) > 1
lcVirKey = UPPE( leVirKey )
DO CASE
CASE lcVirKey = "TAB"
lnVirKey = 9
CASE lcVirKey = "SHIFT"
lnVirKey = 16
CASE lcVirKey = "CTRL"
lnVirKey = 17
CASE lcVirKey = "ALT"
lnVirKey = 18
CASE lcVirKey = "ESC"
lnVirKey = 27
OTHERWISE
lnVirKey = ASC( LEFT(lcVirKey,1) )
ENDC
OTHERWISE
RETURN .F.
ENDC
DECLARE INTEGER GetKeyState IN Win32Api LONG
RETURN BITTEST( GetKeyState( m.lnVirKey ) , 15 )
ENDPROC