Newest questions tagged delphi - Stack Overflow

Can´t debug Delphi exception in RAD Studio

2026-07-30T14:31:59Z

I have some strange behavior of my IDE or Project.

Two projects, same code.

For example: to reproduce an exception, I declare stringlist and try to add string into it without creating a list.

procedure TForm1.Button1Click(Sender: TObject);
var
  sl: TStringList;
begin
  try
    sl.Add('bla');
  except
    on E: Exception do
    begin
      Memo1.Lines.Add(')))');
      raise Exception.Createfmt('Fehlermeldung', ['']);
    end;
  end;
end;

I place a debug breakpoint on

Memo1.Lines.Add(')))');

Project one: I click button, get only one notification from my IDE "access violation"

I click forward and it goes on to the debug point.

Project two: I do the same steps like in project one and it jumping over exception block. I click button, get notification from my IDE, click forward on notification and now I get infinity notifications over Debugger -Exception "EIntOverflow"... "Integeroverflow"

But only in debug mode, if I start the .exe, it works.

IDispatch::Invoke crashes server-side COM framework for basic IAccessible implementation for child count 1+ for IAccessible::get_accChildCount

2026-07-25T23:42:14Z

I'm trying to implement basic accessibility support for a custom GUI (server-side) - all GUI controls are custom/non-MS - via IAccessible. However, my COM framework keeps crashing. Even pure skeletal definitions crash.

The crash appears to be centered around IDispatch::Invoke(). Whenever IAccessible::get_accChildCount() is called and returns 1 or more for the child count, IDispatch::Invoke() is called thereafter and crashes the app. Even a bare "non-implemented" version of IDispatch crashes at Invoke(). The value for iid for Invoke() is also not IID_NULL.

I'm using "Accessibility Insights for Windows" and "Visual UIA Verify" as client apps to probe my app/test the COM framework.

I code in Borland Delphi 3 Professional (32-bit) using Object Pascal, and wish to implement the COM framework as pure binary vTables and standard COM functions using stdcall.

OleVariant seems unstable in Delphi 3. I have swapped it out for tcomvar (16 bytes for 32-bit and 24 bytes for 64-bit). I have tried various different function parameter definitions, higher-level object/interface definitions, even imported IAccessible using the "Import Type Library" function in Delphi 3, but all to no success. I even tried the COM framework in Borland Delphi 7 with no change, it still crashes.

I am new to COM, but understand the basic design principal governing its function.

However, everything I have tried to date has failed to fix the IDispatch::Invoke() error. I suspect it is something simple I have overlooked. But trying to get precise, accurate, and detailed information at this low level in Object Pascal from the Internet has been a real challenge.

I have tried Copilot and Google's AI extensively over days. Both are helpful, but lack the technical background and accuracy to get right down to the nitty gritty detail where it counts.

I could simply deny the request for the IID_IDispatch interface in QueryInterface(), but I suspect it is required for proper/broad client app support, e.g. scripting engines etc, and also, I'd like to understand what the error actually is, and what I have done wrong, so I can fix it.

I've included a stripped down demo version of the COM framework hooked to a standard TForm for the WM_GETOBJ message for testing purposes only.

Any help is much appreciated.

unit com1;

interface

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

type
  TForm1 = class(TForm)
  private
    procedure wmgetobj(var Message: TMessage); message wm_getobject;
  public

  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.wmgetobj(var Message: TMessage);
var
  m                  :twinmessage;
begin
  if not form1.showing then exit;

  m.r                   :=0;
  m.l                   :=message.lparam;
  m.w                   :=message.wparam;
  m.m                   :=message.msg;

  if auto__wmgetobject(nil,m) then message.result:=m.r;
end;

end.

unit com2;

interface

{$ifdef WIN64}{$define 64bit}{$endif}

uses sysutils;

const
  VT_EMPTY                     =0;
  VT_NULL                      =1;
  VT_I4                        =3;
  VT_DISPATCH                  =9;
  VT_BYREF                     =$4000;
  min32                        =-2147483647-1;
  max32                        = 2147483647;
  maxcore                      =999;//gui
  WM_GETOBJECT                 =61;
  OBJID_WINDOW                 =0;
  OBJID_CLIENT                 =-4;
  S_OK                         =$00000000;
  S_FALSE                      =$00000001;
  E_FAIL                       =$80004005;//10apr2026
  E_NOINTERFACE                =$80004002;
  E_INVALIDARG                 =$80070057;
  E_NOTIMPL                    =$80004001;//17jul2026
  DISP_E_BADINDEX              =$8002000B;
  DISP_E_MEMBERNOTFOUND        =$80020003;
  DISP_E_UNKNOWNNAME           =$80020006;
  DISP_E_UNKNOWNINTERFACE      =-2147352575;
  iid_null                     :tguid='{00000000-0000-0000-0000-000000000000}';
  iid_unknown                  :tguid='{00000000-0000-0000-C000-000000000046}';//IUnknown
  iid_dispatch                 :tguid='{00020404-0000-0000-C000-000000000046}';//automation/scripting interface (VB,office, etc)
  iid_accessible               :tguid='{618736E0-3C3D-11CF-810C-00AA00389B71}';//IAccessible
  ROLE_SYSTEM_APPLICATION      =14;
  ROLE_SYSTEM_OUTLINE          =35;
  ROLE_SYSTEM_PUSHBUTTON       =43;
  DISPATCH_METHOD              =1;
  DISPATCH_PROPERTYGET         =2;
  DISPATCH_PROPERTYPUT         =4;
  DISPATCH_PROPERTYPUTREF      =8;

type
  longint32                    =longint;
  longint64                    =comp;
  {$ifdef 64bit}
  iauto                        =longint64;
  hauto                        =longint64;
  {$else}
  iauto                        =longint32;
  hauto                        =longint32;
  {$endif}
  pauto                        =pointer;
  bstr                         =pauto;
  uint32                       =longint32;//32 bit only
  pwinmessage                  =^twinmessage;
  twinmessage                  =record//09jan2025

    m                           :iauto;
    w                           :iauto;
    l                           :iauto;
    r                           :iauto;

  end;

  pint64                       =^tint64;
  tint64                       =packed record
    case longint of

      0:(val:longint64);
      1:(cmp:comp);
      2:(cur:currency);
      3:(dbl:double);
      4:(bytes:array[0..7] of byte);
      5:(wrds:array[0..3] of word);
      6:(ints:array[0..1] of longint);
      7:(bits:set of 0..63);
      8:(datetime:tdatetime);

  end;

  pcomvar                      =^tcomvar;
  tcomvar                      =packed record

    vt                          :word;
    wreserved1                  :word;
    wreserved2                  :word;
    wreserved3                  :word;//8 bytes

    case longint32 of
      vt_i4                       :(i32:longint32);
      vt_dispatch                 :(dispatch:pauto);

      vt_byref or vt_i4           :(pi32:^longint32);
      vt_byref or vt_dispatch     :(pdispatch:^pauto);

      max32                       :(a:pauto;b:pauto);//8 bytes (32-bit) or 16 bytes (64-bit)

  end;

  tbasiccontrol                =tobject;//sample GUI control

  pautoslot                    =^tautoslot;
  tautoslot                    =record

    vtable                      :pauto;
    flist                       :array[0..28] of pauto;
    cok                         :boolean;
    c                           :tbasiccontrol;
    slot                        :longint32;

  end;

  pautoinfo                    =^tautoinfo;
  tautoinfo                    =record

    timer1000                   :longint64;
    active                      :boolean;
    lasttime                    :longint64;
    slotCount                   :longint32;//number of COM slots in use
    mcount                      :longint32;//message count -> "wmgetobject" requests
    qcount                      :longint32;//call count for "queryInterface"
    ucount                      :longint32;//call count for IUnknown
    dcount                      :longint32;//call count for IDispatch
    acount                      :longint32;//call count for IAccessible
    temp                        :longint32;

  end;

var
  auto_list                    :array[-1..maxcore] of tautoslot;//18jul2026
  auto_info                    :tautoinfo;

//automation procs
procedure auto__init;
function  auto__connect(const xcontrol:tbasiccontrol):longint32;
procedure auto__connectBySlot(const xcontrol:tbasiccontrol;const xslot:longint32);
procedure auto__disconnect(const xcontrol:tbasiccontrol;var xcontrolSlot:longint32);
function  auto__root(const xslot:longint32):pautoslot;
function auto__wmgetobject(const g:tobject;var m:twinmessage):boolean;

