إضافة سجلات بإستعمال ثريد - نسخة قابلة للطباعة

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.

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.