求救：多线程连接数据库！！ 兄弟们，帮个忙啊～～～～

[king8192]

操作说明：
我用多线程同时连接不同机器的数据库(Sql Server),将数据库中的数据导入到本地机器的数据库中，我启用的是并发线程，并不是队列等待形式的。
在这个过程中，如果连接机器在3台以上（数据量大约在每台机器60万条），就会发生数据库错误，我同时在memo控件中显示连接信息，但memo控件却没有像paint控件的lock那样的属性，所以在线程同时运行情况下，都会对memo进行写入，显示的文字也非常的乱。
各位兄弟能不能帮小弟一把，费费心，解决一下。必重谢！！

[duanhai]

Memo.Lines.BeginUpdate
Memo.Lines.EndUpdate

应该是你要的

[vipxch]

mark 学习啊，厉害

[vipxch]

to newc_k(帕拉丁)：注释呢？一点注释都没有？给点注释啊，看起来好累！

[king8192]

厉害 多谢几位兄弟了
newc_k(帕拉丁)：还能给点注释吗？
再过两天结帖，一定重谢各位！！

[newc_k]

放出我在三层结构中所用的联接数据库源码，具有队列、连接池、多线程、线程管理等诸多性能


源码：
unit uServiceDBPooler;

interface

uses
DB, Provider, Classes, SqlExpr, IniFiles, variants, SysUtils, Forms, DBCommon, DSIntf, DBClient,Dialogs;

type
//TDBExecuteFlag = (exeGetData, exeSetData, exeOpenSQL, exeExecuteSQL);

EDatabasePoolMax = class(EDatabaseError);
TDBExpressConnPool = class(TComponent)
private
FConnectionName: String;
FDriverName: string;
FGetDriverFunc: string;
FLibraryName: string;
FVendorLib: string;
ConList : TThreadList;
InUseList : TBits;
FMaxConnections: integer;
FParams: TStrings;
FAutoOpen: boolean;
procedure SetMaxConnections(const Value: integer);
protected
public
property ConnectionName :string read FConnectionName write FConnectionName;
property DriverName :string read FDriverName write FDriverName;
property GetDriverFunc :string read FGetDriverFunc write FGetDriverFunc;
property LibraryName :string read FLibraryName write FLibraryName;
property VendorLib :string read FVendorLib write FVendorLib;
property Params :TStrings read FParams write FParams;
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure OpenAll; virtual;
procedure CloseAll; virtual;
function AcquireDB : TSQLConnection; virtual;
procedure ReleaseDB(DBExpressConn : TSQLConnection); virtual;
published
property MaxConnections : integer read FMaxConnections write SetMaxConnections;
Property AutoOpen : boolean read FAutoOpen write FAutoOpen default true;
end;

TDBExpressQueryQueue = class;
EQueryQueueMax = class(EDatabaseError);

TDBExpressQueueItem = class(TObject)
private
FExecuteQuery: boolean;
FReadOnly: boolean;
FText: string;
FQueryObject: TSQLQuery;
FDataSetProvider: TDataSetProvider;
FIsReady: boolean;
FData: OleVariant;
FNeedFree: boolean;
FNErr: integer;
public
constructor Create; virtual;
destructor Destroy;override;
property Text : string read FText write FText;
property ReadOnly : boolean read FReadOnly write FReadOnly;
property ExecuteQuery : boolean read FExecuteQuery write FExecuteQuery;
property QueryObject : TSQLQuery read FQueryObject write FQueryObject;
property DataSetProvider: TDataSetProvider read FDataSetProvider write FDataSetProvider;
property IsReady : boolean read FIsReady write FIsReady;
property NeedFree : boolean read FNeedFree write FNeedFree;
end;

TDBExpressQueueManager = class(TThread)
private
FIsOver: Boolean;
FDBExpressQueryQueue : TDBExpressQueryQueue;
protected
procedure Execute; override;
public
constructor Create(QQ : TDBExpressQueryQueue);
end;

