XML Loading is executed in another thread

diff --git a/bottleclient/LogForm.pas b/bottleclient/LogForm.pas
index 3dd07a5..939a2e7 100755 (executable)
--- a/bottleclient/LogForm.pas
+++ b/bottleclient/LogForm.pas
@@ -903,15 +903,17 @@ begin
     for i := 0 to OpenDialog.Files.Count-1 do begin
       BottleLog := TBottleLogList.Create(ExtractFileName(OpenDialog.Files[i]));
       try
-        BottleLog.LoadFromXMLFile(OpenDialog.Files[i]);
-      except
-        on E: EXMLFileOpenException do begin
-          Beep;
-          ShowMessage(E.Message);
-          FreeAndNil(BottleLog);
+        with BottleLog do
+        begin
+          OnLoaded := LogLoaded;
+          OnLoadFailure := LogLoadFailure;
+          OnLoadWork := LogLoadWork;
+          BottleLog.LoadFromXMLFile(OpenDialog.Files[i]);
         end;
+        Index := BottleLogList.Add(BottleLog); // \8dÅ\8cã\82É\8aJ\82¢\82½\83\8d\83O\82Ì\88Ê\92u\82ð\8bL\89¯
+      except
+        BottleLog.Free;
       end;
-      if BottleLog <> nil then Index := BottleLogList.Add(BottleLog); // \8dÅ\8cã\82É\8aJ\82¢\82½\83\8d\83O\82Ì\88Ê\92u\82ð\8bL\89¯
     end;
     UpdateTab;
     if Index >= 0 then tabBottleLog.TabIndex := Index;

diff --git a/bottleclient/Logs.pas b/bottleclient/Logs.pas
index 1f72a0b..4e443d8 100755 (executable)
--- a/bottleclient/Logs.pas
+++ b/bottleclient/Logs.pas
@@ -62,10 +62,33 @@ type
     Channel: string;
   end;
 
+  TLogXMLThread = class(TThread)
+  private
+    FList: TObjectList;
+    FFileName: String;
+    FOnLoadFailure: TBottleLogLoadFailureEvent;
+    FOnLoaded: TNotifyEvent;
+    FLoadFailureMessage: String;
+    procedure SetOnLoaded(const Value: TNotifyEvent);
+    procedure SetOnLoadFailure(const Value: TBottleLogLoadFailureEvent);
+  protected
+    procedure Execute; override;
+    procedure DoLoaded;
+    procedure DoLoadFailure;
+  public
+    property OnLoaded: TNotifyEvent read FOnLoaded write SetOnLoaded;
+    property OnLoadFailure: TBottleLogLoadFailureEvent
+      read FOnLoadFailure write SetOnLoadFailure;
+    property List: TObjectList read FList;
+    constructor Create(FileName: String);
+    destructor Destroy; override;
+  end;
+
   TBottleLogList = class(TObjectList)
   private
     FOnLoaded: TNotifyEvent;
     FHttpThread: THTTPDownloadThread;
+    FXMLThread: TLogXMLThread;
     FLoadBytes: integer;
     FTitle: String;
     FOnLoadFailure: TBottleLogLoadFailureEvent;
@@ -79,6 +102,8 @@ type
     procedure HttpSuccess(Sender: TObject);
     procedure HttpFailure(Sender: TObject);
     procedure HttpWork(Sender: TObject; LoadBytes: integer);
+    procedure XMLLoaded(Sener: TObject);
+    procedure XMLLoadFailure(Sender: TObject; const Message: String);
     procedure SetTitle(const Value: String);
     procedure SetOnLoadFailure(const Value: TBottleLogLoadFailureEvent);
     procedure SetSelectedIndex(const Value: integer);
@@ -301,7 +326,8 @@ end;
 
 procedure TBottleLogList.HttpFailure(Sender: TObject);
 begin
