Здесь я привожу полный исходный код многопоточного приложения, который можно использовать в качестве шаблона для чего-то более сложного. Данный пример запускает в отдельном потоке код, выполняющий запрос к базе данных через ADO (использовался oracle).

Для компиляции использовался Delphi XE2, в более старых версиях возможно понадобится изменить названия подключаемых модулей. На форме разместите кнопку, мемо, таймер.

Остальное, думаю, будет понятно из комментариев по тексту программы.

unit main;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.Win.ADODB, ActiveX, System.DateUtils, FMX.Types,
Vcl.ExtCtrls, Vcl.StdCtrls;

type
TfmMain = class(TForm)
Memo1: TMemo;
Button1: TButton;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TADOQThread = class(TThread)
private
ADOcon:TADOConnection;
ADOq:TADOQuery;
LogStr:widestring;
delta:int64;
procedure updlabel;
public
ThNum:uint64;
ConStr:widestring;
protected
procedure Execute; override;
end;


var
fmMain: TfmMain;
ADOConString,LogFileName:widestring; //настройки
TestRunning:boolean; //тест идет-остановлен
adoqt:TADOQThread; //функционал реализован в потоке
nseq:uint64; //идентификатор потока

implementation

{$R *.dfm}

procedure TADOQThread.updlabel;
//Взаимодействие с VCL вызывается через Synchronize в потоке
begin
fmMain.Memo1.Lines.Add(LogStr);
fmMain.Memo1.SetFocus;
fmMain.Perform(WM_KEYDOWN, VK_END, 0);
end;

procedure TADOQThread.Execute;
var
ServerAnswer:widestring;
dtBeg,dtEnd:TDateTime;
begin
inherited;

CoInitialize(nil); //потому что ADO в потоке
ADOcon:=TADOConnection.Create(nil);
ADOcon.ConnectionString:=ConStr; ADOcon.LoginPrompt:=False;
LogStr:=IntToStr(ThNum)+',';
dtBeg:=Now;
try
ADOCon.Connected:=True;
except
on e: Exception do begin
ADOCon.Free;
LogStr:=LogStr+FormatDateTime('hh:nn:ss.zzz',Now)+',11111,'+E.Message;
delta:=11111; //признак ошибки - задержка на 11111 мс
Synchronize(updlabel); //взаимодействие с формой
CoUninitialize(); //потому что ADO в потоке
Exit;
end;
end;
ADOq:=TADOQuery.Create(nil);
ADOq.Connection:=ADOcon;
ADOq.SQL.Clear;
ADOq.SQL.Add('select to_char(sysdate, ''DD-MM-YYYY HH24:MI:SS'') as ddd from dual');
ADOq.Prepared:=True;
try
ADOq.Active:=True;
except
on e: Exception do begin
ADOCon.Free;
ADOq.Free;
LogStr:=LogStr+FormatDateTime('hh:nn:ss.zzz',Now)+',11111,'+E.Message;
delta:=11111; //признак ошибки - задержка на 11111 мс
Synchronize(updlabel); //взаимодействие с формой
CoUninitialize(); //потому что ADO в потоке
Exit;
end;
end;
dtEnd:=Now;
ServerAnswer:=ADOq.FieldByName('ddd').AsString;
ADOq.Free; ADOCon.Free;
delta:=MilliSecondsBetween(dtEnd,dtBeg); //задержка ответа от сервера (подключение + простой запрос)
LogStr:=LogStr+FormatDateTime('hh:nn:ss.zzz',Now)+','+IntToStr(delta)+','+ServerAnswer;
Synchronize(updlabel); //взаимодействие с формой
CoUninitialize(); //потому что ADO в потоке
end;


procedure TfmMain.Button1Click(Sender: TObject);
begin
TestRunning:=not TestRunning;
end;

procedure TfmMain.FormCreate(Sender: TObject);
var
str:WideString;
begin
TestRunning:=False;
nseq:=0;
fmMain.Memo1.Lines.Clear;
ADOConString:='Provider=OraOLEDB.Oracle.1;Persist Security Info=False;User ID=/;Data Source=testdb';
LogFileName:=ChangeFileExt(ExpandFileName(ParamStr(0)),'.log');
end;

procedure TfmMain.Timer1Timer(Sender: TObject);
begin
if TestRunning then begin
if (nseq mod 100)=0 then begin
try
//периодически сохранять лог во временном файле
fmMain.Memo1.Lines.SaveToFile(LogFileName);
except
on e: Exception do begin
// Application.MessageBox('Ошибка записи во временный файл ','Error');
end;
end;
end;
adoqt:=TADOQThread.Create(true); //создать поток с отложенным запуском
adoqt.FreeOnTerminate:=true; //уничтожать по окончании потока
adoqt.Priority:=tpLower;
adoqt.ThNum:=nseq; inc(nseq);
adoqt.ConStr:=ADOConString;
adoqt.Resume; //запустить поток
end;
end;

end.

Добавить комментарий
  • Комментарии не найдены