开发学院软件开发 Delphi 排除Delphi5中编写COM+程序的一个错误阅读

排除Delphi5中编写COM+程序的一个错误

　2006-02-04 13:34:07　来源：WEB开发网　　　

核心提示： 在Delphi5中编写COM+组件时总获得不到ObjectContext也就是调用GetObjectContext返回nil. 这使事物处理没法正确完成. 有人在网上告诉我在COM+组件前加上一条加载mtxex.dll语句.确实解决了这个问题, 但好像运行的并不稳定.PRocedure TgEntityObj.Ini

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