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

2019-11-18 18:44:47

字體：大中小

來源：轉載

供稿：網友

在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;