دخول

SMP3 · 02-09-2013, 12:22 PM

و عليكم السلام
المشكل أنك تستخدم thread غير آمن non safe ..
للتخاطب مع المكونات من داخل الثريد عليك أن تستخدم الدالة Synchronize للقراءة أو الكتابة
ألق نظرة .. لقد عدلت على المثال :

PHP كود :
unit uExm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, DBGrids, DB, ADODB;

type
  TForm1 = class(TForm)
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    Button1: TButton;
    Button2: TButton;
    ADOTable1: TADOTable;
    ADOConnection1: TADOConnection;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TTHR = class(TThread)
  private
    procedure SafeAccessDB;
    { Private declarations }
  protected
    procedure Execute; override;
  end;

var
  Form1: TForm1;
  THR: TTHR;
  Terminated: Boolean;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  Conn, DB: string;
begin

  DB := ExtractFilePath(Application.ExeName) + 'db.mdb';
  Conn := 'Provider=Microsoft.Jet.OLEDB.4.0;' + 'Data Source=' + DB + ';' +
    'Persist Security Info=False;' +
    'Mode=Share Deny None;Extended Properties="";';
  ADOConnection1.LoginPrompt := False;
  ADOConnection1.ConnectionString := Conn;
  ADOConnection1.Open;
  ADOTable1.Connection := ADOConnection1;
  ADOTable1.TableName := 'Table1';
  ADOTable1.Open;

end;

procedure TForm1.Button1Click(Sender: TObject);
var
  I: Integer;
begin
  Terminated := False;
  for I := 1 to 100 do
    begin
      ADOTable1.Append;
      ADOTable1.FieldByName('Items').AsString := 'Item ' + IntToStr(I);
      ADOTable1.Post;
      Application.ProcessMessages;
      if Terminated then
        Break;
    end;
end;

{ TTHR }

procedure TTHR.SafeAccessDB;
var
  I: Integer;
begin
  for I := 1 to 1000 do
    begin
      Form1.ADOTable1.Append;
      Form1.ADOTable1.FieldByName('Items').AsString := 'Item ' + IntToStr(I);
      Form1.ADOTable1.Post;
      if Terminated then
        Break;
    end;
end;

procedure TTHR.Execute;
begin
  FreeOnTerminate := True;
  Synchronize(SafeAccessDB);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  THR := TTHR.Create(True);
  THR.Resume;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Terminated := True;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  ADOTable1.Close;
  ADOConnection1.Close;
end;

end. 

+
استخدم FreeOnTerminate حتى يتم تحرير الثريد بشكل تلقائي
----------------------------------------------
لكن مع هذا ستلاحظ تجمد في واجهة المستخدم لأن أغلب مكونات دلفي لا تدعم مصطلح safe thread
يتوجب عليك في هذه الحالة :
أن تضع أكواد الاتصال داخل الثريد .. (يجب أن تنشئ المكونات يدويا داخل ال constructor

PHP كود :
unit uExm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, DBGrids, DB, ADODB;

type
  TForm1 = class(TForm)
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    Button1: TButton;
    Button2: TButton;
    ADOTable1: TADOTable;
    ADOConnection1: TADOConnection;
    Button3: TButton;
    Refresh: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure RefreshClick(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TTHR = class(TThread)
  private
    FADOConnection: TADOConnection;
    FADOTable: TADOTable;
    constructor Create(CreateSuspended: Boolean); overload;
    destructor Destroy; override;
    procedure SafeAccessDB;
    { Private declarations }
  protected
    procedure Execute; override;
  end;

var
  Form1: TForm1;
  THR: TTHR;
  Terminated: Boolean;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  Conn, DB: string;
begin

  DB := ExtractFilePath(Application.ExeName) + 'db.mdb';
  Conn := 'Provider=Microsoft.Jet.OLEDB.4.0;' + 'Data Source=' + DB + ';' +
    'Persist Security Info=False;' +
    'Mode=Share Deny None;Extended Properties="";';
  ADOConnection1.LoginPrompt := False;
  ADOConnection1.ConnectionString := Conn;
  ADOConnection1.Open;
  ADOTable1.Connection := ADOConnection1;
  ADOTable1.TableName := 'Table1';
  ADOTable1.Open;

end;

procedure TForm1.Button1Click(Sender: TObject);
var
  I: Integer;
begin
  Terminated := False;
  for I := 1 to 200000 do
    begin
      ADOTable1.Append;
      ADOTable1.FieldByName('Items').AsString := 'Item ' + IntToStr(I);
      ADOTable1.Post;
      Application.ProcessMessages;
      if Terminated then
        Break;
    end;
end;

{ TTHR }

procedure TTHR.SafeAccessDB;
var
  I: Integer;
begin
  for I := 1 to 200000 do
    begin
      FADOTable.Append;
      FADOTable.FieldByName('Items').AsString := 'Item ' + IntToStr(I);
      FADOTable.Post;
      if Terminated then
        Break;
    end;
end;

constructor TTHR.Create(CreateSuspended: Boolean);
var
  Conn, DB: string;
begin
  inherited;
  FADOConnection := TADOConnection.Create(nil);
  FADOTable := TADOTable.Create(nil);
  DB := ExtractFilePath(Application.ExeName) + 'db.mdb';
  Conn := 'Provider=Microsoft.Jet.OLEDB.4.0;' + 'Data Source=' + DB + ';' +
    'Persist Security Info=False;' +
    'Mode=Share Deny None;Extended Properties="";';
  FADOConnection.LoginPrompt := False;
  FADOConnection.ConnectionString := Conn;
  FADOConnection.Open;
  FADOTable.Connection := FADOConnection;
  FADOTable.TableName := 'Table1';
  FADOTable.Open;
end;

destructor TTHR.Destroy;
begin
  FADOTable.Close;
  FADOConnection.Close;
  FADOTable.Free;
  FADOConnection.Free;
  Form1.ADOConnection1.Open;
  Form1.ADOTable1.Open;
  inherited;
end;

procedure TTHR.Execute;
begin
  FreeOnTerminate := True;
  SafeAccessDB;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  ADOConnection1.Close;
  ADOTable1.Close;
  THR := TTHR.Create(True);
  THR.Resume;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  THR.Terminate;
end;

procedure TForm1.RefreshClick(Sender: TObject);
begin
  ADOConnection1.Open;
  ADOTable1.Open;
end;

end. 

لاحظ أنه يجب أن تقوم بغلق الاتصال أولا (جداول , ado conn ,...) قبل مناداة الثريد .
بالتوفيــــــق ..

دخول
اسم المستخدم/البريد الالكتروني :
كلمة المرور :	فقدت كلمة المرور ؟
	تذكرني بالمرة القادمة