interface
uses Classes, AdoDB, Windows, Messages,
ActiveX;
const DM_Base=WM_User;
DM_Ask=DM_Base+1;
DM_Next=DM_Base+2;
DM_Last=DM_Next;
type TSqlEvent=procedure(answer:integer)
of object;
type
TOpenQuery =
Class(TThread)
Public
constructor Create(AConnectString:WideString;
//as is
AonTerminate:TNotifyEvent;
//wird ausgelöst, wenn Thread beendet oder abbricht
AOnSqlEvent:TSqlEvent);
//wird ausgelöst, wenn neues Datenbankergebnis
procedure Terminate;
override;
//Thread beenden
function AskSQL(aSqlText:
string):boolean;
//neues SQL_Statement
function NextSQL:boolean;
//=SQLQuery.Next
protected
FQry: TADOQuery;
FCon: TADOConnection;
FSql:
String;
FConnectString: WideString;
FOnSQLEvent:TSQLEvent;
FAnswer:Integer;
procedure Execute;
override;
procedure DoSQLCommand(
var msg:TMessage);
message DM_Ask;
procedure DoSQLNext(
var msg:TMessage);
message DM_Next;
procedure DoSQLEvent;
end;
implementation
constructor TOpenQuery.Create();
begin
inherited Create(False);
FreeOnTerminate:=True;
FConnectString:=aConnectString;
onTerminate:=AonTerminate;
FOnSQLEvent:=AOnSQLEvent;
end;
procedure TOpenQuery.Execute;
var msg:TMSG;
begin
coinitialize(
nil);
FCon:=TAdoConnection.Create(
nil);
Fqry:=TAdoQuery.Create(
nil);
try
FCon.ConnectionString:=FconnectString;
Fqry.Connection:=FCon;
FCon.Open;
while not terminated
and getmessage(msg,0,0,0)
do
begin
if (msg.
message>=DM_Base)
and
(msg.
message<=DM_Last)
then
dispatch(msg)
//Als message an die Klasse verteilen
else
dispatchmessage(msg);
//Windows verteilen lassen
end;
finally
Fqry.Free;
FCon.Free;
CoUninitialize;
end;
end;
procedure TOpenQuery.Terminate;
begin
inherited;
PostThreadMessage(self.ThreadID,WM_quit,0,0);
//getmessage abbrechen
end;
procedure TOpenQuery.DoSQLCommand(
var msg:TMessage);
var sqltext:PString;
begin
sqlText:=PString(msg.LParam);
Fqry.active:=false;
Fqry.SQL.Text:=sqlText^;
dispose(sqlText);
Fqry.Open;
if not Fqry.eof
then
begin
FAnswer:=Fqry.FieldByName('
zahl').AsInteger;
synchronize(DoSQLEvent);
end;
//else Maintthread informieren
end;
procedure TOpenQuery.DoSQLNext(
var msg:TMessage);
begin
if (Fqry.Active)
and (
not Fqry.Eof)
then
begin
Fqry.Next;
FAnswer:=Fqry.FieldByName('
zahl').AsInteger;
synchronize(DoSQLEvent);
end;
// else an MainThread melden
end;
procedure TOpenQuery.DoSQLEvent;
begin
if assigned(FonSQLEvent)
then
FOnSQLevent(FAnswer);
end;
function TOpenquery.AskSQL(ASqlText:
string):boolean;
var SQLText:PString;
begin
new(SQLText);
SQLTExt^:=ASqlText;
result:=PostThreadMessage(self.ThreadID,DM_Ask,0,integer(SQLText));
if not result
then
dispose(SQLTExt);
end;
function TOpenQuery.NextSQL;
begin
result:=PostThreadMessage(self.ThreadID,DM_Next,0,0);
end;