Form in Delphi DLL causes access violations and/or crashes when updated in a loop

Question

I'm writing a DLL (Delphi 2010) which contains a form with a Stringgrid and a RichView component. The DLL obtains data from a host app, which is actually a script running inside a paxCompiler engine.

The Stringgrid and RichView inside the DLL are constantly refreshed in a loop. The problem is that, if we update the components on a DLL form too often (or just wait for a while), an access violation (c0000005) will happen and/or the app will crash.

I.e. if we write

if MilliSecondsBetween(Now, MyStart) > 10

istead of

if MilliSecondsBetween(Now, MyStart) > 500

the app will crash instantly. With 500 ms delay it will work for some time, from several minutes to several hours.

If we use the RichView component, the app will crash much faster. (I know it's my code, not RichView.) It usually says 'canvas does not allow drawing' and 'invalid pointer operation' before it crashes.

If we move mouse over the RichView for a while we will almost definitely get a crash/AV. This may be somehow related to repainting of the form and mouse cursor.

Most of my code (both in host app and inside dll) is wrapped in try...except clauses, but the host app crashes anyway.

Here's some code. Some parts of the code are omitted to simplify reading. Any help will be highly appreciated.

Host app:

uses Forms, StdCtrls, SysUtils, Classes;

type
  TMyEvents = class(tobject)
    procedure MyButtonClick (Sender : tobject);
  end;

type
  TMyForm = class(TForm)
  private
  protected
  public
  end;

type
  TDataInfo = packed record
    Data1 : string[16];
    Data2: string[16];
    Data3: string[16];
  end;

type
  TDataArray = Array [0..1999] of TDataInfo;
type
  PDataArray = ^TDataArray;

var MyForm : TForm;
  MyButton : TButton;
  MyEvents : TMyEvents;
  initForm : boolean;

  A : TDataArray;
  PA : PDataArray;


procedure CreateDllForm; register; external 'FormDLL.dll';
procedure ShowDllForm; register; external 'FormDLL.dll';
procedure WriteHandle (S : PCardinal); register; external 'FormDLL.dll';
procedure ExportedProc1 (X1 : PDataArray; Y1 : Cardinal); register; external 'FormDLL.dll';
procedure ExportedProc2; register; external 'FormDLL.dll';
procedure DestroyDllForm; register; external 'FormDLL.dll';


procedure MainProc;
  begin

    MyEvents := TMyEvents.Create;

       // ********************************************
       // THIS FORM IS AUXILARY AND WE DON'T ACTUALLY USE IT.
       // IT IS NEEDED ONLY TO PROVIDE CORRECT BEHAVIOUR OF THE MAIN DLL FORM, 
       // ********************************************

    MyForm := TMyForm.Create (nil);
    MyForm.Caption := 'Form from script';

    MyButton := TButton.Create (MyForm);
    MyButton.Show;
    MyButton.Top := 50;
    MyButton.left := 50;
    MyButton.Width := 200;
    MyButton.Height := 21;
    MyButton.Parent := MyForm;
    MyButton.Caption := 'Press me';
    MyButton.OnClick := MyEvents.MyButtonClick;

    MyForm.Show;
  end;


       // ********************************************
       // THE AUXILARY FORM CONTAINS ONLY 1 BUTTON,
       // WHICH TRIGGERS THE MAIN DLL FORM.

       // AFAIK, THIS WAS DONE TO GUARANTEE THAT
       // THE MAIN DLL FORM RUNS FROM THE MAIN THREAD.
       // ********************************************

procedure TMyEvents.MyButtonClick (Sender : tobject);
  var hWnd : PCardinal;
  begin
    try
      CreateDllForm;   
      ShowDllForm;     

      initForm := true;

      hWnd := PCardinal (MyForm.Handle);   
      WriteHandle (hWnd);                  
     except                     
      print ('error');
    end;    
  end;  

procedure OnFree; //Free all objects we've created
  begin
    if assigned (MyButton) then
    begin MyButton.Free end;
    if assigned (MyForm) then
    begin MyForm.Free end;
    if assigned (MyEvents) then
    begin MyEvents.Free end;

    DestroyDllForm;
  end;



procedure UpdateGrid;
var i, CurrentCount, iCounter : integer;
  begin
    while (true) do
    begin
      Delay (100);
      if (initForm = true) then
      begin
        for i := 0 to CurrentCount do
        begin
           // some code
        end;
        iCounter := i;
        try
        ExportedProc1(@A[0], iCounter);    
        except
          print ('error writing to grid');
        end;
      end;
    end;
  end;

procedure UpdateRV;
var i: integer;
begin
  try
    while (true) do
    begin
      Delay (100);
      if (initForm = true) then
        begin
         ExportedProc2;
        end;
    end;
  except
    print ('error writing rv');
  end;
end;

begin
  initForm := false;
  Script.MainProc (@MainProc);
  Script.NewThread (UpdateGrid);
  Script.NewThread (UpdateRV);
  Delay (-1);
end.

DLL:

library FormDll;

uses
  DateUtils,
  Dialogs,
  Windows,
  Forms,
  SysUtils,
  Classes,
  Grids,
  Controls,
  FormDllUnit in 'FormDllUnit.pas' {CustomForm};

{$R *.res}

type
  MyMessage = packed record
    Msg: Cardinal;
    MsgText: Widestring ;
    Result : LongInt;
  end;

type
  TDataInfo = packed record
    Data1 : string[16];
    Data2: string[16];
    Data3: string[16];
  end;

type
  TDataArray = Array [0..1999] of TDataInfo;
type
  PDataArray = ^TDataArray;

var
A: TDataArray;
MyStart: TDateTime;
MyTargetersStart: TDateTime;
myCount : integer;


procedure CreateDllForm; register; export;
begin
  CustomForm := TCustomForm.Create(nil);
  SetThreadLocale(GetSystemDefaultLCID);
  GetFormatSettings;
end;

procedure ShowDllForm; register; export;
begin

  CustomForm.Show;

// we initialize some variables here
// initializing stringgrid
end;

procedure WriteHandle(S: PCardinal); register; export;
begin
  AppHandle:=Cardinal(S);
end;


procedure ExportedProc1(myArray: PDataArray; iCount: Cardinal); register; export;
var 
   i : cardinal;
   //some more variables
begin

if MilliSecondsBetween(Now, MyStart) > 500 then begin

myCount := iCount;
MyStart := Now;

  CustomForm.PlayersGrid.Rows[1].BeginUpdate;

    for i := 0 to CustomForm.PlayersGrid.ColCount - 1 do  begin
      CustomForm.PlayersGrid.Cols[i].Clear;
    end;

     // filling array A with PDataArray data from host application
     // QuickSort(A, 0, iCount -1);

   for i := 0 to iCount - 1 do begin
     //filling stringgrid with values from array A
  end;

//some code

CustomForm.PlayersGrid.Rows[1].EndUpdate;

end;

end;


procedure DestroyDllForm; register; export;
begin
  FreeAndNil(CustomForm);
end;


procedure ExportedProc2; register; export;
var x: integer;

begin
if MilliSecondsBetween(Now, MyTargetersStart) > 500 then
begin
  MyTargetersStart := Now;
  CustomForm.RichView1.Clear;
    for x := 0 to myCount-1 do
    begin
      //filling RichView1 with values from array A
    end;
  CustomForm.RichView1.Format;
end;
end;

exports
CreateDllForm,
ShowDllForm,
WriteHandle,
ExportedProc1,
ExportedProc2,
DestroyDllForm;

end.

DLL unit:

unit FormDllUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, AppEvnts, ComCtrls, ExtCtrls,
  RVScroll, RichView, RVStyle, DateUtils, Grids;

type
  TCustomForm = class(TForm)
    RVStyle1: TRVStyle;
    RichView1: TRichView;
    PlayersGrid: TStringGrid;

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure PlayersGridMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PlayersGridDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure PlayersGridSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);

  private
  public
    { Public declarations }
  end;

