Delphi DLL中的表单在循环中更新时会导致访问冲突和/或崩溃

时间:2014-04-21 17:39:16

标签: delphi dll vcl

我正在编写一个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.

2 个答案:

答案 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.