TDBExpressQueryQueue = class(TComponent)
private
FDBExpressConnPool: TDBExpressConnPool;
Queue : TThreadList;
QueueManagerList : TTHreadList;
FMaxQueueFactor: integer;
FQueueManagers: integer;
procedure SetDBExpressDatabasePool(const Value: TDBExpressConnPool);
procedure SetQueueManagers(const Value: integer);
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
function ExecuteSQL(Delta,ProviderFlagsParams: OleVariant): integer;
function OpenSQL(Text: string): OleVariant; virtual;
published
property DBExpressDatabasePool : TDBExpressConnPool read FDBExpressConnPool write SetDBExpressDatabasePool;
property MaxQueueFactor : integer read FMaxQueueFactor write FMaxQueueFactor;
property QueueManagers : integer read FQueueManagers write SetQueueManagers;
end;

TAdvDataSetProvider = class(TDataSetProvider)
private
FProviderFlagsParams: OleVariant;
procedure GetDataSetProperties(Sender: TObject;
DataSet: TDataSet; out Properties: OleVariant);
procedure OnBeforeUpdateRecord(Sender: TObject; SourceDS: TDataSet; DeltaDS:
TCustomClientDataSet; UpdateKind: TUpdateKind;var Applied: Boolean);
public
property ProviderFlagsParams: OleVariant read FProviderFlagsParams write FProviderFlagsParams;
constructor Create(AOwner: TComponent);override;
end;

[newc_k]

implementation



{ TDBExpressConnPool }

function TDBExpressConnPool.AcquireDB: TSQLConnection;
var
i : integer;
begin
Result := nil;
with ConList.LockList do
try
i := InUseList.OpenBit;
if i >= Count then raise EDatabasePoolMax.Create('All database connections are in use. Cannot continue with Aquire.');
Result := Items[i];
InUseList[i] := True;
finally
ConList.UnlockList;
end;
end;

procedure TDBExpressConnPool.CloseAll;
var
i : integer;
begin
with ConList.LockList do
try
for i := 0 to Count-1 do
begin
if TSQLConnection(Items[i]).Connected then
TSQLConnection(Items[i]).Close;
end;
finally
ConList.UnlockList;
end;
end;

constructor TDBExpressConnPool.Create(AOwner: TComponent);
begin
inherited;
ConList := TThreadList.Create;
InUseList := TBits.Create;
FParams := TStringList.Create;
FMaxConnections := 0;
FAutoOpen := true;
FConnectionName := 'DB2Connection';
FDriverName := 'DB2';
FGetDriverFunc := 'getSQLDriverDB2';
FLibraryName := 'dbexpdb2.dll';
FVendorLib := 'db2cli.dll';
FParams.Add('DriverName=DB2');
FParams.Add('Database=cpmis0');
FParams.Add('USER_NAME=ucpmis');
FParams.Add('Password=ucpmis200403');
FParams.Add('BlobSize=-1');
FParams.Add('ErrorResourceFile=');
FParams.Add('LocaleCode=0000');
FParams.Add('DB2 TransIsolation=ReadCommited');
MaxConnections := 5;
end;

destructor TDBExpressConnPool.Destroy;
begin
ConList.Free;
InUseList.Free;
FParams.Free;
inherited;
end;

procedure TDBExpressConnPool.OpenAll;
var
i : integer;
begin
with ConList.LockList do
try
for i := 0 to Count-1 do
begin
if TSQLConnection(Items[i]).Connected then
TSQLConnection(Items[i]).Close;
TSQLConnection(Items[i]).Params.Clear;
TSQLConnection(Items[i]).Params.AddStrings(FParams);
TSQLConnection(Items[i]).Open;
end;
finally
ConList.UnlockList;
end;
end;

procedure TDBExpressConnPool.ReleaseDB(DBExpressConn: TSQLConnection);
begin
with ConList.LockList do
try
InUseList[IndexOf(DBExpressConn)] := False;
finally
ConList.UnlockList;
end;
end;

