我正在编写一个DLL（Delphi 2010），其中包含一个带有Stringgrid和RichView组件的表单。 DLL从主机应用程序获取数据，主机应用程序实际上是在paxCompiler引擎内运行的脚本。
DLL中的Stringgrid和RichView会在循环中不断刷新。 问题是，如果我们经常更新DLL表单上的组件（或只是等待一段时间），将发生访问冲突（c0000005）和/或应用程序崩溃。
即。如果我们写
if MilliSecondsBetween(Now, MyStart) > 10
而不是
if MilliSecondsBetween(Now, MyStart) > 500
应用程序会立即崩溃。延迟500毫秒，它可以工作一段时间，从几分钟到几个小时。
如果我们使用RichView组件，应用程序将崩溃得更快。 （我知道这是我的代码，而不是RichView。）它通常在崩溃之前说“画布不允许绘图”和“无效指针操作”。
如果我们将鼠标移动到RichView上一段时间，我们几乎肯定会遇到崩溃/ AV。这可能与重新绘制表单和鼠标光标有关。
我的大多数代码（在主机应用程序和内部dll中）都包含在try ... except子句中，但主机应用程序仍会崩溃。
这是一些代码。省略了代码的某些部分以简化阅读。 任何帮助将受到高度赞赏。
主机应用：
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 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.
答案 0 :(得分：2)
您正在通过访问主线程外部的VCL组件来破坏VCL线程规则。这是第一件要解决的问题。
可能会出现更多问题，但是您提供了大量代码，我不想对其进行全部调试。你有数据竞争似乎是合理的。数据类型和转换看起来有点可疑。
答案 1 :(得分：1)
好的，我终于找到了解决方案。特别感谢David Heffernan。以下代码对我来说非常适合：
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.
主持人申请：
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.