8

我正在对一个杂乱的项目进行一些调试，我之前的开发人员不知道他们在做什么，主要问题是尝试多线程应用程序失败。我现在正在清理混乱并试图找出哪里出了问题。CoInitialize问题之一是使用 ADO 组件的调用不一致。

继续我之前的问题，我如何确定CoInitialize已经调用了多少级别？

例如，考虑以下代码：

CoInitialize(nil);
try
  CoInitialize(nil);
  try
    //2 levels have been called, how to programatically check this?
  finally
    CoUninitialize;
  end;
finally
  CoUninitialize;
end;
4

4 回答 4

10

如果我必须解决这个问题，我会通过检测对 和 的调用来CoInitialize解决CoInitializeEx它CoUninitialize。我会将调用挂钩到这些函数并使用线程局部变量来计算调用。

您可以通过将以下单元添加到您的项目中来做到这一点。

unit InstrumentCOMinit;

interface

uses
  SysUtils, Windows, ComObj, ActiveX;

threadvar
  COMinitCount: Integer;

implementation

function CoInitialize(pvReserved: Pointer): HResult; stdcall; external 'ole32.dll';
function CoInitializeEx(pvReserved: Pointer; coInit: Longint): HResult; stdcall; external 'ole32.dll';
procedure CoUninitialize; stdcall; external 'ole32.dll';

function InstrumentedCoInitialize(pvReserved: Pointer): HResult; stdcall;
begin
  Result := CoInitialize(pvReserved);
  if Succeeded(Result) then
    inc(COMinitCount);
end;

function InstrumentedCoInitializeEx(pvReserved: Pointer; coInit: Longint): HResult; stdcall;
begin
  Result := CoInitializeEx(pvReserved, coInit);
  if Succeeded(Result) then
    inc(COMinitCount);
end;

procedure InstrumentedCoUninitialize; stdcall;
begin
  CoUninitialize;
  dec(COMinitCount);
end;

procedure Fail;
begin
  raise EAssertionFailed.Create('Fixup failed.');
end;

procedure PatchCode(Address: Pointer; const NewCode; Size: Integer);
var
  OldProtect: DWORD;
begin
  if not VirtualProtect(Address, Size, PAGE_EXECUTE_READWRITE, OldProtect) then begin
    Fail;
  end;
  Move(NewCode, Address^, Size);
  FlushInstructionCache(GetCurrentProcess, nil, 0);
  if not VirtualProtect(Address, Size, OldProtect, @OldProtect) then begin
    Fail;
  end;
end;

type
  PInstruction = ^TInstruction;
  TInstruction = packed record
    Opcode: Byte;
    Offset: Integer;
  end;

procedure RedirectProcedure(OldAddress, NewAddress: Pointer);
var
  NewCode: TInstruction;
begin
  NewCode.Opcode := $E9;//jump relative
  NewCode.Offset := NativeInt(NewAddress)-NativeInt(OldAddress)-SizeOf(NewCode);
  PatchCode(OldAddress, NewCode, SizeOf(NewCode));
end;

initialization
  RedirectProcedure(@ActiveX.CoInitialize, @InstrumentedCoInitialize);
  RedirectProcedure(@ActiveX.CoInitializeEx, @InstrumentedCoInitializeEx);
  RedirectProcedure(@ActiveX.CoUninitialize, @InstrumentedCoUninitialize);
  ComObj.CoInitializeEx := InstrumentedCoInitializeEx;

end.

与 Serg 的方法不同，这种技术不会改变程序的语义。

于 2013-01-27T12:28:45.463 回答
6

你可以这样做：

function CoInitializeCount: Integer;
var
  HR: HResult;
  I: Integer;

begin
  Result:= 0;
  repeat
    HR:= CoInitialize(nil);
    if (HR and $80000000 <> 0) then begin
      Result:= -1;
      Exit;
    end;
    CoUnInitialize;
    if (HR <> S_OK) then begin
      CoUnInitialize;
      Inc(Result);
    end
    else Break;
  until False;
  for I:= 0 to Result - 1 do
    CoInitialize(nil);
end;

