Determining ThreadingModel in a Delphi Application

I has occurred to me that someone might need to determine their COM threading model from inside their application. This could be useful for some ASSERT() code or perhaps as part of a unit test. From my last blog post, you’ll recall that this information is stored in an opaque structure located in each thread’s Thread Environment Block (TEB). Actually quite simple to do, with original credit going to John Robbins’ Bugslayer Column from the old MSJ magazine.

{
uses ActiveX;
Ported from John Robbins - Microsoft Systems Journal Bugslayer Column - October '99
http://www.microsoft.com/msj/1099/bugslayer/bugslayer1099.aspx
}
function DebugCoGetThreadingModel : integer;
const
  OLE_APT_MASK  = $0080;
  OLE_FREE_MASK = $0140;
var
  dwOLETLS: Cardinal;
  dwFlags:  Cardinal;
begin

  asm
    // Get TEB
    mov eax, FS:[018h]
    mov eax, [eax+0f80h]
    mov dwOLETLS, eax
  end;

  { Not initialized }
  if dwOLETLS = 0 then begin
    Result := -1;
    exit;
  end;

  dwFlags := PCardinal((dwOLETLS + $0C))^;

  if ((dwFlags and OLE_APT_MASK) = OLE_APT_MASK) then
    Result := COINIT_APARTMENTTHREADED

  else if ((dwFlags and OLE_FREE_MASK) = OLE_FREE_MASK) then
    Result := COINIT_MULTITHREADED

  { Unknown }
  else
    Result := -2;
end;

And some sample usage code

  case DebugCoGetThreadingModel of
    -2: Label1.Caption := 'Unknown';
    -1: Label1.Caption := 'Not initialized';
    COINIT_APARTMENTTHREADED: Label1.Caption := 'COINIT_APARTMENTTHREADED';
    COINIT_MULTITHREADED: Label1.Caption := 'COINIT_MULTITHREADED';
  end;

John also has an excellent blog of his own which is which is a fantastic low-level technical resource. Speaking of old magazines, I just discovered the Bug of the Month ad that has appeared in Dr Dobbs for nearly the past 20 years has an online archive. Head over to Gimpel Software if you’re up for some C-based brain exercises.