排除Delphi5中編寫COM+程式的一個錯誤 (轉)

排除Delphi5中編寫COM+程式的一個錯誤 (轉)[@more@]

  在5中編寫COM+時總獲得不到Context
也就是GetObjectContext返回nil. 這使事物處理沒法正確
完成. 有人在網上告訴我在COM+元件前加上一條載入mtxex.dll
語句.確實解決了這個問題, 但好像執行的並不穩定.
procedure TgEntityObj.Initialize;
begin
  inherited;
  LoadLibrary('mtxex.dll');
end;
但我在Delphi6中不加這條語句就可以獲得ObjectContext.
我看了D6中的MTX單元和D5果然不一樣, 這也不能怪Borland
D5出來的時候(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 ImPlusPlatform: boolean;  //////  是否為COM+
var
  Ver: TOsVersionInfo;////
begin
  Ver.dwOSVersionInfoSize := sizeof(Ver);////
  GetVersionEx(Ver);
  if (Ver.dwPlatfoD = VER_PLATFORM__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 IsComPlusPlatfothen  ////
  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了.