How to identify how many levels of CoInitialize have been called?

Question

I'm doing some debugging on a messy project I picked up where the previous developer didn't know what they were doing, and the main issue is failed attempts to multi-thread the application. I'm now cleaning up the mess and trying to figure out where things are going wrong. One of the issues is inconsistent calls to CoInitialize in order to use ADO components.

Continued from my previous question, how can I identify how many levels of CoInitialize have been called?

For example, take this code into consideration:

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

Answer 1

If I had to solve this problem I'd tackle it by instrumenting calls to CoInitialize, CoInitializeEx and CoUninitialize. I would hook the calls to those functions and use a thread local variable to count the calls.

You can do this by adding the following unit to your project.

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.

Unlike Serg's approach, this technique will not change the semantics of your program.

Answer 2

You can do it like this:

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;

---

Warning! Since the above function closes COM it cannot be used in COM applications, only to answer the particular question while debugging.

Answer 3

If I should clean such project, I would create an abstract thread ancestor having Execute overriden and split into three virtual methods e.g. BeforeExecuteTask, AfterExecuteTask and abstract ExecuteTask.

I'd move COM (un)initialization into Before/After methods and delete all other occurencies (DRY). In each descendant I'd move code from the original Execute method to overriden ExecuteTask.

Answer 4

As far as Coinitialize and CoUninitialize would have to be counted per thread and CoUninitialize should not be called for counting as far as COM will be broken, you could use the following code for debugging.

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.

This

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

would be an example output of the following unit:

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.