Текущий архив: 2007.12.09;
Скачать: CL | DM;

Вниз

Работа с FB из нескольких потоков   Найти похожие ветки 

← →
jack128 ©   (2007-05-30 15:44) [0]

День добрый.
Есть база на FB1.5
Есть многопоточное приложение. В каждом потоке создается свой экземпляр IBDatabase, свои IBTransaction и и тд..  ПРоблема в том, что если один поток апдейтит базы, то второй даже не может к базе подключится, а первый просто виснит.. Висит всё на вызове функции Fisc_attach_database, то есть непосредственно в клиентской библиотеке gds32.dll..

Ну вопрос очевиден:  Что делать? (с)

Вот минимальный пример, для компиляции - просто поменяйте значения констант DataBaseName и SQLQuery

Pas:
unit Unit2;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, IBDatabase, IBSQL, StdCtrls;

type
 TForm2 = class(TForm)
   Button1: TButton;
   Button2: TButton;
   Memo1: TMemo;
   procedure Button2Click(Sender: TObject);
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form2: TForm2;

implementation

{$R *.dfm}

const
 DataBaseName = "D:\Женя\Grand\Modules\CertMaker.new\Center\Server\CMMANBASE.FDB";
 SQLQuery = "update rfolders set title = title";

type
 TIBThread = class(TThread)
 strict private
   FDatabase: TIBDatabase;
   FStr: string;
   procedure DoAddLineToMemo;
 protected
   procedure Execute; override; final;
   procedure DoExecute; virtual; abstract;
 protected
   property Database: TIBDatabase read FDatabase;
   function CreateTransaction(ForWrite: boolean): TIBTransaction;
   procedure AddLineToMemo(const S: string);
 end;

 TIBWriteThread = class(TIBThread)
 protected
   procedure DoExecute; override;
 end;

 TIBStartReadTransactionThread = class(TIBThread)
 protected
   procedure DoExecute; override;
 end;

{ TIBThread }

procedure TIBThread.AddLineToMemo(const S: string);
begin
 FStr := S;
 Synchronize(DoAddLineToMemo);
end;

function TIBThread.CreateTransaction(ForWrite: boolean): TIBTransaction;
const
 TransactionParams: array[False..True] of string = (
   "read_committed"#13#10+
   "rec_version"#13#10+
   "nowait"#13#10+
   "read",

   "read_committed"#13#10+
   "rec_version"#13#10+
   "nowait");
begin
 Result := TIBTransaction.Create(FDatabase);
 Result.DefaultDatabase := FDatabase;
 Result.Params.Text := TransactionParams[ForWrite];
end;

procedure TIBThread.DoAddLineToMemo;
begin
 Form2.Memo1.Lines.Add(FStr)
end;

procedure TIBThread.Execute;
begin
 AddLineToMemo("Начало работы потока");
 try
   try
     FDatabase := TIBDatabase.Create(nil);
     try
       FDatabase.DatabaseName := DatabaseName;
       with FDatabase.Params do
       begin
         Values["lc_ctype"] := "WIN1251";
         Values["user_name"] := "SYSDBA";
         Values["password"] := "masterkey";
       end;
       FDatabase.LoginPrompt := False;
       FDatabase.Connected := True;
       DoExecute;
     finally
       FreeAndNil(FDatabase);
     end;
   except
     on E: Exception do
       AddLineToMemo("Ошибка: " + E.Message);
   end;
 finally
   AddLineToMemo("Окончание работы потока");
 end;
end;

{ TWriteThread }

procedure TIBWriteThread.DoExecute;
var
 SQL: TIBSQL;
 Count: Integer;
begin
 inherited;
 SQL := TIBSQL.Create(Database);
 try
   SQL.Transaction := CreateTransaction(True);
   SQL.Transaction.StartTransaction;
   SQL.SQL.Text := SQLQuery;
   Count := 0;
   while not Terminated do
   begin
     SQL.ExecQuery;
     if SQL.Open then
       SQL.Close;
     Inc(Count);
     if (Count mod 20) = 0 then
     begin
       AddLineToMemo("Пишущий поток всё еще работает...");
       Count := 0;
     end;
   end;
 finally
   if (SQL.Transaction <> nil) and SQL.Transaction.InTransaction then
     SQL.Transaction.Commit;
   SQL.Free;
 end;
end;

{ TIBStartReadTransactionThread }

procedure TIBStartReadTransactionThread.DoExecute;
var
 Transaction: TIBTransaction;
begin
 inherited;
 Transaction := CreateTransaction(False);
 try
   AddLineToMemo("Перед стартом транзакции");
   Transaction.StartTransaction;
   AddLineToMemo("Перед коммитом транзакции");
   Transaction.Commit;
   AddLineToMemo("После коммита транзакции");    
 finally
   Transaction.Free;
 end;
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
 with TIBWriteThread.Create(True) do
 begin
   FreeOnTerminate := True;
   Resume
 end;
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
 with TIBStartReadTransactionThread.Create(True) do
 begin
   FreeOnTerminate := True;
   Resume
 end;