procedure TDBExpressConnPool.SetMaxConnections(const Value: integer);
var
i: integer;
TmpDBExpressConn : TSQLConnection;
begin
if Value <=0 then raise EQueryQueueMax.Create('There must be a positive number of Max Connectiosn');
if csDesigning in ComponentState then
begin
FMaxConnections := Value;
exit;
end;
if FMaxConnections < Value then
begin
for i := FMaxConnections to Value do
begin
TmpDBExpressConn := TSQLConnection.Create(nil);
with TmpDBExpressConn do
begin
ConnectionName := FConnectionName;
DriverName := FDriverName;
GetDriverFunc := FGetDriverFunc;
LibraryName := FLibraryName;
VendorLib := FVendorLib;
Params.Clear;
Params.AddStrings(FParams);
LoginPrompt := False;
end;
if FAutoOpen then TmpDBExpressConn.Connected := true;
ConList.Add(TmpDBExpressConn);
end;
end else
begin
if FMaxConnections > Value then
begin
with ConList.LockList do
try
while Count < Value do
begin
TSQLConnection(Items[Count-1]).Close;
TSQLConnection(Items[Count-1]).Free;
Delete(Count-1);
end;
finally
ConList.UnlockList;
end;
end;
end;

FMaxConnections := Value;
InUseList.Size := Value+1;
end;



{ TDBExpressQueueItem }

constructor TDBExpressQueueItem.Create;
begin
inherited Create;
FIsReady := False;
FNeedFree := False;
end;

destructor TDBExpressQueueItem.Destroy;
begin
FDataSetProvider.Free;
FQueryObject.Free;
inherited;
end;

{ TDBExpressQueueManager }

constructor TDBExpressQueueManager.Create(QQ: TDBExpressQueryQueue);
begin
inherited Create(false);
FDBExpressQueryQueue := QQ;
Priority := tpNormal;
FIsOver := false;
Resume;
end;

procedure TDBExpressQueueManager.Execute;
var
iCount : integer;
SQLConnection : TSQLConnection;
Query : TSQLQuery;
DataSetProvider: TDataSetProvider;
o : TDBExpressQueueItem;
begin
SQLConnection := nil;
o := nil;
while FIsOver = false do
begin
Priority := tpNormal;
if not assigned(FDBExpressQueryQueue.FDBExpressConnPool) then continue;
with FDBExpressQueryQueue.Queue.LockList do
try
iCount := Count;
finally
FDBExpressQueryQueue.Queue.UnlockList;
end;
if iCount > 0 then
begin
try
SQLConnection := FDBExpressQueryQueue.FDBExpressConnPool.AcquireDB;
except
continue;
end;
Priority := tpHighest;
try
with FDBExpressQueryQueue.Queue.LockList do
try
if Count = 0 then
begin
FIsOver := true;
continue;
end;
o := TDBExpressQueueItem(Items[0]);
Delete(0);
finally
FDBExpressQueryQueue.Queue.UnlockList;
end;
if not assigned(o) then raise Exception.Create('Error getting queued object');
try
if Assigned(o.QueryObject) then
begin
try
o.FQueryObject.SQLConnection := SQLConnection;
if o.ExecuteQuery then
begin
try
DataSetProvider.ApplyUpdates(o.FData, 0, o.FNErr);
except
end;
end else
begin
o.FQueryObject.SQL.Text := o.Text;
o.FQueryObject.Open;
o.FData := o.FDataSetProvider.Data;
end;
Priority := tpNormal;
finally
end;
end
else begin
o.Free;
exit;
end;
finally
o.IsReady := True;
end;
finally
FDBExpressQueryQueue.FDBExpressConnPool.ReleaseDB(SQLConnection);
end;
end
else
FIsOver := true;
end;
end;

[newc_k]

{ TDBExpressQueryQueue }

constructor TDBExpressQueryQueue.Create(AOwner: TComponent);
begin
inherited;
Queue := TThreadList.Create;
QueueManagerList := TThreadList.Create;
FMaxQueueFactor := 3;
FQueueManagers := 1;
end;