var
  CustomForm: TCustomForm;
  AppHandle: HWND;

implementation

{$R *.dfm}

procedure TCustomForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  SendMessage(AppHandle,WM_CLOSE,0,0);
end;


procedure TCustomForm.PlayersGridDrawCell(Sender: TObject; ACol,
  ARow: Integer; Rect: TRect; State: TGridDrawState);
var r: TRect;

begin
With TStringGrid(Sender),TStringGrid(Sender).Canvas Do
Begin
  //drawing cells with custom colors etc.
End;
end;

procedure TCustomForm.PlayersGridMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  //some code
end;

procedure TCustomForm.PlayersGridSelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
begin
  //some code
end;

end.

Answer 1

You are breaking VCL threading rules by accessing VCL components outside the main thread. That's the first thing to fix.

There may well be more problems but you presented a lot of code and I for one don't want to debug it all. It does seem plausible that you have data races. And the data types and casting look a bit dubious.

Answer 2

Ok, I've finally found out the solution. Special thanks to David Heffernan. The following code works perfectly for me:

DLL:

procedure ShowDllForm; stdcall; export;
begin
  if CustomForm = nil then
  CustomForm := TCustomForm.Create(nil);
  CustomForm.Show;
end;

procedure ProcessFormMessages; stdcall; export;
begin
  Application.ProcessMessages;
end;

function FormShowing: Boolean; stdcall; export;
begin
  if CustomForm <> nil then
    Result := CustomForm.Showing
  else
    Result := False;
end;

procedure DestroyDllForm; stdcall; export;
begin
  FreeAndNil(CustomForm);
end;

exports
 ShowDllForm,
 ProcessFormMessages,
 FormShowing,
 DestroyDllForm;
end.

Host application:

procedure ShowDllForm; stdcall; external 'FormDLL.dll';
procedure DestroyDllForm; stdcall; external 'FormDLL.dll';
procedure ProcessFormMessages; stdcall; external 'FormDLL.dll';
function FormShowing: Boolean; stdcall; external 'FormDLL.dll';

procedure MainProc;
begin
  ShowDllForm;
  try
    repeat
      begin
        Delay(100);
        ProcessFormMessages;
      end;
    until not FormShowing;
  except
    print('error');
  end;
end;

procedure OnFree;
  begin
    DestroyDllForm;
  end;

begin
  Script.MainProc(@MainProc);
  Delay (-1);
end.