//support procs
function rollid32(var x:longint32):longint32;
function com__guidMatch(const s,d:tguid):boolean;
function com__makebstr(const x:string):pauto;
function bolstr(const x:boolean):string;
function low__cls(const x:pointer;const xsize:longint32):boolean;
procedure showbasic(const x:string);
function win____MessageBox(hWnd:hauto; lpText, lpCaption: PChar; uType: uint32): longint32; stdcall; external 'user32.dll' name 'MessageBoxA';
function win____LresultFromObject(const refiid:TGUID;wparam:iauto;punk:IUnknown):iauto;stdcall; external 'oleacc.dll' name 'LresultFromObject';
function win____DefWindowProc(hWnd: hauto; Msg: iauto; wParam: iauto; lParam: iauto): iauto; stdcall; external 'user32.dll' name 'DefWindowProcA';
function win____CoInitializeEx(pvReserved: pauto; coInit: Longint): hauto; stdcall; external 'ole32.dll' name 'CoInitializeEx';
function win____CoInitialize(pvReserved: pauto): hauto; stdcall; external 'ole32.dll' name 'CoInitialize';
function win____SysAllocString(x:pauto):pauto; stdcall; external 'oleaut32.dll' name 'SysAllocString';

//comvar procs
function comvar__ok(var x:tcomvar):boolean;
function comvar__vt(var x:tcomvar):longint32;
function comvar__i32OK(var x:tcomvar):boolean;
function comvar__i32(var x:tcomvar):longint32;
function comvar__i32b(var x:tcomvar;const xdefVal:longint32):longint32;
function comvar__dispatchOK(var x:tcomvar):boolean;
function comvar__dispatch(var x:tcomvar):pauto;
procedure comvar__init(var x:tcomvar);
procedure comvar__setnull(var x:tcomvar);
procedure comvar__setempty(var x:tcomvar);
procedure comvar__seti32(var x:tcomvar;const v:longint32);
procedure comvar__setDispatch(var x:tcomvar;const v:pauto);

implementation

uses forms, com1;

//automation procs
function auto__iunknown__addref(self:pauto):longint32;stdcall;
begin
  result             :=2;
end;

function auto__iunknown__queryinterface(self:pauto;const iid:tguid;out obj):longint32;stdcall;
begin
  rollid32( auto_info.ucount );

  if com__guidMatch( iid ,iid_unknown    ) or
     com__guidMatch( iid ,iid_dispatch   ) or
     com__guidMatch( iid ,iid_accessible ) then

  begin
    rollid32( auto_info.qcount );

    result             :=s_ok;
    pauto(obj)         :=self;
  end

  else begin
    result             :=e_nointerface;
    pauto(obj)         :=nil;
  end;

end;

function auto__iunknown__release(self:pauto):longint32;stdcall;
begin
  result                :=1;
end;

function auto__idispatch__GetTypeInfoCount(self:pauto;out count:longint32):longint32;stdcall;
begin
  rollid32(auto_info.dcount);
  result                :=E_NOTIMPL;
  count:=0;
end;

function auto__idispatch__GetTypeInfo(self:pauto;index,localeid:longint32;out typeinfo):longint32;stdcall;
begin
  rollid32(auto_info.dcount);
  result                :=E_NOTIMPL;
  pauto(typeinfo):=nil;
end;

function auto__idispatch__GetIDsOfNames(self:pauto;const IID:TGUID;names:pauto;nameCount,localeid:longint32;dispids:pauto):longint32;stdcall;
begin
  rollid32(auto_info.dcount);
  result                :=E_NOTIMPL;
end;

function auto__idispatch__Invoke(self:pauto;xdispid:longint32;const iid:tguid;localeid:longint32;flags:word;var Params;varresult:pcomvar; excepinfo,argerr:pauto ):longint32;stdcall;
begin
  rollid32(auto_info.dcount);
  result                :=E_NOTIMPL;

  //note: inbound "iid" should be "iid_null" but it's not
  if com__guidMatch(iid,iid_null) then
  begin
    //triggers a crash when "const" is removed from above function definition
  end;

  if (varresult<>nil) then
  begin
    varresult^.vt:=vt_null;//triggers a crash
  end;

  excepinfo   :=nil;
  argerr      :=nil;
end;

function auto__get_accParent(self:pauto;out ppdispParent:IDispatch):longint32;stdcall;
begin
  rollid32(auto_info.acount);
  result      :=s_ok;

  if (self=@auto_list[0]) then ppdispParent:=nil
  else                         ppdispParent:=idispatch( @auto_list[0] );

end;

function auto__get_accChildCount(self:pauto;out pcountChildren:longint32):longint32;stdcall;
begin
  rollid32(auto_info.acount);

  //simulate root control (auto_list[0]) with 10 children
  if (self=@auto_list[0]) then
  begin
    result                :=s_ok;
    pcountChildren        :=10;//triggers call to idispatch::invoke which crashes app
    end
  else begin
    result                :=E_NOTIMPL;
    pcountChildren        :=0;
  end;
end;

function auto__get_accChild(self:pauto;vChild:tcomvar;out ppdispChild:IDispatch):longint32;stdcall;
begin
  rollid32(auto_info.acount);

  case comvar__i32(vchild) of
    1..max32:begin
      result                :=s_ok;
      ppdispChild           :=idispatch( @auto_list[1] );
    end;

  else begin
      result                :=E_NOTIMPL;
      ppdispChild           :=nil;
    end;
  end;//case

end;

function auto__get_accName(self:pauto;vChild:tcomvar;out pszName:bstr):longint32;stdcall;
begin
  rollid32(auto_info.acount);
  result                :=s_ok;
  pszName               :=com__makebstr('control.name.'+inttostr(comvar__i32b(vchild,-999)));//25jul2026
end;

function auto__get_accValue(self:pauto;vChild:tcomvar;out pszValue:bstr):longint32;stdcall;
begin
  rollid32(auto_info.acount);
  result                :=DISP_E_MEMBERNOTFOUND;
  pszvalue              :=nil;
end;

function auto__get_accDescription(self:pauto;vChild:tcomvar;out pszDescription:bstr):longint32;stdcall;
begin
  rollid32(auto_info.acount);
  result                :=DISP_E_MEMBERNOTFOUND;
  pszDescription        :=nil;
end;

function auto__get_accRole(self:pauto;vChild:tcomvar;pvarRole:pcomvar):longint32;stdcall;
begin
  rollid32(auto_info.acount);
  result                :=E_INVALIDARG;

  if (pvarRole<>nil) then
  begin
    result             :=s_ok;
    comvar__seti32(pvarRole^,ROLE_SYSTEM_PUSHBUTTON);
  end;

end;

function auto__get_accState(self:pauto;vChild:tcomvar;out pvarState:pcomvar):longint32;stdcall;
begin
  rollid32(auto_info.acount);
  result                :=DISP_E_MEMBERNOTFOUND;//E_INVALIDARG;
  if (pvarState<>nil) then comvar__setempty(pvarState^);
end;

function auto__get_accHelp(self:pauto;vChild:tcomvar;out pszHelp:bstr):longint32;stdcall;
begin
  rollid32(auto_info.acount);
  result                :=DISP_E_MEMBERNOTFOUND;
  pszHelp               :=nil;
end;

function auto__get_accHelpTopic(self:pauto;out pszHelpFile:bstr;vChild:tcomvar;out pidTopic:longint32):longint32;stdcall;
begin
  rollid32(auto_info.acount);
  result                :=DISP_E_MEMBERNOTFOUND;
  pszHelpFile           :=nil;
  pidTopic              :=0;
end;

function auto__get_accKeyboardShortcut(self:pauto;vChild:tcomvar;out pszShortcut:bstr):longint32;stdcall;
begin
  rollid32(auto_info.acount);
  result                :=DISP_E_MEMBERNOTFOUND;
  pszShortcut           :=com__makebstr('Ctrl+F');//dummy value
  result                :=s_ok;
end;

function auto__get_accFocus(out pvarChild:pcomvar): longint32;stdcall;
begin
  rollid32(auto_info.acount);
  result                :=DISP_E_MEMBERNOTFOUND;

  if (pvarChild<>nil) then
  begin
    result             :=s_ok;
    comvar__seti32(pvarChild^,3);//return child 3 as focused
  end;

end;

function auto__get_accSelection(self:pauto;out pvarChildren:pcomvar):longint32;stdcall;
begin
  rollid32(auto_info.acount);
  result                :=DISP_E_MEMBERNOTFOUND;
end;

function auto__get_accDefaultAction(self:pauto;vChild:tcomvar;out pszDefaultAction:bstr):longint32;stdcall;
begin
  rollid32(auto_info.acount);
  result                :=s_false;
  pszDefaultAction      :=nil;
end;

function auto__accSelect(self:pauto;flagsSelect:longint32;varChild:tcomvar):longint32;stdcall;
begin
  rollid32(auto_info.acount);
  result                :=s_false;//or DISP_E_MEMBERNOTFOUND;