警告！由于上述函数关闭了 COM，因此不能在 COM 应用程序中使用，只能在调试时回答特定问题。

于 2013-01-27T01:48:43.393 回答
2

如果我要清理这样的项目，我将创建一个抽象线程祖先，并覆盖 Execute 并将其拆分为三个虚拟方法，例如 BeforeExecuteTask、AfterExecuteTask 和抽象 ExecuteTask。

我会将 COM（取消）初始化移动到 Before/After 方法中，并删除所有其他发生（DRY）。在每个后代中，我会将代码从原始 Execute 方法移动到覆盖的 ExecuteTask。

于 2013-01-27T07:45:18.193 回答
1

至于 Coinitialize 和 CoUninitialize 必须按线程计数，并且不应调用 CoUninitialize 进行计数，因为 COM 将被破坏，您可以使用以下代码进行调试。 

unit CoinitCounter;

interface

uses Classes, Generics.Collections, ActiveX, SyncObjs, Windows;

Type
  TCoIniRec = Record
    ThreadID: Cardinal;
    Init: Integer;
    InvalidInit:Integer;
    CoInit: Integer;
    IsCoinitialized:Boolean;
  End;

  TCoIniList = TList<TCoIniRec>;

  TCoinitCounter = Class
  private
    FCS: TCriticalSection;
    FList: TCoIniList;

    Constructor Create;
    Destructor Destroy; override;
  public
    Function Coinitialize(p: Pointer): HRESULT;
    Procedure CoUninitialize;
    Function LeftInitCount: Integer;
    Function ValidInits: Integer;
    Function InValidInits: Integer;
    Function IsCoinitialized:Boolean;

  End;

var
  FCoinitCounter: TCoinitCounter;

implementation

{ TCoinitCounter }

function TCoinitCounter.Coinitialize(p: Pointer): HRESULT;
var
  r: TCoIniRec;
  i, x: Integer;
begin
  FCS.Enter;
  Result := ActiveX.Coinitialize(p);
  if  Succeeded(Result) then
  begin    
    x := -1;
    for i := 0 to FList.Count - 1 do
      if FList[i].ThreadID = GetCurrentThreadID then
        x := i;
    if x > -1 then
    begin
      r := FList[x];
      r.IsCoinitialized := true;
      if Result = s_OK then r.Init := r.Init + 1
      else r.InvalidInit := r.InvalidInit + 1;
      FList[x] := r;
    end
    else
    begin
      ZeroMemory(@r,SizeOf(r));
      r.ThreadID := GetCurrentThreadID;
      r.IsCoinitialized := true;
      if Result = s_OK then r.Init :=  1
      else r.InvalidInit :=  1;
      FList.Add(r);
    end;
  end;
  FCS.Leave;
end;

procedure TCoinitCounter.CoUninitialize;
var
  r: TCoIniRec;
  i, x: Integer;
begin
  FCS.Enter;
  x := -1;
  ActiveX.CoUninitialize;
  for i := 0 to FList.Count - 1 do
    if FList[i].ThreadID = GetCurrentThreadID then
      x := i;
  if x > -1 then
  begin
    r := FList[x];
    r.IsCoinitialized := false;
    r.CoInit := r.CoInit + 1;
    FList[x] := r;
  end
  else
  begin
    r.ThreadID := GetCurrentThreadID;
    r.IsCoinitialized := false;
    r.CoInit := 1;
    FList.Add(r);
  end;
  FCS.Leave;
end;

constructor TCoinitCounter.Create;
begin
  inherited;
  FCS := TCriticalSection.Create;
  FList := TCoIniList.Create;
end;

destructor TCoinitCounter.Destroy;
begin
  FCS.Free;
  FList.Free;

  inherited;
end;

function TCoinitCounter.InValidInits: Integer;
var
  i, x: Integer;
begin
  FCS.Enter;
  x := -1;
  for i := 0 to FList.Count - 1 do
    if FList[i].ThreadID = GetCurrentThreadID then
      x := i;
  if x > -1 then
    Result :=  FList[x].InvalidInit
  else
    Result := 0;
  FCS.Leave;
end;