-  if Assigned(FOnLoadFailure) then DoLoadFailure('\83T\81[\83o\82Ì\90Ú\91±\82É\8e¸\94s\82µ\82Ü\82µ\82½');
+  if Assigned(FOnLoadFailure) then
+    DoLoadFailure('\83T\81[\83o\82Ì\90Ú\91±\82É\8e¸\94s\82µ\82Ü\82µ\82½');
 end;
 
 procedure TBottleLogList.HttpSuccess(Sender: TObject);
@@ -429,92 +455,16 @@ begin
 end;
 
 procedure TBottleLogList.LoadFromXMLFile(const FileName: String);
-var i, j, votes, agrees: integer;
-    Time: TDateTime;
-    ANode, Child: TdomElement;
-    Item: TLogItem;
-    DOM: TdomDocument;
-    Parser: TXmlToDomParser;
-    Impl: TDomImplementation;
-    Str, mid, channel, script, ghost: String;
 begin
   Self.Clear;
-  Impl := TDomImplementation.create(nil);
-  try
-    Parser := TXmlToDomParser.create(nil);
-    Parser.DOMImpl := Impl;
-    try
-      try
-        Screen.Cursor := crHourGlass;
-        DOM := Parser.fileToDom(FileName); //\82±\82ê\82Í\96¾\8e¦\93I\82ÉFree\82µ\82È\82­\82Ä\82æ\82¢
-        DOM.normalize;
-        if not DOM.validate(nil, erReplace) then
-          raise EXMLFileOpenException.Create('\97L\8cø\82È\83{\83g\83\8b\83\8d\83O\8c`\8e®\82Å\82Í\82 \82è\82Ü\82¹\82ñ\81B');
-        with DOM do
-        begin
-          if DocumentElement = nil then
-            raise EXMLFileOpenException.Create('\97L\8cø\82È\8c`\8e®\82Å\82Í\82 \82è\82Ü\82¹\82ñ\81B\83\8b\81[\83g\83^\83O\82ª\82 \82è\82Ü\82¹\82ñ');
-          if DocumentElement.nodeName <> 'bottlelog' then
-            raise EXMLFileOpenException.Create('\97L\8cø\82È\8c`\8e®\82Å\82Í\82 \82è\82Ü\82¹\82ñ\81Bbottlelog\82ª\8c©\82Â\82©\82è\82Ü\82¹\82ñ');
-          Str :=  DocumentElement.getAttribute('version');
-          if Str <> '1.0' then
-            raise EXMLFileOpenException.CreateFmt('\97L\8cø\82È\8c`\8e®\82Å\82Í\82 \82è\82Ü\82¹\82ñ\81B'+
-              '\82±\82Ì\83\8d\83O\83t\83@\83C\83\8b\82Ì\83o\81[\83W\83\87\83\93(%s)\82Í\93Ç\82Ý\8d\9e\82ß\82Ü\82¹\82ñ', [Str]);
-
-          for i := 0 to DocumentElement.childNodes.length-1 do
-          begin
-            if documentElement.childNodes.item(i).nodeType <> ntElement_Node then
-              Continue;
-            ANode := documentElement.childNodes.item(i) as TdomElement;
-            if ANode.nodeName <> 'message' then
-              Continue;
-            mid := ANode.getAttribute('mid');
-            channel := '';
-            script := '';
-            ghost := '';
-            votes := 0;
-            agrees := 0;
-            Time := Now;
-            for j := 0 to ANode.childNodes.length-1 do
-            begin
-              if ANode.childNodes.item(j).nodeType <> ntElement_Node then
-                Continue;
-              Child := ANode.childNodes.item(j) as TdomElement;
-              if Child.nodeName = 'channel' then
-                channel := Trim(Child.textContent)
-              else if Child.nodeName = 'script' then
-                script := Trim(Child.textContent)
-              else if Child.nodeName = 'ghost' then
-                ghost := Trim(Child.textContent)
-              else if Child.nodeName = 'votes' then
-                votes := StrToIntDef(Child.textContent, 0)
-              else if Child.nodeName = 'agrees' then
-                agrees := StrToIntDef(Child.textContent, 0)
-              else if Child.nodeName = 'date' then
-                TryStrToDateTime(Trim(Child.textContent), Time);
-            end;
-            Item := TLogItem.Create(ltBottle, mid, channel, script, ghost, time);
-            Item.Votes  := votes;
-            Item.Agrees := agrees;
-            Item.State := lsOpened;
-            try
-              Self.Add(Item);
-            except
-              Item.Free;
-            end;
-          end;
-        end;
-      except
-        on E: EParserException do
-          raise EXMLFileOpenException.Create('XML\89ð\90Í\83G\83\89\81[' + E.Message);
-      end;
-    finally
-      Parser.DOMImpl.freeDocument(DOM);
-      Parser.Free;
-    end;
-  finally
-    Impl.Free;
-    Screen.Cursor := crDefault;
+  AddSystemLog('\83\8d\81[\83h\92\86...');
+  FXMLThread := TLogXMLThread.Create(FileName);
+  FXMLThread.FreeOnTerminate := true; // \8f\9f\8eè\82É\8fÁ\82¦\82Ä\82à\82ç\82¤
+  with FXMLThread do
+  begin
+    OnLoaded := XMLLoaded;
+    OnLoadFailure := XMLLoadFailure;
+    Resume;
   end;
 end;
 
