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.
