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

    技术2022-05-11  150

              在Delphi5中编写COM+组件时总获得不到ObjectContext也就是调用GetObjectContext返回nil. 这使事物处理没法正确完成. 有人在网上告诉我在COM+组件前加上一条加载mtxex.dll语句.确实解决了这个问题, 但好像运行的并不稳定.procedure TgEntityObj.Initialize;begin  inherited;  LoadLibrary('mtxex.dll');end;但我在Delphi6中不加这条语句就可以获得ObjectContext.我看了D6中的MTX单元和D5果然不一样, 这也不能怪BorlandD5出来的时候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)