end;

function auto__accLocation(self:pauto;out pxLeft,pyTop,pcxWidth,pcyHeight:longint32;out varChild:pcomvar):longint32;stdcall;
begin
  rollid32(auto_info.acount);
  result                :=DISP_E_MEMBERNOTFOUND;
  pxLeft                :=0;
  pyTop                 :=0;
  pcxWidth              :=0;
  pcyHeight             :=0;
end;

function auto__accNavigate(self:pauto;navDir:longint32;varStart:tcomvar;out pvarEndUpAt:pcomvar):longint32;stdcall;
begin
  rollid32(auto_info.acount);
  result                :=s_false;//or DISP_E_MEMBERNOTFOUND;
end;

function auto__accHitTest(self:pauto;xLeft,yTop:longint32;out pvarChild:pcomvar):longint32;stdcall;
begin
  rollid32(auto_info.acount);
  result                :=s_false;//or DISP_E_MEMBERNOTFOUND;
end;

function auto__accDoDefaultAction(self:pauto;varChild:tcomvar):longint32;stdcall;
begin
  rollid32(auto_info.acount);
  result                :=DISP_E_MEMBERNOTFOUND;
end;

function auto__put_accName(self:pauto;varChild:tcomvar;const pszName:widestring):longint32;stdcall;
begin
  rollid32(auto_info.acount);
  result                :=E_NOTIMPL;//discontinued
end;

function auto__put_accValue(self:pauto;vChild:tcomvar;const pszName:widestring):longint32;stdcall;
begin
  rollid32(auto_info.acount);
  result                :=DISP_E_MEMBERNOTFOUND;
end;

//gui level procs
procedure auto__init;
var
  p                  :longint32;

begin

  //init -------------------------------------------------------------------------

  ismultithread:=true;
  win____CoInitialize(nil);

  low__cls( @auto_info ,sizeof(auto_info) );
  low__cls( @auto_list ,sizeof(auto_list) );

  auto__connectBySlot( nil ,-1 );//emergency fallback slot

  //make dummy controls
  for p:=0 to 99 do auto__connect( tbasiccontrol.create );

end;

function auto__connect(const xcontrol:tbasiccontrol):longint32;
var
  p                  :longint32;

begin

  //defaults
  result                :=-1;

  //check
  if (xcontrol=nil) then exit;

  //find existing
  for p:=0 to high(auto_list) do
  begin

    if auto_list[p].cok and (auto_list[p].c=xcontrol) then
    begin

      result             :=p;
      exit;

    end;

  end;//p

  //find new
  for p:=0 to high(auto_list) do
  begin

    if not auto_list[p].cok then
    begin
      result             :=p;
      break;
    end;

  end;//p

  //at capacity
  if (result=-1) then exit;

  //connect
  auto__connectBySlot( xcontrol ,result );

end;

procedure auto__connectBySlot(const xcontrol:tbasiccontrol;const xslot:longint32);
var
  findex                       :longint32;

  procedure fadd(const f:pauto);
  begin

    if ( findex <= high(auto_list[0].flist) ) then
    begin

      if (f<>nil) then
      begin

        auto_list[xslot].flist[ findex ] :=f;

        inc( findex );

      end;

    end

    else begin

      showbasic('Warning: COM function exceeds capacity for tautoslot');

    end;

  end;

begin

  //check
  if (xslot<low(auto_list)) or (xslot>high(auto_list)) then exit;


  //set root vars ----------------------------------------------------------------

  auto_list[xslot].c              :=xcontrol;
  auto_list[xslot].cok            :=(xcontrol<>nil);
  auto_list[xslot].slot           :=xslot;//25jul2025

  //add COM interfaces -----------------------------------------------------------

  //.unknown
  with auto_list[xslot] do
  begin

    vtable                          :=@flist[0];
    flist[0]                        :=@auto__iunknown__queryinterface;
    flist[1]                        :=@auto__iunknown__addref;
    flist[2]                        :=@auto__iunknown__release;
    findex                          :=3;

  end;

  //.dispatch
  fadd( @auto__idispatch__GetTypeInfoCount    );
  fadd( @auto__idispatch__GetTypeInfo         );
  fadd( @auto__idispatch__GetIDsOfNames       );
  fadd( @auto__idispatch__Invoke              );

  //.accessible
  fadd( @auto__get_accParent                  );
  fadd( @auto__get_accChildCount              );
  fadd( @auto__get_accChild                   );
  fadd( @auto__get_accName                    );
  fadd( @auto__get_accValue                   );
  fadd( @auto__get_accDescription             );
  fadd( @auto__get_accRole                    );
  fadd( @auto__get_accState                   );
  fadd( @auto__get_accHelp                    );
  fadd( @auto__get_accHelpTopic               );
  fadd( @auto__get_accKeyboardShortcut        );
  fadd( @auto__get_accFocus                   );
  fadd( @auto__get_accSelection               );
  fadd( @auto__get_accDefaultAction           );
  fadd( @auto__accSelect                      );
  fadd( @auto__accLocation                    );
  fadd( @auto__accNavigate                    );
  fadd( @auto__accHitTest                     );
  fadd( @auto__accDoDefaultAction             );
  fadd( @auto__put_accName                    );
  fadd( @auto__put_accValue                   );

end;

procedure auto__disconnect(const xcontrol:tbasiccontrol;var xcontrolSlot:longint32);
var
  p                  :longint32;

begin

  //check
  if (xcontrol=nil) then exit;

  //fast
  if (xcontrolSlot>=0) and (xcontrolSlot<=high(auto_list)) and (auto_list[xcontrolSlot].cok) and (auto_list[xcontrolSlot].c=xcontrol) then
  begin

    auto_list[xcontrolSlot].cok  :=false;
    auto_list[xcontrolSlot].c    :=nil;
    xcontrolSlot                 :=-1;
    exit;

  end;

  //slow
  for p:=0 to high(auto_list) do
  begin

    if auto_list[p].cok and (auto_list[p].c=xcontrol) then
    begin

      auto_list[p].cok   :=false;
      auto_list[p].c     :=nil;
      xcontrolSlot       :=-1;
      exit;

    end;

  end;

  //fallback
  xcontrolSlot          :=-1;

end;

function auto__root(const xslot:longint32):pautoslot;
begin
  if (xslot>=0) and (xslot<=high(auto_list)) and auto_list[xslot].cok then result:=@auto_list[xslot]
  else                                                                     result:=@auto_list[-1];//fallback
end;

function auto__wmgetobject(const g:tobject;var m:twinmessage):boolean;
begin

  //defaults
  result      :=false;

  //iaccessible
  if (m.l=OBJID_Window) then
  begin
    rollid32( auto_info.mcount );
    result   :=true;
    m.r      :=win____LresultFromObject( iid_accessible ,m.w ,iunknown( @auto_list[0] ) );
  end

  else if (longint32(m.l)=OBJID_CLIENT) then
  begin
    rollid32( auto_info.mcount );
    result   :=true;
    m.r      :=win____LresultFromObject( iid_accessible ,m.w ,iunknown( @auto_list[0] ) );
  end;

end;


//support procs
function rollid32(var x:longint32):longint32;//1..max32, never <=0
begin
  if      (x<=0)    then x:=1
  else if (x<max32) then x:=x+1
  else                   x:=1;

  result:=x;
end;

function com__guidMatch(const s,d:tguid):boolean;//18jul2026
begin
  result      :=
                ( s.d1    = d.d1    ) and
                ( s.d2    = d.d2    ) and
                ( s.d3    = d.d3    ) and
                ( s.d4[0] = d.d4[0] ) and
                ( s.d4[1] = d.d4[1] ) and
                ( s.d4[2] = d.d4[2] ) and
                ( s.d4[3] = d.d4[3] ) and
                ( s.d4[4] = d.d4[4] ) and
                ( s.d4[5] = d.d4[5] ) and
                ( s.d4[6] = d.d4[6] ) and
                ( s.d4[7] = d.d4[7] );
end;

function com__makebstr(const x:string):pauto;//COM basic string
var
  a        :widestring;
begin
  a           :=x;
  result      :=win____sysallocstring( pwidestring(a) );
end;

function bolstr(const x:boolean):string;
begin
  if x then result:='1' else result:='0';
end;

function low__cls(const x:pointer;const xsize:longint32):boolean;
begin
  result:=(x<>nil);
  if result then fillchar(x^,xsize,0);
end;

procedure showbasic(const x:string);
begin
  win____MessageBox( 0 ,pchar(x) ,'Information' ,$00000000+$40 );
end;

