程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> 排除Delphi5中編寫COM+程序的一個錯誤

排除Delphi5中編寫COM+程序的一個錯誤

編輯：Delphi

在Delphi5中編寫COM+組件時總獲得不到ObjectContext
　　也就是調用GetObjectContext返回nil. 這使事物處理沒法正確
　　完成. 有人在網上告訴我在COM+組件前加上一條加載mtxex.dll
　　語句.確實解決了這個問題, 但好像運行的並不穩定.
　　procedure TgEntityObj.Initialize;
　　begin
　　 inherited;
　　 LoadLibrary('mtxex.dll');
　　end;
　　但我在Delphi6中不加這條語句就可以獲得ObjectContext.
　　我看了D6中的MTX單元和D5果然不一樣, 這也不能怪Borland
　　D5出來的時候WIN2000(COM+)還沒出來所以D5中MTX單位中還是加載
　　MTS的寫法.

　　在D5 MTX單元中253行.
　　implementation

　　uses ComObj;

　　type
　　 TGetObjectContextProc = function(var ObjectContext: IObjectContext): HRESULT; cdecl;
　　 TSafeRefProc = function(const rid: TGUID; Unk: IUnknown): Pointer; cdecl;
　　var
　　 GetObjectContextProc: TGetObjectContextProc = nil;
　　 SafeRefProc: TSafeRefProc = nil;
　　 MtsProcsLoaded: Boolean = False;

　　procedure LoadMtsProcs;
　　var
　　 Mtxdll: HModule;
　　begin
　　 if MtsProcsLoaded then Exit;
　　 MtsProcsLoaded := True;
　　 Mtxdll := GetModuleHandle('mtxex.dll');
　　 if mtxdll <> 0 then
　　 begin
　　 @GetObjectContextProc := GetProcAddress(Mtxdll, 'GetObjectContext');
　　 @SafeRefProc := GetProcAddress(Mtxdll, 'SafeRef');
　　 end;
　　end;

　　function GetObjectContext: IObjectContext;
　　begin
　　 LoadMtsProcs;
　　 if Assigned(GetObjectContextProc) then
　　 OleCheck(GetObjectContextProc(Result))
　　 else
　　 Result := nil; //單步執行時返回空.
　　end;

　　D6中的MTX單元注意不同.

　　implementation

　　uses ComObj;

　　type
　　 TGetObjectContextProc = function(var ObjectContext: IObjectContext): HRESULT; cdecl;
　　 ///
　　 TCoGetObjectContextProc = function(const riid: TGUID; var ObjectContext: IObjectContext): HRESULT; stdcall;
　　 TSafeRefProc = function(const rid: TGUID; Unk: IUnknown): Pointer; cdecl;
　　var
　　 GetObjectContextProc: TGetObjectContextProc = nil;
　　 CoGetObjectContextProc: TCoGetObjectContextProc = nil; ///
　　 SafeRefProc: TSafeRefProc = nil;
　　 MtsProcsLoaded: Boolean = False;

　　function IsComPlusPlatform: boolean;      ////// 是否為COM+
　　var
　　 Ver: TOsVersionInfo;////
　　begin
　　 Ver.dwOSVersionInfoSize := sizeof(Ver);////
　　 GetVersionEx(Ver);
　　 if (Ver.dwPlatformID = VER_PLATFORM_WIN32_NT) and///
　　     (Ver.dwMajorVersion >= 5) then////
　　       Result := true          //
　　 else Result := false;
　　end;                              //////

　　
　　procedure LoadMtsProcs;
　　var
　　 Mtxdll: HModule;
　　begin
　　 if MtsProcsLoaded then Exit;
　　 MtsProcsLoaded := True;
　　 if IsComPlusPlatform then        ////
　　 begin
　　    Mtxdll := GetModuleHandle('ole32.dll');   ///
　　    if mtxdll <> 0 then                         ///
　　       @CoGetObjectContextProc := GetProcAddress(Mtxdll, 'CoGetObjectContext');
　　 end                                             ///
　　 else
　　 begin
　　    Mtxdll := GetModuleHandle('mtxex.dll');
　　    if mtxdll <> 0 then
　　    begin
　　      @GetObjectContextProc := GetProcAddress(Mtxdll, 'GetObjectContext');
　　      @SafeRefProc := GetProcAddress(Mtxdll, 'SafeRef');
　　    end;
　　 end;
　　end;
　　function GetObjectContext: IObjectContext;
　　const
　　 IID_IObjectContext: TGUID = '{51372AE0-CAE7-11CF-BE81-00AA00A2FA25}'; ///
　　begin
　　 LoadMtsProcs;
　　 if Assigned(CoGetObjectContextProc) then    ///
　　    CoGetObjectContextProc(IID_IObjectContext, Result)     ///
　　 else if Assigned(GetObjectContextProc) then
　　    OleCheck(GetObjectContextProc(Result))
　　 else
　　    Result := nil;
　　end;