end;

end.

Dfm:
object Form2: TForm2
 Left = 0
 Top = 0
 Caption = "Form2"
 ClientHeight = 286
 ClientWidth = 367
 Color = clBtnFace
 Font.Charset = DEFAULT_CHARSET
 Font.Color = clWindowText
 Font.Height = -11
 Font.Name = "Tahoma"
 Font.Style = []
 OldCreateOrder = False
 DesignSize = (
   367
   286)
 PixelsPerInch = 96
 TextHeight = 13
 object Button1: TButton
   Left = 24
   Top = 240
   Width = 138
   Height = 25
   Anchors = [akLeft, akBottom]
   Caption = "Start write thread"
   TabOrder = 0
   OnClick = Button1Click
 end
 object Button2: TButton
   Left = 168
   Top = 240
   Width = 161
   Height = 25
   Anchors = [akLeft, akBottom]
   Caption = "Start Transaction thread"
   TabOrder = 1
   OnClick = Button2Click
 end
 object Memo1: TMemo
   Left = 24
   Top = 8
   Width = 305
   Height = 209
   Anchors = [akLeft, akTop, akRight, akBottom]
   Lines.Strings = (
     "Memo1")
   TabOrder = 2
 end
end

---

← →
Jan1 ©   (2007-05-30 16:06) [1]

Delphi7+FB2.0 нет никаких зависаний.

---

← →
Desdechado ©   (2007-05-30 16:20) [2]

IBX и Delphi каких версий?

---

← →
jack128 ©   (2007-05-30 16:27) [3]

"Interbase Express10,10" и Delphi 2006 соответственно..

---

← →
Сергей М. ©   (2007-05-30 16:32) [4]

> jack128 ©   (30.05.07 15:44)


Смелый ты мужик)

Прямо в доп.потоке валишь в мемо строчки)

---

← →
jack128 ©   (2007-05-30 16:36) [5]

поставил 2,0,1 - всё работает.. Глючит полуторка??

---

← →
jack128 ©   (2007-05-30 16:36) [6]

Сергей М. ©   (30.05.07 16:32) [4]
Прямо в доп.потоке валишь в мемо строчки)
а если внимательно присмотреться в код? ;-)

---

← →
Сергей М. ©   (2007-05-30 16:42) [7]

> jack128 ©   (30.05.07 16:36) [6]


А, пардон, вижу)

Замылил взгляд AddLineToMemo, с Do и без Do)

---

← →
Desdechado ©   (2007-05-30 16:54) [8]

gds32.dll точно от полуторки?
А то, может, от чего-то еще завалялась?

---

← →
jack128 ©   (2007-05-30 17:36) [9]

Desdechado ©   (30.05.07 16:54) [8]
gds32.dll точно от полуторки?
А то, может, от чего-то еще завалялась?
не, тут всё точно..

---

← →
jack128 ©   (2007-05-30 17:38) [10]

отмечу, что если параллельно запускать не потоки, а ПРОЦЕССЫ, то всё работает как часы..

---

← →
PEAKTOP(banned)   (2007-05-30 22:46) [11]

> отмечу, что если параллельно запускать не потоки, а ПРОЦЕССЫ,  то всё работает как часы..


Дескриптор процесса приложения (PID) ОДИН, оттудыва и грабли, потому как в IBX есть в модуле IBIntf.pas

procedure TDynamicLibrary.LoadIBLibrary;
...............

{$IFDEF MSWINDOWS}
 IBLibrary := LoadLibrary(PChar(IBASE_DLL)); // тута винда и получает дескриптор вызывающего процесса.
 ............
{$ENDIF}


Так что, забей на IBX вместе со TThread. Те надо что-нить, что может перед подключением спросить о клиентской библиотеке и соответственно ее подгрузить, как например FIBPlus. Пусть это будет одна и та-же библиотека, главное, что при этом вызывающая функция получит новый дескриптор процесса (точнее нового класса TThread), и, соответственно будет думать, что это новый процесс.

---

← →
jack128 ©   (2007-05-30 23:37) [12]

PEAKTOP(banned)   (30.05.07 22:46) [11]
IBLibrary := LoadLibrary(PChar(IBASE_DLL)); // тута винда и получает дескриптор вызывающего процесса.
"Тута" - это внутри LoadLibrary??  Ну получает она PID и что дальше??
PEAKTOP(banned)   (30.05.07 22:46) [11]
Так что, забей на IBX вместе со TThread. Те надо что-нить, что может перед подключением спросить о клиентской библиотеке и соответственно ее подгрузить, как например FIBPlus
А что, IBX не умеет грузить gds32 ??  А на основании чего сделан такой вывод, если не секрет???

---

← →
Сергей М. ©   (2007-05-31 08:48) [13]

> Дескриптор процесса приложения (PID) ОДИН, оттудыва и грабли


Галиматья какая-то

---

← →
PEAKTOP(banned)   (2007-05-31 10:54) [14]

> А что, IBX не умеет грузить gds32 ??  А на основании чего  сделан такой вывод, если не секрет???

Она его и грузит. Один раз во время выполнения метода TIBDataBase.Create() самого первого компонента TIBDataBase в приложении. Тебя уже пытались "подколоть" на тему

Сергей М. ©   (30.05.07 16:32) [4]
> jack128 ©   (30.05.07 15:44)
Смелый ты мужик)
Прямо в доп.потоке валишь в мемо строчки)

Тут тоже самое: в IBIntf есть переменная

...............
implementation
var
..........
 IBLibrary: THandle;
.............

она получается глобальной, и когда создаешь следующие компоненты TIBDataBase, то у них дескриптор библиотеки тот же, а надо, чтобы в потоке в TTherad.Create каждый раз вызывалось LoadLibrary, и каждый TIBDataBase имел свой IBLibrary:THandle.

---

← →
jack128 ©   (2007-05-31 11:11) [15]

PEAKTOP(banned)   (31.05.07 10:54) [14]
Один раз во время выполнения метода TIBDataBase.Create() самого первого компонента TIBDataBase в приложении.
а что, этого недостаточно, чтоли???

PEAKTOP(banned)   (31.05.07 10:54) [14]
она получается глобальной, и когда создаешь следующие компоненты TIBDataBase, то у них дескриптор библиотеки тот же, а надо, чтобы в потоке в TTherad.Create каждый раз вызывалось LoadLibrary, и каждый TIBDataBase имел свой IBLibrary:THandle.
Ясно.  Ты не в курсе, как работает LoadLibrary..

---

← →
Сергей М. ©   (2007-05-31 11:27) [16]

> PEAKTOP(banned)   (31.05.07 10:54) [14]


Чушь ты несешь)

---

← →
PEAKTOP(banned)   (2007-05-31 12:18) [17]

> jack128 ©   (31.05.07 11:11) [15]

Ты просто пропробуй сделать тоже самое на FIBPlus, и посмотри, что будет.

> Сергей М. ©   (31.05.07 11:27) [16]

Давай подождем результатов эксперимента ? :))

---

← →
jack128 ©   (2007-05-31 13:20) [18]

PEAKTOP(banned)   (31.05.07 12:18) [17]
Ты просто пропробуй сделать тоже самое на FIBPlus, и посмотри, что будет
Пока не вижу причин этой чепухой заниматься..

---

← →
Правильный Вася   (2007-05-31 13:56) [19]

PEAKTOP(banned)  
почму ж тогда с двушкой работает?

---

← →
Сергей М. ©   (2007-05-31 14:55) [20]

> PEAKTOP(banned)   (31.05.07 12:18) [17]
> Давай подождем результатов эксперимента ?


Экспериментировать нужно осмысленно.

А то на чем ты настаиваешь, есть чепуха полная, о чем ув. jack128 ©   (31.05.07 13:20) [18] и сказал.

---

← →
Fiend ©   (2007-06-01 17:40) [21]

Товарищь реактор, причем тут компаненты? у меня есть софт написанный с использованием ИБХ много лет назад, когда у меня еще небыло ФИБПлюса. Там тоже куча порождаемых друг другом потоков, и все работает и по сей день без зависаний. А ваш рассказ по поводу LoadLibrary - ЧУШЬ!

Автору: Не знаю поможет это вам или нет, но мой код в местах где идет комит выполняется Synchronize(FTransaction.Commit); и то что касается ролбэка. Помоему у меня тоже такой же глюк был. Пробаните.

---

← →
jack128 ©   (2007-06-02 18:38) [22]

Fiend ©   (01.06.07 17:40) [21]
Автору: Не знаю поможет это вам или нет, но мой код в местах где идет комит выполняется Synchronize(FTransaction.Commit); и то что касается ролбэка. Помоему у меня тоже такой же глюк был. Пробаните.
мы просто двойку поставили, вроде всё работает..
И потом - не ясно, на что твой вариант повлияет, ведь до коммита дело даже не доходит..

---

← →
Сергей М. ©   (2007-06-04 08:52) [23]

> в местах где идет комит выполняется Synchronize(FTransaction.
> Commit); и то что касается ролбэка


Что за ерунда - старт транзакции в произвольном (заранее неизвестном) потоке, а коммит/ролбэк не иначе как в основном ?

---

← →
имя   (2007-08-08 21:22) [24]

Удалено модератором

---

← →
имя   (2007-08-08 22:35) [25]

Удалено модератором

---

Страницы: 1 вся ветка

Текущий архив: 2007.12.09;
Скачать: CL | DM;

Наверх

Память: 0.54 MB
Время: 0.026 c