diff --git a/packages/fcl-db/src/base/database.inc b/packages/fcl-db/src/base/database.inc index 6d06c9bdea..6e66db38b5 100644 --- a/packages/fcl-db/src/base/database.inc +++ b/packages/fcl-db/src/base/database.inc @@ -58,8 +58,8 @@ constructor TDatabase.Create(AOwner: TComponent); begin Inherited Create(AOwner); FParams:=TStringlist.Create; - FDatasets:=TList.Create; - FTransactions:=TList.Create; + FDatasets:=TThreadList.Create; + FTransactions:=TThreadList.Create; FConnected:=False; end; @@ -77,51 +77,81 @@ end; procedure TDatabase.CloseDataSets; -Var I : longint; +Var + I : longint; + L : TList; begin If Assigned(FDatasets) then begin - For I:=FDatasets.Count-1 downto 0 do - TDataset(FDatasets[i]).Close; + L:=FDatasets.LockList; + try + For I:=L.Count-1 downto 0 do + TDataset(L[i]).Close; + finally + FDatasets.UnlockList; + end; end; end; procedure TDatabase.CloseTransactions; -Var I : longint; +Var + I : longint; + L : TList; begin If Assigned(FTransactions) then begin - For I:=FTransactions.Count-1 downto 0 do - try - TDBTransaction(FTransactions[i]).EndTransaction; - except - if not ForcedClose then - Raise; - end; + L:=FTransactions.LockList; + try + For I:=L.Count-1 downto 0 do + try + TDBTransaction(L[i]).EndTransaction; + except + if not ForcedClose then + Raise; + end; + finally + FTransactions.UnlockList + end; end; end; procedure TDatabase.RemoveDataSets; -Var I : longint; - +Var + I : longint; + L : TList; begin If Assigned(FDatasets) then - For I:=FDataSets.Count-1 downto 0 do - TDBDataset(FDataSets[i]).Database:=Nil; + begin + L:=FDatasets.LockList; + try + For I:=L.Count-1 downto 0 do + TDBDataset(L[i]).Database:=Nil; + finally + FDatasets.UnlockList; + end; + end; end; procedure TDatabase.RemoveTransactions; -Var I : longint; - +Var + I : longint; + L : TList; begin If Assigned(FTransactions) then - For I:=FTransactions.Count-1 downto 0 do - TDBTransaction(FTransactions[i]).Database:=Nil; + begin + L:=FTransactions.LockList; + try + For I:=L.Count-1 downto 0 do + TDBTransaction(L[i]).Database:=Nil; + finally + FTransactions.UnlockList + end; + end; end; procedure TDatabase.SetParams(AValue: TStrings); @@ -132,92 +162,157 @@ end; Function TDatabase.GetDataSetCount : Longint; +Var + L : TList; + begin + Result:=0; If Assigned(FDatasets) Then - Result:=FDatasets.Count - else - Result:=0; + begin + L:=FDatasets.LockList; + try + Result:=L.Count; + finally + FDatasets.Unlocklist; + end; + end; end; Function TDatabase.GetTransactionCount : Longint; +Var + L : TList; + begin + Result:=0; If Assigned(FTransactions) Then - Result:=FTransactions.Count - else - Result:=0; + begin + L:=FTransactions.LockList; + try + Result:=L.Count; + finally + FTransactions.UnlockList; + end; + end; end; Function TDatabase.GetDataset(Index : longint) : TDataset; +Var + L : TList; + begin - If Assigned(FDatasets) then - Result:=TDataset(FDatasets[Index]) - else + If Not Assigned(FDatasets) then begin result := nil; DatabaseError(SNoDatasets); + end + else + begin + L:=FDatasets.LockList; + try + Result:=TDataset(L[Index]) + finally + FDatasets.UnlockList; + end; end; end; Function TDatabase.GetTransaction(Index : longint) : TDBtransaction; +Var + L : TList; + begin - If Assigned(FTransactions) then - Result:=TDBTransaction(FTransactions[Index]) - else + If Not Assigned(FTransactions) then begin result := nil; DatabaseError(SNoTransactions); + end + else + begin + L:=FTransactions.LockList; + try + Result:=TDBTransaction(L[Index]) + finally + FTransactions.UnlockList; + end; end; end; procedure TDatabase.RegisterDataset (DS : TDBDataset); -Var I : longint; - +Var + I : longint; + L : TList; begin - I:=FDatasets.IndexOf(DS); - If I=-1 then - FDatasets.Add(DS) - else - DatabaseErrorFmt(SDatasetRegistered,[DS.Name]); + L:=FDatasets.LockList; + try + I:=L.IndexOf(DS); + If I=-1 then + L.Add(DS) + else + DatabaseErrorFmt(SDatasetRegistered,[DS.Name]); + finally + FDatasets.UnlockList; + end; end; procedure TDatabase.RegisterTransaction (TA : TDBTransaction); -Var I : longint; +Var + I : longint; + L : TList; begin - I:=FTransactions.IndexOf(TA); - If I=-1 then - FTransactions.Add(TA) - else - DatabaseErrorFmt(STransactionRegistered,[TA.Name]); + L:=FTransactions.LockList; + try + I:=L.IndexOf(TA); + If I=-1 then + L.Add(TA) + else + DatabaseErrorFmt(STransactionRegistered,[TA.Name]); + finally + FTransactions.UnlockList; + end; end; procedure TDatabase.UnRegisterDataset (DS : TDBDataset); -Var I : longint; +Var + I : longint; + L : TList; begin - I:=FDatasets.IndexOf(DS); - If I<>-1 then - FDatasets.Delete(I) - else - DatabaseErrorFmt(SNoDatasetRegistered,[DS.Name]); + L:=FDatasets.LockList; + try + I:=L.IndexOf(DS); + If I<>-1 then + L.Delete(I) + else + DatabaseErrorFmt(SNoDatasetRegistered,[DS.Name]); + finally + FDatasets.UnlockList; + end; end; procedure TDatabase.UnRegisterTransaction (TA : TDBTransaction); -Var I : longint; +Var + I : longint; + L : TList; begin - I:=FTransactions.IndexOf(TA); - If I<>-1 then - FTransactions.Delete(I) - else - DatabaseErrorFmt(SNoTransactionRegistered,[TA.Name]); + L:=FTransactions.LockList; + try + I:=L.IndexOf(TA); + If I<>-1 then + L.Delete(I) + else + DatabaseErrorFmt(SNoTransactionRegistered,[TA.Name]); + finally + FTransactions.UnlockList; + end; end; @@ -374,7 +469,7 @@ constructor TDBTransaction.Create(AOwner: TComponent); begin inherited Create(AOwner); - FDatasets:=TList.Create; + FDatasets:=TThreadList.Create; end; procedure TDBTransaction.CheckDatabase; @@ -394,17 +489,23 @@ procedure TDBTransaction.CloseDataSets; Var I : longint; + L : TList; DS : TDBDataset; begin If Assigned(FDatasets) then begin - For I:=FDatasets.Count-1 downto 0 do - begin - DS:=TDBDataset(FDatasets[i]); - If AllowClose(DS) then - DS.Close; - end; + L:=FDatasets.LockList; + try + For I:=L.Count-1 downto 0 do + begin + DS:=TDBDataset(L[i]); + If AllowClose(DS) then + DS.Close; + end; + finally + FDatasets.UnlockList; + end; end; end; @@ -420,57 +521,91 @@ end; procedure TDBTransaction.RemoveDataSets; -Var I : longint; +Var + I : longint; + L : TList; begin - If Assigned(FDatasets) then - For I:=FDataSets.Count-1 downto 0 do - TDBDataset(FDataSets[i]).Transaction:=Nil; + If Not Assigned(FDatasets) then + exit; + L:=FDatasets.LockList; + try + For I:=L.Count-1 downto 0 do + TDBDataset(L[i]).Transaction:=Nil; + finally + FDatasets.unlockList; + end; end; function TDBTransaction.GetDataset(Index: longint): TDBDataset; +Var + L : TList; + + begin - If Assigned(FDatasets) then - Result:=TDBDataset(FDatasets[Index]) - else - begin - Result := nil; + If Not Assigned(FDatasets) then DatabaseError(SNoDatasets); + L:=FDatasets.LockList; + try + Result:=TDBDataset(L[Index]) + finally + FDatasets.UnlockList; end; end; function TDBTransaction.GetDataSetCount: Longint; +Var + L : TList; + begin - If Assigned(FDatasets) Then - Result:=FDatasets.Count - else - Result:=0; + Result:=0; + If Not Assigned(FDatasets) Then + exit; + L:=FDatasets.lockList; + try + Result:=L.Count + finally + FDatasets.UnlockList; + end; end; procedure TDBTransaction.RegisterDataset (DS : TDBDataset); -Var I : longint; - +Var + I : longint; + L : TList; begin - I:=FDatasets.IndexOf(DS); - If I=-1 then - FDatasets.Add(DS) - else - DatabaseErrorFmt(SDatasetRegistered,[DS.Name]); + L:=FDatasets.LockList; + try + I:=L.IndexOf(DS); + If I=-1 then + L.Add(DS) + else + DatabaseErrorFmt(SDatasetRegistered,[DS.Name]); + finally + FDatasets.UnlockList; + end; end; procedure TDBTransaction.UnRegisterDataset (DS : TDBDataset); -Var I : longint; +Var + I : longint; + L : TList; begin - I:=FDatasets.IndexOf(DS); - If I<>-1 then - FDatasets.Delete(I) - else - DatabaseErrorFmt(SNoDatasetRegistered,[DS.Name]); + L:=FDatasets.LockList; + try + I:=L.IndexOf(DS); + If I<>-1 then + L.Delete(I) + else + DatabaseErrorFmt(SNoDatasetRegistered,[DS.Name]); + finally + FDatasets.UnlockList; + end; end; { --------------------------------------------------------------------- diff --git a/packages/fcl-db/src/base/db.pas b/packages/fcl-db/src/base/db.pas index a8bcc9e8ae..65b14f4e1b 100644 --- a/packages/fcl-db/src/base/db.pas +++ b/packages/fcl-db/src/base/db.pas @@ -1956,7 +1956,7 @@ type Private FActive : boolean; FDatabase : TDatabase; - FDataSets : TList; + FDataSets : TThreadList; FOpenAfterRead : boolean; Function GetDataSetCount : Longint; Function GetDataset(Index : longint) : TDBDataset; @@ -2047,8 +2047,8 @@ type private FConnected : Boolean; FDataBaseName : String; - FDataSets : TList; - FTransactions : TList; + FDataSets : TThreadList; + FTransactions : TThreadList; FDirectory : String; FKeepConnection : Boolean; FParams : TStrings; diff --git a/packages/fcl-db/src/base/fields.inc b/packages/fcl-db/src/base/fields.inc index c2494452b1..3e3483a801 100644 --- a/packages/fcl-db/src/base/fields.inc +++ b/packages/fcl-db/src/base/fields.inc @@ -496,6 +496,8 @@ end; function TField.GetAsBytes: TBytes; begin + Result:=Default(TBytes); + Writeln('Allocating ',Datasize,' bytes'); SetLength(Result, DataSize); if assigned(result) and not GetData(@Result[0], False) then Result := nil; diff --git a/packages/fcl-db/src/sqldb/sqldb.pp b/packages/fcl-db/src/sqldb/sqldb.pp index 4abae7217e..cd5b56bdc8 100644 --- a/packages/fcl-db/src/sqldb/sqldb.pp +++ b/packages/fcl-db/src/sqldb/sqldb.pp @@ -192,7 +192,7 @@ type FCharSet : string; FCodePage : TSystemCodePage; FRole : String; - FStatements : TFPList; + FStatements : TThreadList; FLogEvents: TDBEventTypes; FOnLog: TDBLogNotifyEvent; function GetPort: cardinal; @@ -265,11 +265,9 @@ type Procedure MaybeConnect; - Property Statements : TFPList Read FStatements; + Property Statements : TThreadList Read FStatements; property Port: cardinal read GetPort write SetPort; public - property Handle: Pointer read GetHandle; - property FieldNameQuoteChars: TQuoteChars read FFieldNameQuoteChars write FFieldNameQuoteChars; constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure StartTransaction; override; @@ -290,6 +288,8 @@ type procedure DropDB; virtual; function GetNextValue(const SequenceName: string; IncrementBy: integer=1): Int64; virtual; property ConnOptions: TConnOptions read FConnOptions; + property Handle: Pointer read GetHandle; + property FieldNameQuoteChars: TQuoteChars read FFieldNameQuoteChars write FFieldNameQuoteChars; published property Password : string read FPassword write FPassword; property Transaction : TSQLTransaction read FTransaction write SetTransaction; @@ -1192,7 +1192,8 @@ begin FSQLFormatSettings:=DefaultSQLFormatSettings; FFieldNameQuoteChars:=DoubleQuotes; FLogEvents:=LogAllEvents; //match Property LogEvents...Default LogAllEvents - FStatements:=TFPList.Create; + FStatements:=TThreadList.Create; + FStatements.Duplicates:=dupIgnore; end; destructor TSQLConnection.Destroy; @@ -1268,11 +1269,17 @@ procedure TSQLConnection.DoInternalDisconnect; Var I : integer; + L : TList; begin - For I:=0 to FStatements.Count-1 do - TCustomSQLStatement(FStatements[i]).Unprepare; - FStatements.Clear; + L:=FStatements.LockList; + try + For I:=0 to L.Count-1 do + TCustomSQLStatement(L[i]).Unprepare; + L.Clear; + finally + FStatements.UnlockList; + end; end; procedure TSQLConnection.StartTransaction; @@ -1791,9 +1798,9 @@ begin end; procedure TSQLConnection.RegisterStatement(S: TCustomSQLStatement); + begin - if FStatements.IndexOf(S)=-1 then - FStatements.Add(S); + FStatements.Add(S); end; procedure TSQLConnection.UnRegisterStatement(S: TCustomSQLStatement);