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.
Comments are closed.