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

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

加斜细的是多的部分你只需要把这些部加D5的MTX就可以了.然后另存到你程序的当前目录
编译程序就能获得ObjectContext了.

  • 0
    点赞
  • 0
    评论
  • 0
    收藏
  • 一键三连
    一键三连
  • 扫一扫,分享海报

相关推荐
©️2020 CSDN 皮肤主题: 大白 设计师:CSDN官方博客 返回首页
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、C币套餐、付费专栏及课程。

余额充值