Devart Forums

Code: Select all

program ThreadsProject;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Classes,
  DB,
  SqlExpr;

type
  TDBInfoRec = record
    DriverName: string;
    ConnectionName: string;
    DBName:  string;
  end;


  TWorkThread = class(TThread)
  private
    FSQLConnection: TSQLConnection;
    FSQLQuery: TSQLQuery;
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended: Boolean);
    destructor Destroy; override;

    property SQLConnection: TSQLConnection read FSQLConnection write FSQLConnection;
    property SQLQuery: TSQLQuery read FSQLQuery write FSQLQuery;
  end;


{ TWorkThread }

constructor TWorkThread.Create(CreateSuspended: Boolean);
begin
  inherited;
  FSQLConnection := TSQLConnection.Create(nil);
  FSQLQuery := TSQLQuery.Create(nil);
  FSQLQuery.SQLConnection := FSQLConnection;
end;

destructor TWorkThread.Destroy;
begin
  if Assigned(FSQLQuery) then FreeAndNil(FSQLQuery);
  if Assigned(FSQLConnection) then FreeAndNil(FSQLConnection);
  inherited;
end;

procedure TWorkThread.Execute;
begin
  inherited;
  FSQLConnection.Open;
  FSQLQuery.ExecSQL(True);
end;

function CheckAllThreadsFinished(aThreadsList: TList): Boolean;
var
  i: Integer;
  nFinished: integer;
begin
  nFinished := 0;
  for i := 0 to aThreadsList.Count - 1 do
    if TWorkThread(aThreadsList[i]).Finished then
      Inc(nFinished);
  Result := aThreadsList.Count = nFinished;
end;

var
//  nThreads: Integer;
  i: Integer;
  aDBInfo: array [0..1] of TDBInfoRec;
  aWorkThreads: TList;
  oThread: TWorkThread;
begin
  try
    { TODO -oUser -cConsole Main : Insert code here }
    aDBInfo[0].DriverName := 'DevartInterBase';
    aDBInfo[0].ConnectionName := 'Devart driver';
    aDBInfo[0].DBName := 'localhost:e:\Work\Projects\TEST.FDB';

    aDBInfo[1].DriverName := 'DevartInterBase';
    aDBInfo[1].ConnectionName := 'Devart driver COPY';
    aDBInfo[1].DBName := 'localhost:e:\Work\Projects\TEST_COPY.FDB';

    aWorkThreads := TList.Create;
    try
      for i := Low(aDBInfo) to High(aDBInfo) do begin
        oThread := TWorkThread.Create(True);
        oThread.SQLConnection.DriverName := aDBInfo[i].DriverName;
        oThread.SQLConnection.ConnectionName := aDBInfo[i].ConnectionName;
        oThread.SQLConnection.Params.Values['Database'] := aDBInfo[i].DBName;
        oThread.SQLConnection.Params.Values['User_Name'] := 'admin';
        oThread.SQLConnection.Params.Values['Password'] := 'admin';
        oThread.SQLQuery.CommandText := 'execute procedure TMP_TEST_SP;';
        aWorkThreads.Add(oThread);
      end;

      // Стартуем потоки
      for i := Low(aDBInfo) to High(aDBInfo) do begin
        TWorkThread(aWorkThreads[i]).Resume;
      end;

      // Ожидаем завершения работы потоков
      while not CheckAllThreadsFinished(aWorkThreads) do
        Sleep(50);
    finally
      while aWorkThreads.Count > 0 do begin
        TWorkThread(aWorkThreads[0]).Free;
        aWorkThreads.Delete(0);
      end;
      aWorkThreads.Free;
    end;
  except
    on E:Exception do
      Writeln(E.Classname, ': ', E.Message);
  end;
end.

Code: Select all

SET TERM ^ ;
CREATE TABLE TMP_TEST (
    DB_NAME        VARCHAR(10) DEFAULT 'TEST',
    DATE_INSERTED  VARCHAR(30),
    VAL            INTEGER
)^
/* Trigger: TMP_TEST_BI */
CREATE OR ALTER TRIGGER TMP_TEST_BI FOR TMP_TEST
ACTIVE BEFORE INSERT POSITION 0
as
begin
  select cast('NOW' as timestamp) from rdb$database
    into NEW.date_inserted;
end
^
create or alter procedure TMP_TEST_SP
returns (
    VAL integer,
    DB_NAME varchar(10),
    DATE_INSERTED varchar(30))
AS
declare variable I integer;
declare variable P integer;
BEGIN
  delete from tmp_test;
  P = 0;
  WHILE (P < 1000) DO BEGIN
    insert into TMP_TEST(VAL) values(:P);
    P = P + 1;
    I = 0;
    while (i < 10000) do I = I + 1;
  END
  FOR SELECT VAL, DB_NAME, DATE_INSERTED
  FROM TMP_TEST
  into :VAL, :DB_NAME, DATE_INSERTED do
  BEGIN
    SUSPEND;
  END
END^
SET TERM ; ^