
18.03.2015, 09:06
|
 |
Прохожий
|
|
Регистрация: 22.12.2014
Сообщения: 14
Версия Delphi: XE5
Репутация: 50
|
|
Код:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Xml.xmldom, Xml.XMLIntf, Vcl.StdCtrls,
Xml.Win.msxmldom, Xml.XMLDoc;
type
TForm1 = class(TForm)
XMLDocument1: TXMLDocument;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
procedure AreYouReady(Sender: TObject; AsyncLoadState : integer);
procedure LetsCreateOurThreads;
public
{ Public declarations }
end;
MyThread = class(TThread)
private
FCountNodes : integer;
FStartNode : integer;
FEndNode : integer;
FNode : IXMLNode;
protected
procedure Execute; override;
public
constructor Create(CountNodes, StartNode: integer;
Node: IXMLNode; CreateSuspended: Boolean);
destructor Destroy; override;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.AreYouReady(Sender: TObject; AsyncLoadState: integer);
begin
if AsyncLoadState = 4 then
begin
LetsCreateOurThreads;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
XMLDocument1.FileName := '';
XMLDocument1.ParseOptions := [poAsyncLoad]; // это должно активировать
// нативный механизм потоков
// парсинга. За нас уже всё продумано.
XMLDocument1.OnAsyncLoad := AreYouReady; // т.к. парсинг в нативных потоках,
// то необходимо дождаться его.
XMLDocument1.Active := true;
end;
procedure TForm1.LetsCreateOurThreads;
var
MyNode : IXMLNode;
i,
childCount,
whole,
modulo,
start,
threadCount : integer;
tempThread : MyThread;
begin
threadCount := 5; // максимальное количество одновременно работающих потоков
MyNode := XMLDocument1.DocumentElement;
childCount := MyNode.ChildNodes.Count;
whole := childCount div threadCount; // количество веток на один поток
modulo := childCount mod threadCount; // остаток веток - мы его в первый поток отдадим
// Создаем первый поток
// можно да и нужно создавать TtreadList для контроля за потоками но я пропустил его
// для наглядности кода
tempThread := MyThread.Create(whole + modulo - 1, 0, MyNode, false);
start := whole + modulo;
if childCount > 1 then
begin
for i := 2 to ThreadCount do
begin
tempThread := MyThread.Create(whole, start, MyNode, false);
start := start + whole;
end;
end;
end;
{ MyThread }
constructor MyThread.Create(CountNodes, StartNode: integer;
Node: IXMLNode; CreateSuspended: Boolean);
begin
inherited Create(CreateSuspended);
FNode := Node;
FCountNodes := CountNodes;
FStartNode := StartNode;
FEndNode := StartNode + CountNodes;
// здесь создашь все коннекты: к БД и т.п
end;
destructor MyThread.Destroy;
begin
// здесь удалишь все коннекты: к БД и т.п.
inherited;
end;
procedure MyThread.Execute;
var
i : integer;
tempNode : IXMLNode;
txtObjNr,
txtObjCity,
txtObjAddress : string;
begin
for i := FStartNode to FEndNode do
begin
tempNode := FNode.ChildNodes[i];
txtObjNr := tempNode.ChildValues['T_Number'];
txtObjCity := tempNode.ChildValues['City'];
txtObjAddress := tempNode.ChildValues['Street'];
// и выкидывай txtObj--- в базу данных
end;
//если всё норм выходи из потока
end;
end.
Я торопился при написании кода. Могут быть мелкие ошибки. Но в целом идея должна быть понятна.
__________________
Самые сильные программисты были на заре компьютеризации.
И чем дольше я программист, тем больше это понимаю - мы до сих пор поддерживаем их код...
|