關於 GetClass 的問題 |
|
尚未結案
|
|
jacky_5678
一般會員   發表：5 回覆：14 積分：3 註冊：2004-04-21 發送簡訊給我 |
各位大大 你們好
小弟 有一個問題期待你們的解惑
小弟最近 維護別人的程式 是用載入 bpl 方式的
目前有一個 Function (GetClass(FormClassName))
都會不定時 發生當掉出現 Access violation
可以請問一下 這一個Function 的用法 及用意,
或其他相同的Function 因為此 (GetClass) 太容易當機....
因為小弟 看範例實在看不懂 也不曉得要如何改,
但確定是這一個Function搞的鬼
煩請各位大大 幫我解惑一下
謝謝各位
=====初學者======
|
|
change.jian
版主  發表：29 回覆：620 積分：439 註冊：2003-06-02 發送簡訊給我 |
|
|
jacky_5678
一般會員 發表：5 回覆：14 積分：3 註冊：2004-04-21 發送簡訊給我 |
各位大大 你們好
以下Source 是我發生問題的Function 有勞各位大大未我解惑一下,萬分感激.. function TFrmMainMenu.CallProg(ProgPackageName, FormClassName: String): Boolean;
var
AClass: TPersistentClass;
tbShipDt: ^TB_SHIPDT;
keep_pkgcount: integer;
i: integer;
MyCheck: boolean;
begin
Result := False; if (FRuning = True) then
Exit; FRuning := True; try
try
PostMessage(FindWindow('TFrmSCMain',nil),WM_APP 101,9,0); //Reset 例外處理重複判斷變數 PostMessage(FindWindow('TFrmSCMain',nil),WM_APP 101,12,0); //關閉 Timer8 , 怕某些 Form 關不掉 , 導致 Timer8 一直 run CloseCurrentForm(False); UnloadCurrentPackage(); if FileExists('c:\tfm\packagebreak.flg') then
DeleteFile('c:\tfm\packagebreak.flg'); FCurrentPackageName2:=ProgPackageName;
keep_pkgcount:=_GetAddinPackageCount; if FileExists('C:\TFM\BIN\BPL\' ProgPackageName) then
begin
FCurrentPackage := _LoadAddinPackage(FCurrentPackageName2, 'C:\TFM\BIN\BPL\' ProgPackageName);
end
else
begin
ShowMsgBox('程式:' ProgPackageName ', 不存在！', MB_ICONERROR);
Exit;
end; if (FCurrentPackage = 0) then
begin
FCurrentPackageName := '';
Exit;
end
else
begin
end; if LogBuffer<>'' then WriteToMainLog(LogBuffer); AClass := GetClass(FormClassName);
WriteToMainLog(Self.Name '.CallProg() AClass.ClassName = ' AClass.ClassName); if (AClass <> nil) then
begin
if (Assigned(FrmSCMain) = True) then
begin MyCheck:=false;
try
try
if UpperCase(ProgPackageName) = 'ANNORSTAP.BPL' then
begin
_SetDisableKeybordAndMouse(True);
end;
FrmSCmain.CurrentForm := TForm(TComponentClass(AClass).Create(Application));
finally
_SetDisableKeybordAndMouse(False);
end; except
on E: Exception do
begin
WriteToMainLog(Self.Name ' Exception:' E.Message); try
TForm(TComponentClass(AClass)).Free;
FrmSCmain.CurrentForm := TForm(TComponentClass(AClass).Create(Application));
except
on E: Exception do
begin
FrmSCmain.CurrentForm := TForm(TComponentClass(AClass));
raise;
end;
end; end; end; WriteToMainLog(Self.Name '.CallProg() CurrentForm.Name = '
FrmSCmain.CurrentForm.Name);
end
else
WriteToMainLog(Self.Name '.CallProg() Error! FrmSCMain not Assigned!');
end; if (Assigned(FrmSCmain.CurrentForm) = True) then
begin
if (Assigned(FrmSCMain.CurrentForm.OnClose) = True) then
begin
CurFormOnClose := FrmSCMain.CurrentForm.OnClose;
WriteToMainLog(Self.Name '.CallProg() Get CurtentForm.OnClose');
end
else
begin
CurFormOnClose := nil;
WriteToMainLog(Self.Name '.CallProg() CurrentForm.OnClose is NULL!');
end; FrmSCMain.CurrentForm.OnClose := ProgFormClose;
WriteToMainLog(Self.Name '.CallProg() Set CurrentForm.OnClose'); if (FrmSCMain.CurrentForm.Showing = False) then
begin
FrmSCMain.CurrentForm.Show(); end; FrmMainMenu.Enabled:=false;
FrmSCMain.Enabled:=false; WriteToMainLog(Self.Name '.CallProg() CurrentForm.Show()');
end
else
begin UnloadCurrentPackage; WriteToMainLog('★' Self.Name '.CallProg() ' FormClassName ' Not Found!');
ShowMsgBox(sModNotAvail, MB_ICONERROR);
_WriteTfmLog(Self.Name '.CallProg() -> End');
Exit;
end;
except
on E: Exception do
begin
ShowMsgBox('程式:' ProgPackageName ', 執行錯誤！', MB_ICONERROR);
Exit;
end;
end; Result := True;
finally
FRuning := False;
_WriteTfmLog(Self.Name '.CallProg() -> End');
end; end; =====初學者======
|
|
roger128
初階會員 發表：27 回覆：45 積分：25 註冊：2002-08-29 發送簡訊給我 |
AClass := GetClass(FormClassName);
WriteToMainLog(Self.Name '.CallProg() AClass.ClassName = ' AClass.ClassName);
可能發生錯誤!! 可以改成
if AClass = nil then ClassNotFound(const ClassName: string)
else WriteToMainLog(Self.Name '.CallProg() AClass.ClassName = ' AClass.ClassName);
|
|
jacky_5678
一般會員 發表：5 回覆：14 積分：3 註冊：2004-04-21 發送簡訊給我 |
引言: 你的意思是說 GetClass 這一個Function 不會錯,是錯在我寫log 的地方嗎? WriteToMainLog(Self.Name '.CallProg() AClass.ClassName = ' AClass.ClassName); 那如果真的 GetClass Get不到的時候,是不是表示我應該要重新開機,還是該要如何處理ㄋ? |
|
roger128
初階會員 發表：27 回覆：45 積分：25 註冊：2002-08-29 發送簡訊給我 |
應該是ㄅ
你可以看一下
截錄classes.pas GetClass
function GetClass(const AClassName: string): TPersistentClass;
begin
RegGroups.Lock;
try
Result := RegGroups.GetClass(AClassName);
finally
RegGroups.Unlock;
end;
end;
基本上GetClass 只會找到有註冊過ㄉClass 所以有可能找不到ㄉ話 就是你沒註冊
|
|
jacky_5678
一般會員 發表：5 回覆：14 積分：3 註冊：2004-04-21 發送簡訊給我 |
引言:
應該是ㄅ
你可以看一下 那可以再請教一下嗎?
因為我有看過程式,程式都有註冊ㄟ,現在會發生在這個錯誤的時候是不定時的
,有時候可以,有時候不行,那這樣會是什麼原因ㄋ??
|
|
change.jian
版主 發表：29 回覆：620 積分：439 註冊：2003-06-02 發送簡訊給我 |
|
|
jacky_5678
一般會員 發表：5 回覆：14 積分：3 註冊：2004-04-21 發送簡訊給我 |
引言:
我把目前懷疑當的地方稍作 註解 分為4個點
目前 有兩種 error 訊息 分別如下: 問題點 1 與 2 的 error 訊息
=> Exception:Access violation at address 400056FC in module 'rtl70.bpl'. Read of address FFFFFFD4 問題點 3 的 error 訊息
=> Exception:A component named FrmACDATSND01 already exists 問題點 4 的 error 訊息
=> Exception:Access violation at address C08B056F. Read of address PS: 問題點 3 與 4 的error是陸續出來的 |
|
change.jian
版主 發表：29 回覆：620 積分：439 註冊：2003-06-02 發送簡訊給我 |
1.在(1)與(2)的位置,應改成如下:
AClass := GetClass(FormClassName); <==== 目前懷疑當掉的地方(1)
if Assigned(AClass) then //加上判斷AClass是否存在
WriteToMainLog(Self.Name '.CallProg() AClass.ClassName = ' AClass.ClassName); <==== 目前懷疑當掉的地方(2)
2.在(3)的地方出現的錯誤訊息表示FrmACDATSND01這個form被重覆建立 3.在(4)的地方應改成如下
[code]
if Assigned(AClass) then //加上判斷AClass是否存在,以免AClass不存在又去呼叫Free,造成錯誤
TForm(TComponentClass(AClass)).Free;
FrmSCmain.CurrentForm := TForm(TComponentClass(AClass).Create(Application)); <==== 目前懷疑當掉的地方(4)
[\code] 4.建議整個流程應該重新檢討一次,不然像這已經存在的form又被重覆建立,不存在的form卻又被呼叫free,
user會感覺程式很不穩
|
|
jacky_5678
一般會員 發表：5 回覆：14 積分：3 註冊：2004-04-21 發送簡訊給我 |
引言: 1.在(1)與(2)的位置,應改成如下:
那可以再請教一下
關於第三點的問題,Form 重複Create 的問題
因為程式每次寫的方式,都有Close ,也有把他給Free,那有什麼可能會有Free
不掉的情況發生ㄋ?
|
|
change.jian
版主 發表：29 回覆：620 積分：439 註冊：2003-06-02 發送簡訊給我 |
當然,理論上而言,寫程式的人在CREATE後,一般都會給他FREE掉.但依經驗,往往很容易忽略例外狀況的處理
舉例而言,也許在CLOSE時,有錯誤發生,這時,本來應該最後會執行到FREE的CODE,就變成中途中斷,
剛好這個FORM又已經不在畫面上,這時USER也許是看到錯誤訊息,然後畫面就不見了,USER會認為已經關掉,
這時再開的話就會有問題.當然,這只是一個舉例而已 因為不曉得FrmSCmain.CurrentForm是什麼東西,如果只是一個指標的話,那麼也可以比照其他地方的方式,
在CREATE 之前,先加上 IF Assigned 的判斷,以避免錯誤產生.
|
|
jacky_5678
一般會員 發表：5 回覆：14 積分：3 註冊：2004-04-21 發送簡訊給我 |
發表時間：2005-05-31 12:15:54
IP:211.21.xxx.xxx 未訂閱
系統時間：2024-05-17 19:31:26
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |