| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

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

Страницы:   < 1 2 >

jack128 ©   (2007-05-30 15:44:00) 

День добрый.
Есть база на 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

---

  (2007-08-08 22:35:00) [1]

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

---

  (2007-08-08 21:22:00) [2]

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

---

Сергей М.   (2007-06-04 08:52:00) [3]

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


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

---

jack128   (2007-06-02 18:38:00) [4]

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

---

Fiend   (2007-06-01 17:40:00) [5]

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

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

---

Сергей М.   (2007-05-31 14:55:00) [6]

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


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

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

---

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

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

---

jack128   (2007-05-31 13:20:00) [8]

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

---

PEAKTOP(banned)   (2007-05-31 12:18:00) [9]

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

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

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

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

---

Сергей М.   (2007-05-31 11:27:00) [10]

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


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

---

jack128   (2007-05-31 11:11:00) [11]

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

---

PEAKTOP(banned)   (2007-05-31 10:54:00) [12]

> А что, 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.

---

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

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


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

---

jack128   (2007-05-30 23:37:00) [14]

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 ??  А на основании чего сделан такой вывод, если не секрет???

---

PEAKTOP(banned)   (2007-05-30 22:46:00) [15]

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


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

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

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


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

---

jack128   (2007-05-30 17:38:00) [16]

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

---

jack128   (2007-05-30 17:36:00) [17]

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

---

Desdechado   (2007-05-30 16:54:00) [18]

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

---

Сергей М.   (2007-05-30 16:42:00) [19]

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


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

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

---

jack128   (2007-05-30 16:36:00) [20]

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

---

Страницы:   < 1 2 >

Наверх