function TCoinitCounter.LeftInitCount: Integer;
var
  i, x: Integer;
begin
  FCS.Enter;
  x := -1;
  for i := 0 to FList.Count - 1 do
    if FList[i].ThreadID = GetCurrentThreadID then
      x := i;
  if x > -1 then
    Result := FList[x].Init + FList[x].InvalidInit - FList[x].CoInit
  else
    Result := 0;
  FCS.Leave;
end;

function TCoinitCounter.IsCoinitialized: Boolean;
var
  i, x: Integer;
begin
  FCS.Enter;
  x := -1;
  for i := 0 to FList.Count - 1 do
    if FList[i].ThreadID = GetCurrentThreadID then
      x := i;
  if x > -1 then
    Result := FList[x].IsCoinitialized
  else
    Result := false;
  FCS.Leave;
end;


function TCoinitCounter.ValidInits: Integer;
var
  i, x: Integer;
begin
  FCS.Enter;
  x := -1;
  for i := 0 to FList.Count - 1 do
    if FList[i].ThreadID = GetCurrentThreadID then
      x := i;
  if x > -1 then
    Result :=  FList[x].Init
  else
    Result := 0;
  FCS.Leave;
end;

initialization

FCoinitCounter := TCoinitCounter.Create;

finalization

FCoinitCounter.Free;

end.

这

ThreadID 6968 deserved: 0 counted: 0 valid: 0 invalid 0
ThreadID 2908 deserved: 4 counted: 4 valid: 1 invalid 3
ThreadID 5184 deserved: 1 counted: 1 valid: 1 invalid 0
ThreadID 7864 deserved: 8 counted: 8 valid: 1 invalid 7
ThreadID 7284 deserved: 2 counted: 2 valid: 1 invalid 1
ThreadID 6352 deserved: 5 counted: 5 valid: 1 invalid 4
ThreadID 3624 deserved: 4 counted: 4 valid: 1 invalid 3
ThreadID 5180 deserved: 0 counted: 0 valid: 0 invalid 0
ThreadID 7384 deserved: 6 counted: 6 valid: 1 invalid 5
ThreadID 6860 deserved: 9 counted: 9 valid: 1 invalid 8

将是以下单元的示例输出：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    procedure DispOnTerminate(Sender: TObject);
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation
uses CoinitCounter;
{$R *.dfm}
Type
  TTestThread=Class(TThread)
    private
    FCounted,FTestCoinits:Integer;
    FValidInits: Integer;
    FInValidInits: Integer;
    protected
    Procedure Execute;override;
    public
    Constructor Create(cnt:Integer);overload;
    Property TestCoinits:Integer read FTestCoinits;
    Property Counted:Integer Read FCounted;
    Property ValidInits:Integer Read FValidInits;
    Property InivalidInits:Integer Read FInValidInits;
  End;


{ TTestThread }

constructor TTestThread.Create(cnt: Integer);
begin
  inherited Create(false);
  FTestCoinits:= cnt;
end;

procedure TTestThread.Execute;
var
 i:Integer;
begin
  inherited;
  for I := 1 to FTestCoinits  do
     FCoinitCounter.Coinitialize(nil);
  FCounted := FCoinitCounter.LeftInitCount;
  FValidInits := FCoinitCounter.ValidInits;
  FInValidInits := FCoinitCounter.InValidInits;
  for I := 1 to FCounted do
       FCoinitCounter.CoUninitialize;
end;




procedure TForm1.DispOnTerminate(Sender: TObject);
begin
  Memo1.Lines.Add(Format('ThreadID %d deserved: %d counted: %d valid: %d invalid %d'
     ,[TTestThread(Sender).ThreadID, TTestThread(Sender).TestCoinits,TTestThread(Sender).Counted,TTestThread(Sender).ValidInits,TTestThread(Sender).InivalidInits]));
end;
procedure TForm1.Button1Click(Sender: TObject);
var
 i:Integer;
begin

  for I := 1 to 10  do
      with TTestThread.Create(Random(10)) do OnTerminate := DispOnTerminate;
end;

end.
于 2013-01-27T12:26:06.077 回答