function comvar__ok(var x:tcomvar):boolean;
begin

  case x.vt of
    vt_empty                     :result:=true;
    vt_null                      :result:=true;
    vt_i4                        :result:=true;
    vt_i4 or vt_byref            :result:=true;
    vt_dispatch                  :result:=true;
    vt_dispatch or vt_byref      :result:=true;
  else                            result:=false;
  end;//case

end;

function comvar__vt(var x:tcomvar):longint32;
begin
  result                       :=x.vt;
end;

function comvar__i32OK(var x:tcomvar):boolean;
begin
  case x.vt of
    vt_i4                        :result:=true;
    vt_i4 or vt_byref            :result:=true;
  else                            result:=false;
  end;//case
end;

function comvar__i32(var x:tcomvar):longint32;
begin
  case x.vt of
    vt_i4                        :result:=x.i32;
    vt_i4 or vt_byref            :result:=x.pi32^;
  else                            result:=0;
  end;//case
end;

function comvar__i32b(var x:tcomvar;const xdefVal:longint32):longint32;
begin
  case x.vt of
    vt_i4                        :result:=x.i32;
    vt_i4 or vt_byref            :result:=x.pi32^;
  else                            result:=xdefVal;
  end;//case
end;

function comvar__dispatchOK(var x:tcomvar):boolean;
begin
  case x.vt of
    vt_dispatch                  :result:=true;
    vt_dispatch or vt_byref      :result:=true;
  else                            result:=false;
  end;//case
end;

function comvar__dispatch(var x:tcomvar):pauto;
begin
  case x.vt of
    vt_dispatch                  :result:=x.dispatch;
    vt_dispatch or vt_byref      :result:=x.pdispatch^;
  else                            result:=nil;
  end;//case
end;

procedure comvar__init(var x:tcomvar);
begin
  low__cls(@x,sizeof(x));
end;

procedure comvar__setnull(var x:tcomvar);
begin
  x.vt                         :=vt_null;
end;

procedure comvar__setempty(var x:tcomvar);
begin
  x.vt                         :=vt_empty;
end;

procedure comvar__seti32(var x:tcomvar;const v:longint32);
begin
  x.vt                         :=vt_i4;
  x.i32                        :=v;
end;

procedure comvar__setDispatch(var x:tcomvar;const v:pauto);
begin
  x.vt                         :=vt_dispatch;
  x.dispatch                   :=v;
end;

initialization
  auto__init;

end.

Delphi 13 , compile error using old source code with DUNITX

2026-07-01T11:52:31Z

I have moved my code over many Delphi versions - without any change on the code base .

The upgrade from Delphi 10.4 to Delphi 13 for my dunitx testcases failed :

Working code Delphi 10.4

assert.AreEqual(aList.Count, 3, 'Items count OK ?');

New Working code Delphi 13.1

assert.AreEqual<Integer>(aList.Count,Integer(3), 'Items count OK ?');

Did the Delphi compiler become worse ? ..... because the compiler cannot automatically determine the type parameter for the generic any longer ??

Has my previous old solution been wrong ?

Only final project in Project Group (bpg) runs correctly

2026-06-29T15:55:09Z

My Delphi project group (.bpg) has three projects:

PROJECTS = Proj1.exe Proj2.exe Proj3.exe

When loaded in the IDE, I can switch between (activate) projects. All projects build correctly and can be debugged. The EXEs can also be launched from outside the IDE.

The problem is the 'Run Without Debugging' option in the IDE. Only the final project (Proj3) is able to use 'Run Without Debugging'... all the others produce an error:

System Error. Code 2.The system cannot find the file specified.

I have tried the following:

Changed the order of projects in the .bpg. The result is the same: only the final project can use 'Run Without Debugging' - the others produce error code 2. Regardless of the order, all projects build correctly and can be debugged.
Closed the project group and loaded each project separately in their own IDE. The result is that all work correctly: build, can be debugged, and can use 'Run Without Debugging'.

Is this the only way around this problem?

Delphi IDE issue "no code formatting possible"

2026-06-28T14:17:24Z

I have a strange issue with a recent installation of Delphi 13: The functions "Format Source" and "Refactor" are disabled. What happened to my installation? Where can I fix this issue?

Screen dump: "Format Source Ctrl+D" is disabled in the context menu.

Possible Delphi Win64 Debugger Bug: Volatile registers (RCX/RDX) truncated to 32-bit after breakpoints under heavy multithreaded load

2026-06-23T13:52:22Z

I am developing a high-performance PS/PDF RIP workflow engine in Delphi (Win64 target). The rendering engine relies heavily on multithreading and custom assembly blocks (AVX/YMM instructions for RLE processing).

I recently encountered a severe “Heisenbug”: the application runs flawlessly in Release mode, “Run without debugging” (Ctrl+Shift+F9) or even “Run” (F9) in Debug mode. However, when breakpoints are used, stepping over certain breakpoints causes random, catastrophic Access Violations deep inside the assembly routines.

Since placing breakpoints altered the timing and masked the issue, I wrote a custom, nearly zero-overhead, lock-free logger using lock xadd and rdtsc instructions to time-stamp the event and dump raw CPU registers into a pre-allocated memory block without waking the OS thread scheduler.

What the lock-free logger revealed was shocking. Under heavy thread contention, if a thread hits a breakpoint and pauses, resuming it (F9) occasionally causes 64-bit parameter register corruption (RCX, RDX, etc.). This happened when I placed the breakpoint right on the place I called the virtual assembly routine from (logging immediately before the call, and at the very first line of the assembly routine).

For example, my logger captured RCX entering a routine as a valid 64-bit pointer:
PRE-BREAKPOINT: 00007FF49F698690

After the IDE paused on the breakpoint and I pressed F9 to resume, the immediate next instruction logged the exact same register as:
POST-BREAKPOINT: 000000009F698690

The upper 32 bits were completely zeroed out, effectively decapitating the pointer and causing an immediate access violation when dereferenced.

This likely does not happen in a simple, single-threaded test app. It only manifests under heavy CPU load, with dozens of threads actively rendering and allocating memory, and only after multiple iterations of hitting a breakpoint.

Such a decapitated CPU register strongly points to a possible registers’ restoration bug in Delphi. Moreover, I can’t see how a thread can affect other threads’ CPU data.

So, is this a known (or at least suspectable) architectural flaw in the Delphi 64-bit debugger's context restoration under stress? Or, Delphi is right here and there is rather a deeply obscure bug in my code?

Embarcadero® Delphi 13 Version 37.0.59082.6021 (32-bit)

How to find Google Drive's assigned letter?

2026-06-19T09:02:11Z

I have a Delphi program which needs to know Google Drive's drive letter. It appears that the default friendly name is "Google Drive", so I enumerate my drives and look for that text. This works, but this friendly name can be modified by the user.