destructor TDBExpressQueryQueue.Destroy;
var
i : integer;
begin
with QueueManagerList.LockList do
try
for i := 0 to count-1 do
begin
TDBExpressQueueManager(Items[i]).Terminate;
TDBExpressQueueManager(Items[i]).Free;
end;
finally
QueueManagerList.UnLockList;
end;
QueueManagerList.Free;
with Queue.LockList do
try
for i := 0 to count-1 do
TDBExpressQueueItem(Items[i]).Free;
finally
Queue.UnlockList;
end;
Queue.Free;
inherited;
end;

function TDBExpressQueryQueue.ExecuteSQL(Delta,ProviderFlagsParams: OleVariant): integer;
var
SQLConnection: TSQLConnection;
o : TDBExpressQueueItem;
nErr: integer;
Query: TSQLQuery;
DSP: TAdvDataSetProvider;
iCount: Integer;
begin
Query := TSQLQuery.Create(nil);
DSP := TAdvDataSetProvider.Create(nil);
DSP.DataSet := Query;
DSP.ProviderFlagsParams := ProviderFlagsParams;
try
SQLConnection := FDBExpressConnPool.AcquireDB;
except
with Queue.LockList do
try
if Count >= FDBExpressConnPool.MaxConnections*FMaxQueueFactor then
raise Exception.Create('The database queue is full. Please try again in a few seconds.');
finally
Queue.UnlockList;
end;
with QueueManagerList.LockList do
begin
try
if Count = 0 then
QueueManagerList.Add(TDBExpressQueueManager.Create(Self));
finally
QueueManagerList.UnlockList;
end;
end;

o := TDBExpressQueueItem.Create; //SQL敷值
o.ExecuteQuery := true;
o.QueryObject := Query;
o.FDataSetProvider := DSP;
o.FData := Delta;
Queue.Add(o);
try
while not o.IsReady do
Application.ProcessMessages;
Result := o.FNErr;
finally
o.Free;
end;
exit;
end;
try
Query.SQLConnection := SQLConnection;
DSP.UpdateMode := upWhereKeyOnly;
DSP.DataSet := Query;
DSP.ApplyUpdates(Delta, 0, nErr);
result := nErr;
finally
FDBExpressConnPool.ReleaseDB(SQLConnection);
end;
DSP.Free;
Query.Free;
end;

procedure TDBExpressQueryQueue.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited;
if (Operation = opRemove) then
begin
if (AComponent = FDBExpressConnPool) then
FDBExpressConnPool := nil;
end;
end;

function TDBExpressQueryQueue.OpenSQL(Text: string): OleVariant;
var
SQLConnection : TSQLConnection;
o : TDBExpressQueueItem;
Query: TSQLQuery;
DSP: TAdvDataSetProvider;
begin
Query := TSQLQuery.Create(nil);
DSP := TAdvDataSetProvider.Create(nil);
DSP.DataSet := Query;
try
SQLConnection := FDBExpressConnPool.AcquireDB;
except
with Queue.LockList do
try
if Count >= FDBExpressConnPool.MaxConnections*FMaxQueueFactor then
raise Exception.Create('The database queue is full. Please try again in a few seconds.');
finally
Queue.UnlockList;
end;

with QueueManagerList.LockList do
begin
try
if Count = 0 then
QueueManagerList.Add(TDBExpressQueueManager.Create(Self));
finally
QueueManagerList.UnlockList;
end;
end;
o := TDBExpressQueueItem.Create;
o.Text := Text;
o.ExecuteQuery := False;
o.QueryObject := Query;
o.FDataSetProvider := DSP;
Queue.Add(o);
try
while not o.IsReady do
Application.ProcessMessages;
Result := o.FData;
finally
o.Free;
end;
exit;
end;
try
Query.SQLConnection := SQLConnection;
Query.SQL.Text := Text;
DSP.DataSet := Query ;
Query.Open;
Query.First;
result := DSP.Data;
finally
FDBExpressConnPool.ReleaseDB(SQLConnection);
end;
DSP.Free;
Query.Free;
end;

