Показать сообщение отдельно
  #25  
Старый 18.03.2015, 09:06
Аватар для Alex_4444
Alex_4444 Alex_4444 вне форума
Прохожий
 
Регистрация: 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.

Я торопился при написании кода. Могут быть мелкие ошибки. Но в целом идея должна быть понятна.
__________________
Самые сильные программисты были на заре компьютеризации.
И чем дольше я программист, тем больше это понимаю - мы до сих пор поддерживаем их код...
Ответить с цитированием