How can I find Google Drive's drive letter more reliably? I searched the registry, but couldn't find the currently assigned drive letter (default, "G:\").

OS is Windows 11.

In Delphi, how to use the 'implements' directive with a generic interface type?

2026-06-16T11:17:29Z

I want to contain an interface instance inside a container instance while being able to:

synchronize lifetime
not alter the contained instance
be able to resolve the inner interface from the outer, and vice versa

The problem is that the implements directive does not support generic types. It gives this error:

interface type required

  IStoreOption = interface
    ['{FC40203E-104F-488D-B7B7-4B0D831F6150}']
    procedure Read(Value: IConnection);
    procedure Write(Value: IConnection);
  end;

  ITest = interface
    ['{84F0DD99-34C6-433D-9FA1-5DAB8BED3386}']
    procedure SayHello;
  end;

  TTest = class(TInterfacedObject, ITest)
  protected
    procedure SayHello;
  end;

  TStoreOption<T: IInterface> = class(TInterfacedObject, IStoreOption, T)
  private
    fValue: T;
  protected
    property Value: T read fValue implements T;
  public
    constructor Create(Value: T);
    procedure Read(Value: IConnection);
    procedure Write(Value: IConnection);
  end;

  function GetTest: ITest;
  begin
    var StoreOption := TStoreOption<ITest>.Create(TTest.Create) as IStoreOption;
    Supports(StoreOption, ITest, Result);
  end;

  procedure Save(Value: IInterface);
  begin
    var StoreOption: IStoreOption;
    if Supports(Value, IStoreOption, StoreOption) then
      StoreOption.Write(Connection);
  end;

  procedure RunTest;
  begin
    Save(GetTest);
  end;

How can I implement this correctly so it works?

How to migrate Indy to 64bit OpenSSL DLLs?

2026-06-08T17:09:39Z

I'm in the process of migrating my Delphi 12 apps from 32bit to 64bit. Currently I'm using Indy with the 32bit OpenSSL DLLs (libeay32.dll and ssleay32.dll).

When I change to 64bit and try to run the app, I get the 'Could not load SSL library' error. Then I went to GitHub to download 64bit versions of these DLLs from https://github.com/IndySockets/OpenSSL-Binaries.

Downloaded the file, but there are a lot of folders inside like:

openssl-1.0.2q-x64_86-win64
openssl-1.0.2r-x64_86-win64
openssl-1.0.2s-x64_86-win64

Tried to use the first one, but still get the same exception. Which one should I use? Even the DLLs inside the x64 folders have '32' in their name, so I'm confused.

AfterPost or AfterDelete

2026-06-05T11:56:53Z

I’m working with Delphi 10.4.2, VCL, FireDAC and EhLib.

In a real application, I have a TFDMemTable connected to EhLib data-aware controls, mainly TDBGridEh and TDBEditEh. The dataset is loaded from JSON, using CreateDataSet() / Append() / field assignment / Post(). During the JSON load I temporarily disable dataset events and restore them afterwards.

The issue is that in the application, in Release mode, the TFDMemTable fires BeforePost and BeforeDelete, but it does not fire AfterPost or AfterDelete. The same TFDMemTable does fire those After* events in an isolated test.

Some relevant details:

TFDMemTable
VCL application
Delphi 10.4.2
EhLib controls: TDBGridEh, TDBEditEh
Delete is triggered from TDataSetDelete / grid UI
UpdateOptions.AutoCommitUpdates = True
ResourceOptions.SilentMode = True
BeforePost fires
BeforeDelete fires
AfterPost does not fire
AfterDelete does not fire
In an isolated test, the events do fire

Is there any known interaction between EhLib data-aware controls and TFDMemTable that could prevent AfterPost / AfterDelete from being fired, or alter the dataset state/action flow in a way that skips those events?

Interlocked functions on unsigned variables

2026-06-04T15:49:10Z

what is the safe and correct way to atomically write unsigned variables using the Interlocked* functions or TInterlocked?

In the function below, are (A) and (B) fully atomic and threadsafe?
Or is (C) or (D) required?

procedure TForm1.Button3Click(Sender: TObject);
var
  tLastReload: UInt64;
begin
  TInterlocked.Exchange(Int64(tLastReload),1);  //A
  InterlockedExchange64(Int64(tLastReload),2);  //B

  TInterlocked.Exchange(PInt64(@tLastReload)^,3); //C
  InterlockedExchange64(PInt64(@tLastReload)^,4); //D
end;

DELPHI : [dcc64 Fehler] E1026 File not found : 'DUnitX.Loggers.GUI.VCL.dfm'

2026-06-04T13:27:15Z

I need some help getting my DUNIT testcases up and compiling again after the upgrade to DELPHI 11.

This is the top of my command-line testcase program; it is compiling and functional.

{$IFNDEF TESTINSIGHT}
{$APPTYPE CONSOLE}
{$ENDIF}{$STRONGLINKTYPES ON}
uses
  {$IFDEF TESTINSIGHT}
  TestInsight.DUnitX,
  {$ENDIF }
  System.SysUtils,
  DUnitX.Loggers.Console,
  DUnitX.Loggers.Xml.NUnit,
  //DUnitX.Loggers.GUI.VCL,
  DUnitX.TestFramework,

The GUI Version is basically the same, but here the unit : 'DUnitX.Loggers.GUI.VCL.dfm' is needed .

{$R *.res}
uses
  Vcl.Forms,
  System.SysUtils,
  DUnitX.Loggers.XML.NUnit,
  DUnitX.Test,
  DUnitX.TestFixture,
  DUnitX.TestFramework,
  DUnitX.TestResult,
  DUnitX.RunResults,
  DUnitX.TestRunner,
  DUnitX.Utils,
  DUnitX.WeakReference,
  DUnitX.Windows.Console,
  DUnitX.Loggers.Null,
  DUnitX.MemoryLeakMonitor.Default,
  DUnitX.AutoDetect.Console,
  DUnitX.ConsoleWriter.Base,
  DUnitX.Extensibility,
  DUnitX.Extensibility.PluginManager,
  DUnitX.FixtureProviderPlugin,
  DUnitX.FixtureResult,
  DUnitX.Generics,
  DUnitX.InternalInterfaces,
  DUnitX.IoC,
  DUnitX.Loggers.Console,
  DUnitX.CommandLine.OptionDef,
  DUnitX.CommandLine.Options,
  DUnitX.CommandLine.Parser,
  DUnitX.OptionsDefinition,
  DUnitX.Banner,
  DUnitX.FilterBuilder,
  DUnitX.Filters,
  DUnitX.CategoryExpression,
  DUnitX.TestNameParser,
  // DUnitX.Loggers.GUI.VCL,
  DUnitX.Timeout,
  DUnitX.Exceptions,
  DUnitX.ResStrs,

The compiler claims the unit has not been found. If I try to remove this unit, compilation fails here

Application.CreateForm(TGUIVCLTestRunner, GUIVCLTestRunner);

Q: how to fix my DUNITX installation , why is this unit not found

DELPHI : Working with many different monitor config's

2026-06-03T08:38:37Z

I'm using Delphi 11 and have upgraded from Delphi 10.4. Since the upgrade, I've noticed some very weird behavior in the Delphi IDE. Whenever I load a new project, the IDE shrinks to a minimized/tiny window (about 300 px × 50 px) on my monitor. I then have to click the maximize button (top-right) to restore it.

Moreover, some of the dialog windows do not match in size correctly, therefore the "OK" button is not visible and I can't use the function.

Additionally, Delphi always jumps to my first monitor, but I want Delphi to always stay on Monitor #2.

I have several physical workplaces, and each place has a different monitor configuration. In my home office, I have the laptop display and 2 additional 4K monitors with different resolutions.

I want Delphi always to open on monitor #2 and full window mode.

Possible race in TIdUDPServer.CloseBinding: listener thread keeps raw Binding reference while CloseBinding closes it before WaitFor

2026-06-03T02:50:21Z

I am investigating an intermittent AV during rapid TIdUDPServer.Active := False/True cycles in a Delphi 12.2 application.

The crash happens in the UDP close path, at:

TIdUDPServer.CloseBinding
  LListener.Binding.CloseSocket;

I checked the stock Indy source shipped with Delphi 12.2:

C:\Program Files (x86)\Embarcadero\Studio\23.0\source\Indy10\Core\IdUDPServer.pas

The relevant code has this ownership/order pattern:

procedure TIdUDPServer.CloseBinding;
begin
  LListenerThreads := FListenerThreads.LockList;
  try
    while LListenerThreads.Count > 0 do begin
      LListener := TIdUDPListenerThread(LListenerThreads[0]);

      LListener.Stop;
      LListener.Binding.CloseSocket;
      LListener.WaitFor;
      LListener.Free;
      LListenerThreads.Delete(0);
    end;
  finally
    FListenerThreads.UnlockList;
  end;
end;

The listener thread also touches the same binding from its own thread:

procedure TIdUDPListenerThread.AfterRun;
begin
  inherited AfterRun;
  FBinding.CloseSocket;
end;

The listener stores the binding as a raw object reference:

TIdUDPListenerThread = class(TIdThread)
protected
  FBinding: TIdSocketHandle;

TIdThread.Stop only sets the stopped/terminated state. It does not wait for the thread to finish. WaitFor is called only after LListener.Binding.CloseSocket.

So the ownership model seems to be:

TIdUDPServer.Bindings owns the TIdSocketHandle objects.
TIdUDPListenerThread stores a non-owning FBinding reference to one of them.
CloseBinding locks only the listener list, not the binding lifetime.
TIdSocketHandle.CloseSocket locks the socket handle fields of a live object, but it does not pin the lifetime of the TIdSocketHandle object itself.
The listener thread may still run AfterRun and touch FBinding while the owner thread is already in CloseBinding.

In an instrumented run I saw a listener that was created with a valid socket handle, then during shutdown its FBinding.Handle became a garbage value before the AV:

bind #0 handle=972
bind #1 handle=1084
listener #0 STARTED
listener #1 STARTED
CloseBinding -> listener #0
AfterRun: listener #0 closes handle=3145776
AV at LListener.Binding.CloseSocket

This does not look like a harmless double CloseSocket on the same live object. If both threads reached the same live TIdSocketHandle, FConnectionHandle inside TIdSocketHandle.CloseSocket should serialize the close. The problem appears to be that the listener's FBinding reference is no longer a coherent live binding object by the time shutdown code uses it.

Questions:

Is TIdUDPServer.CloseBinding intended to be safe under rapid Active := False / Active := True cycles?
Is the ordering in CloseBinding correct? In particular, should it call LListener.Binding.CloseSocket before LListener.WaitFor, while the listener thread can still execute AfterRun and use FBinding?
Is there an official Indy workaround? For example:
- avoid auto-created dual IPv4/IPv6 bindings and explicitly create one binding;
- never clear/change Bindings after activation;
- serialize Active changes externally;
- patch CloseBinding to stop/wake/wait in a different order.

Update

I investigated this further, and I think the original suspicion about TIdUDPServer.CloseBinding() was probably wrong.

The real issue in my code is most likely that I call TIdUDPServer.SendBuffer() from one thread while another thread controls the server lifecycle (Active := False/True, reconnect/shutdown).

In my application the UDP reader path can send packets, and the owner/runtime thread can also send packets and recreate the UDP server. I could not find a clear statement that all TIdUDPServer access has to be serialized by the application, or that SendBuffer() must not race with Active.

This small repro shows the part that surprised me:

program IndyUdpAvMvp;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  System.Classes,
  Winapi.Windows,
  IdGlobal,
  IdSocketHandle,
  IdUDPServer;

type
  TEvents = class
    procedure UDPException(AThread: TIdUDPListenerThread; ABinding: TIdSocketHandle;
      const AMessage: string; const AExceptionClass: TClass);
  end;

  TSender = class(TThread)
  protected
    procedure Execute; override;
  end;

var
  S: TIdUDPServer;
  Events: TEvents;

procedure TEvents.UDPException(AThread: TIdUDPListenerThread; ABinding: TIdSocketHandle;
  const AMessage: string; const AExceptionClass: TClass);
begin
  Writeln('OnUDPException: ', AExceptionClass.ClassName, ': ', AMessage);
end;

procedure TSender.Execute;
var
  B: TIdBytes;
begin
  SetLength(B, 1);
  Sleep(50);
  If not Terminated then
    S.SendBuffer('127.0.0.1', 54000, Id_IPv4, B);
end;

var
  T: TSender;

begin
  Events := TEvents.Create;
  S := TIdUDPServer.Create(nil);
  try
    S.DefaultPort := 54000;
    S.OnUDPException := Events.UDPException;
    S.Active := true;
    T := TSender.Create(false);
    try
      S.Active := false;
      T.WaitFor;
    finally
      T.Free;
    end;
    S.Bindings.ClearAndResetID;
    S.Binding.CloseSocket;
  finally
    S.Free;
    Events.Free;
  end;
end.

On my machine this raises:

Exception EAccessViolation in module IndyUdpAvMvp.exe ...
Read of address 0000000000000000

OnUDPException is not called.

My current understanding is:

TIdUDPServer.SendBuffer() is not just a passive send operation. It goes through Binding, and for TIdUDPServer accessing Binding may allocate and bind sockets and start listener threads.
Therefore, calling SendBuffer() after or during Active := False can effectively activate the server again.
So the correct fix on my side is to serialize SendBuffer() with server lifecycle changes, or avoid base TIdUDPServer.SendBuffer() in late-send paths and send only through an already-existing live binding.

Is this interpretation correct? In other words, should TIdUDPServer.SendBuffer() be treated as lifecycle-affecting and not safe to race with Active changes?

How to load Excel date cell

2026-05-20T11:06:41Z

I'm using OfficeXML4D library for Delphi and when I do something like this:

Sheet.Cell['F2'].AsDateTime := Now;

What happens is that the date will show 2096-05-20, instead of 2026-05-20.

I checked .AsDateTime, which is:

procedure TExcelCell.SetAsDateTime(const Value: TDateTime);
begin
  FDateTimeValue := Value;
  FFloatValue := Value + ExcelDateOffset;
  FCellType := TCellType.DateTime;
end;

So, the problem seems to be in:

FFloatValue := Value + ExcelDateOffset;

If I remove ExcelDateOffset, the date will be loaded just fine. Can anyone explain why this is like this and if it is ok to remove that from the code?

How to notify a (Spring4D) TObjectDataSet when a bound object property has changed

2026-05-11T15:42:18Z

The value shown in an attached grid is updated when using

  ObjectDataSet.FieldByName('Description').AsString:='Bob';

But not when calling

  ObjectDataSet.GetCurrentModel<TSaleLine>.Description:='Bob';

This is understandable as the TObjectDataSet is not monitoring the object properties and therefore unaware of the change.

I want to add onpropertychanged support to TObjectDataSet to monitor changes to the current model which will then in turn fire a DataEvent(deFieldChange,<field>) as the field change does but am unable to figure out how to trigger it.

I have tried the following but no dice.

type
  TL = class(TGridDataLink);

begin
  ObjectDataSet.GetCurrentModel<TSaleLine>.Description:='Bob';

  var G:=TGridDataLink.Create(Grid);
  TL(G).RecordChanged(ObjectDataSet.FieldByName('Description'));
  G.Free;
end;

How get screenshot of offscreen window?

2026-05-11T13:19:18Z

How to get a continuous screenshot of a window that is not visible on the screen (offscreen)?

I have the following code that initially seemed to work, but this got only the first frame (when the target window is updated, the screenshot still is the first frame). Are there other approaches to achieve this?

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function ActiveCaption: string;
var
  Handle: THandle;
  Len: LongInt;
  Title: string;
begin
  Result := '';
  Handle := GetForegroundWindow;
  if Handle <> 0 then
  begin
    Len := GetWindowTextLength(Handle) + 1;
    SetLength(Title, Len);
    GetWindowText(Handle, PChar(Title), Len);
    ActiveCaption := TrimRight(Title);
  end;
end;

procedure ScreenShotWindow;
var
  DC: HDC;
  wRect: TRect;
  Bmp: TBitmap;
  Width, Height: Integer;
  H: HWnd;
  title: array[0..MAX_PATH]of char;
begin
  H := FindWindow(nil, PWideChar(ActiveCaption));  
  if H = 0 then
    Exit;

  DC := GetWindowDC(H);
  try
    Bmp := TBitmap.Create;
    try
      GetWindowRect(H, wRect);
      Width := wRect.Right - wRect.Left;
      Height := wRect.Bottom - wRect.Top;
      Bmp.SetSize(Width, Height);
      BitBlt(Bmp.Canvas.Handle, 0, 0, Width, Height, DC, 0, 0, SRCCOPY);
      Form1.Canvas.Draw(0, 0, Bmp);
    finally
      Bmp.Free;
    end;
  finally
    ReleaseDC(H, DC);
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   ScreenShotWindow;
end;

end.

Edit:

I still have hope that it is possible, otherwise, I understood that it is a system limitation:

TWebBrowser.Silent = TRUE still shows "bad certificate" error

2026-05-06T10:46:28Z

I have a TWebBrowser with the .Silent property set to True, but it's still popping up the message

Revocation information for the security certificate for this site is not available. Do you want to proceed?

unit browsertest;

interface

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

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  self.WebBrowser1.Silent := True;
  self.WebBrowser1.Navigate('http://...');
end;

end.

How can I solve this so the popup doesn't appear? It must be done programatically, so editing Internet Preferences is out of question (as this is distributed to thousands of clients).

This message appears on some computers, but not in all of them.

Delphi + PAServer: How to correctly export iOS app with Notification Service Extension (appex) – missing provisioningProfiles in exportOptions.plist

2026-04-26T11:32:32Z

I’m deploying an iOS app built with Delphi (FMX) using PAServer. The app includes a Notification Service Extension (.appex).

The build succeeds, but the export step fails with:

error: exportArchive "NotificationService.appex" requires a provisioning profile.

Context

App structure:

MyApp.app/
  PlugIns/
    NotificationService.appex/

Bundle identifiers:

Main app: com.example.myapp
Extension: com.example.myapp.notificationservice

Both App Store provisioning profiles exist and are valid.

Problem

PAServer generates this exportOptions.plist:

<key>provisioningProfiles</key>
<dict>
  <key>com.example.myapp</key>
  <string>com.example.myapp</string>
</dict>

But the extension is missing. It should be:

<key>provisioningProfiles</key>
<dict>
  <key>com.example.myapp</key>
  <string>com.example.myapp</string>
  <key>com.example.myapp.notificationservice</key>
  <string>com.example.myapp.notificationservice</string>
</dict>

Without this, xcodebuild -exportArchive fails.

Question

Is there a way to make Delphi / PAServer include app extensions in exportOptions.plist?

Or is manually exporting with xcodebuild the only solution when using .appex extensions?

Generic TForm in hiearchy

2026-04-23T08:44:33Z

I'm building a fmx app in Delphi 12.2.

I would like to create a view hierarchy that includes a 3rd party generic TForm descendent. This 3rd party TForm does not have an fmx file. It does not appear in the list of inheritable items when I create a new fmx TForm.

TForm
T3rdPartyForm<T> = class(TForm) (no fmx file)
TViewBase<T> = class(T3rdPartyForm<T>)
TAppView1 = class(TViewBase<TAClass>)

I have created the hierarchy. It compiles and runs. TAppView1 has an .fmx file that I can edit in the IDE and which appears correctly at run time.

But, every time I start Delphi, I get 2 error messages:

Error creating form in View.Base.fmx: Error in module: Declaration of call TViewBase is missing or incorrect.

Error in module: Declaration of call TViewBase is missing or incorrect.

I also get the second message when I click the Design tab of TViewBase<T>. I don't know if the error is because T3rdPartyForm<T> is generic or because it has no .fmx file.

I would like to be able to edit TViewBase<T> in the IDE design editor so that its components, as well as its code, can be inherited. I would also like for code completion to work completely and correctly for all forms at the level of TAppView1, and to reduce the number of fake LSP errors I see when editing TAppView1 and its siblings. I think that all of this is impacted by the errors I am seeing.

How do I get the hierarchy I want without errors?

How to load a Delphi TService driver early?

2026-04-15T22:53:18Z

I am wondering what the best approach is to writing a Delphi service (using the TService class) to load my basic driver that simply writes a message to a file on disk. No network access is needed, or anything advanced.

I am unsure of the StartType setting and LoadGroup name I need to use. AI keeps suggesting a load group of "System Reserved" from a quick search, but I want better real-world advice from developers that have implemented Delphi TService apps that use early loading for executing a driver load.

I use ZwLoadDriver directly, in case this matters, as I don't use the Service Control Manager that is built-in to Windows.

Any suggestions for loading a very basic "Hello world!" driver from an early-started service?

Delphi, hooking TBitmap.Create & stack trace

2026-04-15T17:43:09Z

Posting this because I could not find an answer and code produced by two AIs I queried, would not compile. And when I did get it to compile it crashed at some point.

I needed to hook TBitmap.Create and log the calling function/procedure name. I did not parse the stack dump from madExcept

madExcept and DDetours is required.

I am using Delphi 10.2

Here is code to hook the constructor:

unit Main;

interface

uses
  Winapi.Windows,Winapi.Messages,System.SysUtils,System.Variants,System.Classes,Vcl.Graphics,Vcl.Controls,Vcl.Forms,Vcl.Dialogs,DDetours,Vcl.StdCtrls;

type
  TForm2 = class(TForm)
    CreateBitmapBtn: TButton;
    RemoveHookBtn: TButton;
    procedure CreateBitmapBtnClick(Sender: TObject);
    procedure RemoveHookBtnClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

procedure InstallTBitmapCreateHook;
procedure RemoveTBitmapCreateHook;

implementation

{$R *.dfm}

uses madStackTrace;

type
 TBitmapCreateFunc = function(self:TBitmap; DoAlloc:Boolean): TBitmap;

var
 TBitmap_Create_Hook:TBitmapCreateFunc = nil;

function Hook_TBitmap_Create(self:TBitmap; DoAlloc:Boolean):TBitmap;
var
 CallerName: string;
begin
 CallerName:=StackTrace;                        // Get call stack via madExcept
 ShowMessage(CallerName);
 result:=TBitmap_Create_Hook(self,DoAlloc);     // Call original constructor
end;

procedure TForm2.CreateBitmapBtnClick(Sender: TObject);
var
 bMap:TBitMap;
begin
 bMap:=TBitMap.Create;
 bMap.Free;
end;

procedure InstallTBitmapCreateHook;
begin
 TBitmap_Create_Hook:=InterceptCreate(@Vcl.Graphics.TBitmap.Create, @Hook_TBitmap_Create);
end;

procedure RemoveTBitmapCreateHook;
begin
 try
  InterceptRemove(@TBitmap_Create_Hook);
 finally
  TBitmap_Create_Hook:=nil;
 end;
end;

procedure TForm2.RemoveHookBtnClick(Sender: TObject);
begin
 RemoveTBitmapCreateHook;
end;

initialization
 InstallTBitmapCreateHook;

finalization
 RemoveTBitmapCreateHook;

end.

And here is code to hook AfterConstruction():

unit Main2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,DDetours;

type
  TForm3 = class(TForm)
    CreateBitmapBtn: TButton;
    RemoveHookBtn: TButton;
    Memo1: TMemo;
    procedure CreateBitmapBtnClick(Sender: TObject);
    procedure RemoveHookBtnClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

uses madStackTrace;

type
 TAfterConstructionProc = procedure(Self: TBitmap);

var
 Trampoline_TBitmap_AfterConstruction: TAfterConstructionProc = nil;

procedure Intercept_TBitmap_AfterConstruction(Self: TBitmap);
var
 CallerName: string;
begin
 CallerName:=StackTrace;                        // Get call stack via madExcept
 if Assigned(Form3) and Assigned(Form3.Memo1) then
  Form3.Memo1.Lines.Add(CallerName);

 if Assigned(Trampoline_TBitmap_AfterConstruction) then
  Trampoline_TBitmap_AfterConstruction(Self);
end;

procedure InstallBitmapHook;
begin
 if not Assigned(Trampoline_TBitmap_AfterConstruction) then
  begin
   @Trampoline_TBitmap_AfterConstruction:=InterceptCreate(@TBitmap.AfterConstruction,
                                                          @Intercept_TBitmap_AfterConstruction);
  end;
end;

procedure RemoveBitmapHook;
begin
 if Assigned(Trampoline_TBitmap_AfterConstruction) then
  begin
   InterceptRemove(@Trampoline_TBitmap_AfterConstruction);
   Trampoline_TBitmap_AfterConstruction:=nil;
  end;
end;

procedure TForm3.CreateBitmapBtnClick(Sender: TObject);
var
 bMap:TBitMap;
begin
 bMap:=TBitMap.Create;
 bMap.Free;
end;

procedure TForm3.RemoveHookBtnClick(Sender: TObject);
begin
 RemoveBitmapHook;
end;

initialization
 InstallBitmapHook;

finalization
 RemoveBitmapHook;

end.

THTTPRio Authorization Bearer

2026-04-09T10:27:20Z

I'm using Delphi Tokio 10.2.3 and using a THTTPRIO component to consume a SOAP webservice.

I need/must use Bearer token authentication on the request, because the service was changed from basic authentication (username/password) to bearer token.

How can I set/add the token to the header request using THTTPRIO?

How to implement a scoped context in Spring4D?

2026-04-07T15:49:32Z

I want to be able to register a scoped singleton which would work like TSingletonPerThreadLifetimeManager does, but is freed when it goes out of scope.

I want to have the ability to treat certain objects as singletons within the context of a scope.

In the example below, Context is used by both TTest and TSub. I would want them to both point to the same instance, but be unaware that the other one is using it.

type
  TSub = class(TInterfacedObject, ISub)
  public
    constructor Create(Context: IContext);
  end;

  TTest = class(TInterfacedObject, ITest)
  public
    constructor Create(Context: IContext; Sub: ISub);
  end;

Container.RegisterType<IContext,TContext>.AsScoped;
Container.RegisterType<ITest,TTest>.AsTransient;
Container.RegisterType<ISub,TSub>.AsTransient;

var Scope:=TScope.New;
try
  var test:=Container.Resolve<ITest>();
  test.execute;
finally
  Scope:=nil;
end;

Ideally, I would not want to reference the container inside the scope, but process a passed in dynamic factory, such as:

procedure DoInScope(TestFactory: Func<ITest>);
begin
  var Scope:=TScope.New;
  try
    TestFactory().Execute;
  finally
    Scope:=nil;
  end;
end;

I had a look at TSingletonPerThreadLifetimeManager, but was unable to figure out how to trigger the references to be freed at the end of scope.

Another option I can think of is to use a delegate, such as:

Container.RegisterType<IContext,TContext>.DelegateTo(
  function: IContext
  begin
    if TScope.InScope then
    begin
      if not TScope.Has<IContext> then
        TScope.Add<IContext>(Container.Resolve<IContext>); // wont work as recursive
      Result:=TScope.Get<IContext>;
    end;
  end
);

Bad DFM streaming of a TForm displayed in CEF4Delphi TChromium.OnDownloadUpdated event

2026-04-01T08:57:50Z

I have a project using CEF4Delphi that uses a custom Open/Save dialog when downloading a file.

This is the event when I create the custom form

procedure TMainForm.ChromiumDownloadUpdated(Sender: TObject;
  const browser: ICefBrowser; const downloadItem: ICefDownloadItem;
  const callback: ICefDownloadItemCallback);

var
  FileIcon: TIcon;
  Descripcion: string;
  originalFilename: string;
  openSaveForm: TOpenSaveForm;
begin
  else if downloadItem.IsComplete then
  begin
    FileIcon := TIcon.Create;
    openSaveForm := TOpenSaveForm.Create(Self);
    try
      try
        openSaveForm.LabelFilename.Caption := OpenSaveFormCaptionMsg(originalFilename, downloadItem.ReceivedBytes);
        GetFileIconAndDescription(downloadItem.GetFullPath, FileIcon, Descripcion);
        openSaveForm.RadioButtonOpen.Caption := openSaveForm.RadioButtonOpen.Caption + ' ' + Descripcion;
        openSaveForm.FileIcon.Picture.Icon := FileIcon;
        if openSaveForm.ShowModal = mrOk then
          ChooseShowSaveDialog(downloadItem.GetFullPath, openSaveForm.RadioButtonSave.Checked);
      except
        on E: Exception do
          ShowMessage('Excepcion opensaveform: ' + E.Message);
      end;
    finally
      openSaveForm.Free;
      FileIcon.Free;
    end;
  end;
end;

This form normally appears like this:

But somethimes the DFM streaming fails and the form appears broken:

If I inspect the properties of the buttons, labels, etc they have Width=0, Left=0, etc, just after being created and before calling OnShow.

Migrating Delphi application to .NET: Framework 4.8 vs .NET 6+ for COM/Hydra interop

2026-03-31T06:39:21Z

We're planning a phased migration of a large Delphi application to C#/.NET. The migration strategy involves:

Running Delphi and C# side-by-side during transition (12-24 months)
Using RemObjects Hydra (or COM interop) for Delphi ↔ C# communication
Gradually replacing Delphi modules with C# equivalents

Our dilemma: Should we target .NET Framework 4.8 initially or go directly to modern .NET (6/8/10)?

Option A: .NET Framework 4.8 → Later upgrade

Pros:

Well-documented Delphi interop patterns
Proven Hydra support
Lower risk during pilot phase

Cons:

Requires migration to modern .NET later
Creates temporary technical debt
Double deployment/testing effort

Option B: Modern .NET (6/8/10) directly

Pros:

No framework upgrade needed later
Future-proof from day one
Single migration path

Cons:

Less documented interop scenarios
Potential runtime hosting issues with Delphi
Unknown deployment complexities

Specific Technical Questions:

Has anyone successfully used RemObjects Hydra or COM interop between Delphi and .NET 6+? What issues did you encounter?
Are there known blockers for Delphi ↔ modern .NET interop that would force us to use .NET Framework 4.8?
What are the key technical differences in hosting/interop between .NET Framework 4.8 and .NET 6+ that would affect a Delphi bridge?

Environment:

Delphi version: 13
Windows desktop application
Enterprise deployment
Gradual module-by-module replacement strategy

Highlight cells in TCalendar

2026-03-27T16:31:08Z

Is there any way to highlight various non-contiguous cells in Delphi's TCalendar component at the same time? And not only the actual day?

I need to let the user mark different days in different cells, not necessarily contiguous. Either the text or the background, or both, with a different color than the color of non-marked cells.

I am using Delphi 12.3.

How to convert Delphi .pas "format ANSI" files to .pas "format UTF" files? (We are starting to use Cursor IDE on Delphi projects)

2026-03-25T11:26:22Z

We have developed Delphi projects in Lithuanian (Baltic) local Windows machines and our Delphi *.pas files have been in "format ANSI" and they, of course, contained Lithuanian constants as well.

Now we are starting to use Cursor IDE (+ the best models, like Claude Opus 4.6 Max or any other top model) to make AI developement on the codebase, but Cursor IDE + models are totally incapable to handle ANSI Lithuanian files. Cursor + models get confused and overwrites and overwrites Lithuanian texts and complete mess is the sole result. The opening of *.pas files with relevant encoding in Cursor IDE is not helping. The prompts are not helping either - models become unmanageable with this respect.

So - I start the pratice to convert *.pas file from ANSI to UTF8 format - Delphi editor offers command "Right click - File Format..." and there is menu to change the format. This conversion worked as far as AI is concerted - the Cursor IDE + models are able to program such files perfectly.

But if the UTF8 format *.pas files contains string constants with Lithuanian values and those constants are used in the legacy ANSI format *.pas file code, then Strings in both files are incompatible. Even worse, IBX components, that wrote those Lithuanina values into UTF-8 Firebird database perfectly, now are writing complete mess.

So - there is no other option, than to convert and retest all the *.pas files into UTF8 format. But how to do that conversion? Only working way is to do that manually from the Delphi IDE. I have not find any other way. Delphi IDE definition of ANSI/UTF8 file formats are somehow strange, because - if Cursor IDE is asked to detected them, then it decides that there are no BOMs etc. and gets confused. So - how to handle this conversion?

How to change the background color of a TButton component with code in Delphi FMX?

2026-03-21T10:54:48Z

I've been tasked to dynamically style buttons to be different colors with Delphi code in FMX

I want a red TButton component. My first thought was to use a TRectangle instead of a TButton, but then my boss said that he doesn't want the components to be changed to something else because we have too many TButton components already and I should find a way to make it work with TButton.

We get the colors from the database and now I need to fill the button with those colors. A coworker suggested I try something like this and he sent this code:

begin
  var Obj := Button1.FindStyleResource('background');

  if Obj is TRectangle then
    TRectangle(Obj).Fill.Color := TAlphaColorRec.Red;
end;

That however didn't work at all. He suggested some other similar exampled code that I tried and also didn't work. I also tried going back and forth with AI and my coworker's code, but nothing worked. My coworkers as well as AI seems convinced that this is possible, but I just can't get it to work.

I am open to any suggestions or methods as long as it the component stays a TButton and as long as the color is changed via code during run-time.

delphi Data.DBXEncryption unit exception integer overflow

2026-03-21T01:26:53Z

Delphi 10.2.3
Windows 10 with all current updates

I am suddenly getting this exception in Unit Data.DBXEncryption function TPC1Cypher.Code(const I: Integer): Integer;

Overflow occurs in the line below in Delphi's unit and function given above:

if Ax <> 0 then  
   Ax := Ax * Bx;

The above code is directly from Delphi's unit and function, unaltered. I have not altered this code. The values for Ax and Bx are calculated within the function call itself.

Because of this overflow username and password won't validate where they had been. Note: I had to reinstall some delphi 10.2.3 and TMS units after I mucked about in System.Classes (I know!) returning it to its original state. I have not altered any other units (ie DBXEncryption, etc.)

Any insight and help is appreciated! This code below is directly copied from Delphi's unit... It would be best if you have Delphi's source code available to view this unit. Thank you and good luck!

function TPC1Cypher.Code(const I: Integer): Integer;
    var
      Dx: Integer;
      Ax: Integer;
      Cx: Integer;
      Bx: Integer;
      Tmp: Integer;
    begin
      Dx := FX1a2 + I;
      Ax := FX1a0[I];
      Cx := 346;
      Bx := 20021;
      Tmp := Ax;
      Ax := FSi;
      FSi := Tmp;
      Tmp := Ax;
      Ax := Dx;
      Dx := Tmp;
      if Ax <> 0 then
        Ax := Ax * Bx;  <==== this causes overflow crashing the app
      Tmp := Ax;
      Ax := Cx;
      Cx := Tmp;
      if Ax <> 0 then
        begin
          Ax := Ax * FSi;
          Cx := Cx + Ax;
        end;
      Tmp := Ax;
      Ax := FSi;
      FSi := Tmp;
      Ax := Ax * Bx;
      Dx := Dx + Cx;
      IncrAfter(Ax);
      FX1a2 := Dx;
      FX1a0[I] := Ax;
      Result := Ax xor Dx;
    end;

After further work, I have the following:

Integer overflow is occurring in

  unit Data.DBXEncryption
  function TPC1Cypher.Code(const I: Integer): Integer; 
 
  // lines (as above)..

  if Ax <> 0 then
    Ax := Ax * Bx;  <==== overflow exception raised in main app, NOT in simple app.

The TSQLConnection component is generating an integer overflow error in the above module and code when setting the SQLConnection connected property to True.

To verify the error, I created a small simple app that makes the same calls as my main app.

I verified the SQLConnection properties and parameters between the simple app and the main app are identical.

This simple app runs without error. I checked its project options and Overflow checking was off.

Now I checked the project options for my main app and found Overflow checking was true, or on.

So naturally I thought this was the issue, so I set this to off (false)

Ran my main app with this option change, and I still received the Integer overflow error!

Stepping through the code of the simple app, execution continues through the line noted above without error, Ax := Ax * Bx.

Stepping through the code of the main app, execution is aborted at the line Ax := Ax * Bx with overflow error.

So now I added the directive {$Q} to my main app and still get the overflow error. I've searched my files, and nowhere do I see an option to set overflow checking on other than in Project Options, where it is now off.

I'm baffled.