procedure TDBExpressQueryQueue.SetDBExpressDatabasePool(
const Value: TDBExpressConnPool);
begin
FDBExpressConnPool := Value;
if assigned(FDBExpressConnPool) then
begin
FDBExpressConnPool.FreeNotification(self);
end;
end;

procedure TDBExpressQueryQueue.SetQueueManagers(const Value: integer);
var
i : integer;
begin
if Value <=0 then raise Exception.Create('There must be a positive number of Queue Managers');
if csDesigning in ComponentState then
begin
FQueueManagers := Value;
exit;
end;
if (FQueueManagers < Value) or (csLoading in ComponentState) then
begin
for i := FQueueManagers to Value do
begin
QueueManagerList.Add(TDBExpressQueueManager.Create(Self));
end;
end else
begin
if FQueueManagers > Value then
begin
with QueueManagerList.LockList do
try
while Count < Value do
begin
TDBExpressQueueManager(Items[Count-1]).Terminate;
Delete(Count-1);
end;
finally
QueueManagerList.UnlockList;
end;
end;
end;
end;

{ TAdvDataSetProvider }

procedure TAdvDataSetProvider.OnBeforeUpdateRecord(Sender: TObject;
SourceDS: TDataSet; DeltaDS: TCustomClientDataSet;
UpdateKind: TUpdateKind; var Applied: Boolean);
var
iCount, j: integer;
flags: TProviderFlags;
v: OleVariant;
begin
if (VarIsArray(FProviderFlagsParams)) and (not VarIsNull(FProviderFlagsParams)) then
for iCount := VarArrayLowBound(FProviderFlagsParams, 1) to VarArrayHighBound(FProviderFlagsParams, 1) do
begin
flags := [];
//v := VarArrayCreate([0,3],varVariant);
v := FProviderFlagsParams[iCount][1];
if (VarIsArray(v)) and (not VarIsNull(v)) then
begin
for j := VarArrayLowBound(v, 1) to VarArrayHighBound(v, 1) do
begin
if v[j] = 'pfInUpdate' then
flags := flags + [pfInUpdate];
if v[j] = 'pfInWhere' then
flags := flags + [pfInWhere];
if v[j] = 'pfInKey' then
flags := flags + [pfInKey];
if v[j] = 'pfHidden' then
flags := flags + [pfHidden];
end;
end;
DeltaDS.FieldByName(FProviderFlagsParams[iCount][0]).ProviderFlags := flags;
end;
end;

constructor TAdvDataSetProvider.Create(AOwner: TComponent);
begin
inherited;
OnGetDataSetProperties := GetDataSetProperties;
BeforeUpdateRecord := OnBeforeUpdateRecord;
UpdateMode := upWhereKeyOnly;
end;

procedure TAdvDataSetProvider.GetDataSetProperties(Sender: TObject;
DataSet: TDataSet; out Properties: OleVariant);
var
v: OLEVariant;
begin
Properties := VarArrayCreate([0,0],varVariant);
v := VarArrayCreate([0,2],varVariant);
v[0] := szTABLE_NAME;
v[1] := GetTableNameFromQuery(TSQLQuery(DataSet).SQL.Text);
v[2] := true;
Properties[0] := v;
end;

end.




调用
initialization
TAutoObjectFactory.Create(ComServer, TServerCPMISDB, Class_ServerCPMISDB,
ciMultiInstance, tmBoth);
FDBExpressConnPool := TDBExpressConnPool.Create(nil);
FDBExpressQueryQueue := TDBExpressQueryQueue.Create(FDBExpressConnPool);
FDBExpressQueryQueue.DBExpressDatabasePool := FDBExpressConnPool;
FDBExpressQueryQueue.MaxQueueFactor := 5;
//FDBExpressQueryQueue.QueueManagers := 1;
finalization
FDBExpressConnPool.CloseAll;
FDBExpressConnPool.Free;
end.

[jxauyhj]

学习中......

[wsqwang884]

好东西要帮顶一下。。。