@@ -677,4 +627,168 @@ begin
   FOldSortDesc := ASortDesc;
 end;
 
+procedure TBottleLogList.XMLLoaded(Sener: TObject);
+begin
+  Self.Assign(FXMLThread.List);
+  if Assigned(FOnLoaded) then FOnLoaded(Self);
+  FXMLThread := nil;
+end;
+
+procedure TBottleLogList.XMLLoadFailure(Sender: TObject;
+  const Message: String);
+begin
+  if Assigned(FOnLoadFailure) then
+    DoLoadFailure(Message);
+end;
+
+{ TLogXMLThread }
+
+constructor TLogXMLThread.Create(FileName: String);
+begin
+  inherited Create(true);
+  FList := TObjectList.Create(false); // OwnsObject = false (!!)
+  FFileName := FileName;
+end;
+
+destructor TLogXMLThread.Destroy;
+begin
+  FList.Free;
+  inherited;
+end;
+
+procedure TLogXMLThread.DoLoaded;
+begin
+  if Assigned(FOnLoaded) then
+    FOnLoaded(self);
+end;
+
+procedure TLogXMLThread.DoLoadFailure;
+begin
+  if Assigned(FOnLoadFailure) then
+    FOnLoadFailure(self, FLoadFailureMessage);
+end;
+
+procedure TLogXMLThread.Execute;
+var i, j, votes, agrees: integer;
+    Time: TDateTime;
+    ANode, Child: TdomElement;
+    Item: TLogItem;
+    DOM: TdomDocument;
+    Parser: TXmlToDomParser;
+    Impl: TDomImplementation;
+    Str, mid, channel, script, ghost: String;
+begin
+  FList.Clear;
+  Impl := TDomImplementation.create(nil);
+  try
+    Parser := TXmlToDomParser.create(nil);
+    Parser.DOMImpl := Impl;
+    try
+      try
+        DOM := Parser.fileToDom(FFileName); //\82±\82ê\82Í\96¾\8e¦\93I\82ÉFree\82µ\82È\82­\82Ä\82æ\82¢
+        DOM.normalize;
+        if not DOM.validate(nil, erReplace) then
+          raise EXMLFileOpenException.Create('\97L\8cø\82È\83{\83g\83\8b\83\8d\83O\8c`\8e®\82Å\82Í\82 \82è\82Ü\82¹\82ñ\81B');
+        with DOM do
+        begin
+          if DocumentElement = nil then
+          begin
+            FLoadFailureMessage := '\97L\8cø\82È\8c`\8e®\82Å\82Í\82 \82è\82Ü\82¹\82ñ\81B' +
+             '\83\8b\81[\83g\83^\83O\82ª\82 \82è\82Ü\82¹\82ñ';
+            Synchronize(DoLoadFailure);
+            Exit;
+          end;
+          if DocumentElement.nodeName <> 'bottlelog' then
+          begin
+            FLoadFailureMessage := '\97L\8cø\82È\8c`\8e®\82Å\82Í\82 \82è\82Ü\82¹\82ñ\81B' +
+              'bottlelog\82ª\8c©\82Â\82©\82è\82Ü\82¹\82ñ';
+            Synchronize(DoLoadFailure);
+            Exit;
+          end;
+          Str :=  DocumentElement.getAttribute('version');
+          if Str <> '1.0' then
+          begin
+            FLoadFailureMessage := Format('\97L\8cø\82È\8c`\8e®\82Å\82Í\82 \82è\82Ü\82¹\82ñ\81B' +
+              '\82±\82Ì\83\8d\83O\83t\83@\83C\83\8b\82Ì\83o\81[\83W\83\87\83\93(%s)\82Í\93Ç\82Ý\8d\9e\82ß\82Ü\82¹\82ñ', [Str]);
+            Synchronize(DoLoadFailure);
+            Exit;
+          end;
+          for i := 0 to DocumentElement.childNodes.length-1 do
+          begin
+            if documentElement.childNodes.item(i).nodeType <> ntElement_Node then
+              Continue;
+            ANode := documentElement.childNodes.item(i) as TdomElement;
+            if ANode.nodeName <> 'message' then
+              Continue;
+            mid := ANode.getAttribute('mid');
+            channel := '';
+            script := '';
+            ghost := '';
+            votes := 0;
+            agrees := 0;
+            Time := Now;
+            for j := 0 to ANode.childNodes.length-1 do
+            begin
+              if ANode.childNodes.item(j).nodeType <> ntElement_Node then
+                Continue;
+              Child := ANode.childNodes.item(j) as TdomElement;
+              if Child.nodeName = 'channel' then
+                channel := Trim(Child.textContent)
+              else if Child.nodeName = 'script' then
+                script := Trim(Child.textContent)
+              else if Child.nodeName = 'ghost' then
+                ghost := Trim(Child.textContent)
+              else if Child.nodeName = 'votes' then
+                votes := StrToIntDef(Child.textContent, 0)
+              else if Child.nodeName = 'agrees' then
+                agrees := StrToIntDef(Child.textContent, 0)
+              else if Child.nodeName = 'date' then
+                TryStrToDateTime(Trim(Child.textContent), Time);
+            end;
+            Item := TLogItem.Create(ltBottle, mid, channel, script, ghost, time);
+            Item.Votes  := votes;
+            Item.Agrees := agrees;
+            Item.State := lsOpened;
+            try
+              FList.Add(Item);
+            except
+              Item.Free;
+            end;
+          end;
+          Synchronize(DoLoaded);
+        end;
+      except
+        on E: EParserException do
+        begin
+          FLoadFailureMessage := 'XML\89ð\90Í\83G\83\89\81[\81B' + E.Message;
+          Synchronize(DoLoadFailure);
+          Exit;
+        end;
+        on E: Exception do
+        begin
+          FLoadFailureMessage := 'XML\83I\81[\83v\83\93\8e\9e\82É\83G\83\89\81[\82ª\94­\90¶\82µ\82Ü\82µ\82½\81B' +
+            E.Message;
+          Synchronize(DoLoadFailure);
+          Exit;
+        end;
+      end;
+    finally
+      Parser.DOMImpl.freeDocument(DOM);
+      Parser.Free;
+    end;
+  finally
+    Impl.Free;
+  end;
+end;
+
+procedure TLogXMLThread.SetOnLoaded(const Value: TNotifyEvent);
+begin
+  FOnLoaded := Value;
+end;
+
+procedure TLogXMLThread.SetOnLoadFailure(const Value: TBottleLogLoadFailureEvent);
+begin
+  FOnLoadFailure := Value;
+end;
+
 end.