bottleclient/Logs.pas

   1 unit Logs;
   2
   3 interface
   4
   5 uses
   6   Contnrs, Controls, Classes, SysUtils, Dialogs, Forms, HttpThread, BottleDef,
   7   DateUtils, IdURI, XDOM_2_3_J3;
   8
   9 type
  10
  11   TLogType = (ltBottle, ltSystemLog);
  12   TLogState = (lsUnopened, lsPlaying, lsOpened);
  13
  14   TLogItem = class(TPersistent)
  15   private
  16     FScript: String;
  17     FChannel: String;
  18     FMID: String;
  19     FLogTime: TDateTime;
  20     FLogType: TLogType;
  21     FGhost: String;
  22     FVotes: Integer;
  23     FAgreements: Integer;
  24     FState: TLogState;
  25     procedure SetChannel(const Value: String);
  26     procedure SetLogType(const Value: TLogType);
  27     procedure SetMID(const Value: String);
  28     procedure SetScript(const Value: String);
  29     procedure SetLogTime(const Value: TDateTime);
  30     procedure SetGhost(const Value: String);
  31     procedure SetVotes(const Value: Integer);
  32     procedure SetAgreements(const Value: Integer);
  33     procedure SetState(const Value: TLogState);
  34   public
  35     constructor Create(LogType: TLogType; const MID, Channel, Script,
  36       Ghost: String; LogTime: TDateTime); overload;
  37     constructor Create(Source: TLogItem); overload;
  38     property LogType: TLogType read FLogType write SetLogType;
  39     property MID: String read FMID write SetMID;
  40     property Channel: String read FChannel write SetChannel;
  41     property LogTime: TDateTime read FLogTime write SetLogTime;
  42     property Script: String read FScript write SetScript;
  43     property Ghost: String read FGhost write SetGhost;
  44     property Votes: Integer read FVotes write SetVotes;
  45     property Agrees: Integer read FAgreements write SetAgreements;
  46     property State: TLogState read FState write SetState;
  47     procedure Assign(Source: TPersistent); override;
  48   end;
  49
  50   TBottleLogSortType = (stLogTime, stChannel, stGhost, stScript, stVote, stAgree);
  51   TBottleLogLoadFailureEvent = procedure(Sender: TObject; const Message: String) of object;
  52
  53   EXMLFileOpenException = class(Exception);
  54
  55   TBottleLogDownLoadCondition = packed record
  56     IsRange: boolean;
  57     RecentCount: integer;
  58     DateLo: TDateTime;
  59     DateHi: TDateTime;
  60     MinVote: integer;
  61     MinAgree: integer;
  62     Channel: string;
  63   end;
  64
  65   TLogXMLThread = class(TThread)
  66   private
  67     FList: TObjectList;
  68     FFileName: String;
  69     FOnLoadFailure: TBottleLogLoadFailureEvent;
  70     FOnLoaded: TNotifyEvent;
  71     FLoadFailureMessage: String;
  72     procedure SetOnLoaded(const Value: TNotifyEvent);
  73     procedure SetOnLoadFailure(const Value: TBottleLogLoadFailureEvent);
  74   protected
  75     procedure Execute; override;
  76     procedure DoLoaded;
  77     procedure DoLoadFailure;
  78   public
  79     property OnLoaded: TNotifyEvent read FOnLoaded write SetOnLoaded;
  80     property OnLoadFailure: TBottleLogLoadFailureEvent
  81       read FOnLoadFailure write SetOnLoadFailure;
  82     property List: TObjectList read FList;
  83     constructor Create(FileName: String);
  84     destructor Destroy; override;
  85   end;
  86
  87   TBottleLogList = class(TObjectList)
  88   private
  89     FOnLoaded: TNotifyEvent;
  90     FHttpThread: THTTPDownloadThread;
  91     FXMLThread: TLogXMLThread;
  92     FLoadBytes: integer;
  93     FTitle: String;
  94     FOnLoadFailure: TBottleLogLoadFailureEvent;
  95     FOldSortColumn: TBottleLogSortType; // \83\8d\83O\91\8b
  96     FOldSortDesc: boolean;   // \83\8d\83O\91\8b
  97     FSelectedIndex: integer;
  98     FOnLoadWork: TNotifyEvent; // \83\8d\83O\91\8b
  99
 100     function GetBottles(Index: integer): TLogItem;
 101     procedure SetOnLoaded(const Value: TNotifyEvent);
 102     procedure HttpSuccess(Sender: TObject);
 103     procedure HttpFailure(Sender: TObject);
 104     procedure HttpWork(Sender: TObject; LoadBytes: integer);
 105     procedure XMLLoaded(Sener: TObject);
 106     procedure XMLLoadFailure(Sender: TObject; const Message: String);
 107     procedure SetTitle(const Value: String);
 108     procedure SetOnLoadFailure(const Value: TBottleLogLoadFailureEvent);
 109     procedure SetSelectedIndex(const Value: integer);
 110     procedure SetOnLoadWork(const Value: TNotifyEvent);
 111     procedure DoLoadFailure(const ErrorMessage: String);
 112   public
 113     constructor Create(const Title: String);
 114     destructor Destroy; override;
 115     procedure SortBottles(LogSortType: TBottleLogSortType);
 116     function Bottle(MID: String): TLogItem;
 117     property Bottles[Index: integer]: TLogItem read GetBottles;
 118     procedure LoadFromWeb(const Cond: TBottleLogDownloadCondition);
 119     property Title: String read FTitle write SetTitle;
 120     procedure LoadFromStream(Stream: TStream);
 121     property OnLoaded: TNotifyEvent read FOnLoaded write SetOnLoaded;
 122     property OnLoadWork: TNotifyEvent read FOnLoadWork write SetOnLoadWork;
 123     property OnLoadFailure: TBottleLogLoadFailureEvent read FOnLoadFailure write SetOnLoadFailure;
 124     property SelectedIndex: integer read FSelectedIndex write SetSelectedIndex;
 125     procedure AddScriptLog(const Script, Channel, MID, Ghost: String);
 126     procedure AddSystemLog(const MessageString: String);
 127     procedure SaveToText(const FileName: String);
 128     procedure SaveToSstpLog(const FileName: String;
 129       const WithChannel: boolean = false);
 130     procedure SaveToXMLFile(const FileName: String);
 131     procedure LoadFromXMLFile(const FileName: String);
 132   end;
 133
 134 var
 135   ASortType: TBottleLogSortType; //LogCompare\8aÖ\90\94\82©\82ç\8c©\82¦\82é\82æ\82¤\82É\88ê\8e\9e\91Þ\94ð\97p
 136   ASortDesc: boolean;
 137
 138 function LogCompare(Item1, Item2: Pointer): integer;
 139
 140
 141 ////////////////////////////////////////////////////////////////////////////////
 142 implementation
 143
 144 function LogCompare(Item1, Item2: Pointer): Integer;
 145 var
 146   Log1, Log2: TLogItem;
 147 begin
 148   Log1 := TLogItem(Item1);
 149   Log2 := TLogItem(Item2);
 150   Result := 0;
 151   case ASortType of
 152     stLogTime: begin
 153       Result := AnsiCompareStr(Log2.MID, Log1.MID);
 154     end;
 155     stChannel: begin
 156       Result := AnsiCompareStr(Log1.Channel, Log2.Channel);
 157     end;
 158     stGhost: begin
 159       Result := AnsiCompareStr(Log1.Ghost, Log2.Ghost);
 160     end;
 161     stScript: begin
 162       Result := AnsiCompareStr(Log1.Script, Log2.Script);
 163     end;
 164     stVote: begin
 165       Result := Log2.Votes - Log1.Votes;
 166     end;
 167     stAgree: begin
 168       Result := Log2.Agrees - Log1.Agrees;
 169     end;
 170   end;
 171   if ASortDesc then Result := -Result; //\8f¸\8f\87
 172 end;
 173
 174 { TLogItem }
 175
 176 constructor TLogItem.Create(LogType: TLogType; const MID, Channel, Script,
 177   Ghost: String; LogTime: TDateTime);
 178 begin
 179   Self.LogType := LogType;
 180   Self.MID := MID;
 181   Self.Script := Script;
 182   Self.Channel := Channel;
 183   Self.Ghost := Ghost;
 184   Self.LogTime := LogTime;
 185   Self.State := lsUnopened;
 186 end;
 187
 188 procedure TLogItem.SetChannel(const Value: String);
 189 begin
 190   FChannel := Value;
 191 end;
 192
 193 procedure TLogItem.SetLogType(const Value: TLogType);
 194 begin
 195   FLogType := Value;
 196 end;
 197
 198 procedure TLogItem.SetMID(const Value: String);
 199 begin
 200   FMID := Value;
 201 end;
 202
 203 procedure TLogItem.SetScript(const Value: String);
 204 begin
 205   FScript := Value;
 206 end;
 207
 208 procedure TLogItem.SetLogTime(const Value: TDateTime);
 209 begin
 210   FLogTime := Value;
 211 end;
 212
 213 procedure TLogItem.SetAgreements(const Value: Integer);
 214 begin
 215   FAgreements := Value;
 216 end;
 217
 218 procedure TLogItem.SetVotes(const Value: Integer);
 219 begin
 220   FVotes := Value;
 221 end;
 222
 223 procedure TLogItem.SetGhost(const Value: String);
 224 begin
 225   FGhost := Value;
 226 end;
 227
 228
 229 procedure TLogItem.SetState(const Value: TLogState);
 230 begin
 231   FState := Value;
 232 end;
 233
 234 procedure TLogItem.Assign(Source: TPersistent);
 235 var Src: TLogItem;
 236 begin
 237   if not (Source is TLogItem) then
 238     inherited
 239   else begin
 240     Src := Source as TLogItem;
 241     self.FScript := Src.FScript;
 242     self.FChannel := Src.FChannel;
 243     self.FMID := Src.FMID;
 244     self.FLogTime := Src.FLogTime;
 245     self.FLogType := Src.FLogType;
 246     self.FGhost := Src.FGhost;
 247     self.FVotes := Src.FVotes;
 248     self.FAgreements := Src.FAgreements;
 249     self.FState := Src.FState;
 250   end;
 251 end;
 252
 253 constructor TLogItem.Create(Source: TLogItem);
 254 begin
 255   self.Assign(Source);
 256 end;
 257
 258 { TBottleLogList }
 259
 260 procedure TBottleLogList.AddScriptLog(const Script, Channel, MID,
 261   Ghost: String);
 262 var LogItem: TLogItem;
 263 begin
 264   LogItem := TLogItem.Create(ltBottle, MID, Channel, Script, Ghost, Now());
 265   try
 266     Insert(0, LogItem);
 267   except
 268     LogItem.Free;
 269     raise;
 270   end;
 271 end;
 272
 273 procedure TBottleLogList.AddSystemLog(const MessageString: String);
 274 var LogItem: TLogItem;
 275 begin
 276   LogItem := TLogItem.Create(ltSystemLog, '', '', MessageString, '', Now());
 277   try
 278     Insert(0, LogItem);
 279   except
 280     LogItem.Free;
 281     raise;
 282   end;
 283 end;
 284
 285 function TBottleLogList.Bottle(MID: String): TLogItem;
 286 var i: integer;
 287 begin
 288   Result := nil;
 289   for i := 0 to Count-1 do
 290     if (Items[i] as TLogItem).MID = MID then begin
 291       Result := Items[i] as TLogItem;
 292       exit;
 293     end;
 294 end;
 295
 296 constructor TBottleLogList.Create(const Title: String);
 297 begin
 298   inherited Create;
 299   FTitle := Title;
 300   OwnsObjects := true;
 301   FSelectedIndex := -1; // \91I\91ð\82³\82ê\82Ä\82¢\82È\82¢
 302 end;
 303
 304 destructor TBottleLogList.Destroy;
 305 begin
 306   inherited;
 307   // FHttpThread\82Í\8e©\95ª\82ðFree\82·\82é\81u\91O\81v\82ÉSynchronize\82Å\8eQ\8fÆ\82ª\8dí\8f\9c\82³\82ê\82é\82Ì\82Å\81A
 308   // FHttpThread <> nil \82È\82ç\8eÀ\91Ì\82ª\91¶\8dÝ\82·\82é\82±\82Æ\82Í\8am\8eÀ\82Å\82 \82é\81B
 309   if FHttpThread <> nil then begin
 310     FHttpThread.OnSuccess := nil;
 311     FHttpThread.OnConnectionFailed := nil;
 312   end;
 313 end;
 314
 315 procedure TBottleLogList.DoLoadFailure(const ErrorMessage: String);
 316 begin
 317   self.Clear;
 318   self.AddSystemLog(ErrorMessage);
 319   if Assigned(FOnLoadFailure) then FOnLoadFailure(self, ErrorMessage);
 320 end;
 321
 322 function TBottleLogList.GetBottles(Index: integer): TLogItem;
 323 begin
 324   Result := Items[Index] as TLogItem;
 325 end;
 326
 327 procedure TBottleLogList.HttpFailure(Sender: TObject);
 328 begin
 329   if Assigned(FOnLoadFailure) then
 330     DoLoadFailure('\83T\81[\83o\82Ì\90Ú\91±\82É\8e¸\94s\82µ\82Ü\82µ\82½');
 331 end;
 332
 333 procedure TBottleLogList.HttpSuccess(Sender: TObject);
 334 var Stream: TStringStream;
 335     StrList: TStringList;
 336 begin
 337   Stream := TStringStream.Create(FHttpThread.RecvString);
 338   try
 339     StrList := TStringList.Create;
 340     try
 341       StrList.Text := Stream.DataString;
 342       if StrList[0] <> 'Result: OK' then begin
 343         if Assigned(FOnLoadFailure) then
 344           DoLoadFailure('\83T\81[\83o\82ª\83G\83\89\81[\82ð\95Ô\82µ\82Ü\82µ\82½'#13#10 + Stream.DataString);
 345       end else begin
 346         while StrList.Count > 0 do
 347           if StrList[0] <> '' then StrList.Delete(0) else Break; //\83w\83b\83_\81[\82ð\8dí\8f\9c\82·\82é
 348         if StrList.Count > 0 then StrList.Delete(0); //\83w\83b\83_\81[\8cã\82Ì\8bó\8ds\8dí\8f\9c
 349         Stream.Seek(0, soFromBeginning);
 350         Stream.Size := Length(StrList.Text);
 351         Stream.WriteString(StrList.Text);
 352         Stream.Seek(0, soFromBeginning);
 353         LoadFromStream(Stream);
 354       end;
 355     finally
 356       StrList.Free;
 357     end;
 358   finally
 359     Stream.Free;
 360     // nil\82Å\82È\82¢\8fê\8d\87\82É\82Í\8eÀ\91Ì\82ª\91¶\8dÝ\82·\82é\82±\82Æ\82ð\8am\8eÀ\82É\82·\82é
 361     // \82½\82¾\82µ nil \82¾\82©\82ç\82Æ\82¢\82Á\82Ä\8eÀ\91Ì\82ª\91¶\8dÝ\82µ\82È\82¢\82Æ\82Í\8cÀ\82ç\82È\82¢(FreeOnTerminate\82Ì\82½\82ß)
 362     FHttpThread := nil;
 363   end;
 364 end;
 365
 366 procedure TBottleLogList.HttpWork(Sender: TObject; LoadBytes: integer);
 367 begin
 368   self.Clear;
 369   AddSystemLog(Format('\83_\83E\83\93\83\8d\81[\83h\92\86\82Å\82· - %4d KB', [LoadBytes div 1024]));
 370   FLoadBytes := LoadBytes;
 371   if Assigned(FOnLoadWork) then FOnLoadWork(self);
 372 end;
 373
 374 procedure TBottleLogList.LoadFromStream(Stream: TStream);
 375 var i: integer;
 376     SourceStream: TStringStream;
 377     Source: TStringList;
 378     LogItem: TLogItem;
 379   function S2D (const S: String): TDateTime;
 380   begin
 381     Result := EncodeDateTime(
 382       StrToInt(Copy(S, 1, 4)), StrToInt(Copy(S, 5, 2)), StrToInt(Copy(S, 7, 2)),
 383       StrToInt(Copy(S, 9, 2)), StrToInt(Copy(S, 11, 2)), StrToInt(Copy(S, 13, 2)), 0);
 384   end;
 385 begin
 386   Source := nil;
 387   SourceStream := nil;
 388   try
 389     try
 390       SourceStream := TStringStream.Create('');
 391       SourceStream.Seek(0, soFromBeginning);
 392       SourceStream.CopyFrom(Stream, Stream.Size);
 393       Source := TStringList.Create;
 394       Source.Text := SourceStream.DataString;
 395       i := 0;
 396       if Source.Count = 0 then begin
 397         DoLoadFailure('\8ew\92è\8fð\8c\8f\82Ì\83\8d\83O\82Í\91¶\8dÝ\82µ\82Ü\82¹\82ñ');
 398         Exit;
 399       end;
 400       if Source[0] <> 'OK' then begin
 401       end;
 402       Self.Clear;
 403       while (i + 7) < Source.Count do begin
 404         LogItem := TLogItem.Create(ltBottle, Source[i+1], Source[i+2],
 405           Source[i+7], Source[i+3], S2D(Source[i]));
 406         LogItem.Votes  := StrToInt(Source[i+5]);
 407         LogItem.Agrees := StrToInt(Source[i+6]);
 408         LogItem.State := lsOpened;
 409         i := i + 8;
 410         Self.Add(LogItem);
 411       end;
 412     finally
 413       SourceStream.Free;
 414       Source.Free;
 415     end;
 416   except
 417     On EConvertError do begin
 418       DoLoadFailure('\83T\81[\83o\89\9e\93\9a\82Ì\8c`\8e®\82ª\95s\90³\82Å\82·');
 419       Self.Clear;
 420     end;
 421   end;
 422   FOldSortColumn := stLogTime;
 423   FOldSortDesc := false;
 424   if Assigned(FOnLoaded) then FOnLoaded(Self);
 425 end;
 426
 427 procedure TBottleLogList.LoadFromWeb(const Cond: TBottleLogDownloadCondition);
 428 var Param: String;
 429 begin
 430   Self.Clear;
 431   AddSystemLog('\83_\83E\83\93\83\8d\81[\83h\92\86\82Å\82· - \83T\81[\83o\82©\82ç\89\9e\93\9a\91Ò\82¿');
 432   with Cond do begin
 433     if Cond.IsRange then begin
 434       Param := Format('year_lo=%d&month_lo=%d&day_lo=%d&year_hi=%d&month_hi=%d&day_hi=%d&',
 435         [YearOf(DateLo), MonthOf(DateLo), DayOf(DateLo),
 436          YearOf(DateHi), MonthOf(DateHi), DayOf(DateHi)]);
 437     end else begin
 438       Param := Format('recent=%d&', [RecentCount]);
 439     end;
 440     Param := Param + Format('minvote=%d&minagree=%d&channel=%s&sort=timedesc&delimiter=%%0D%%0A',
 441       [MinVote, MinAgree, TIdURI.ParamsEncode(Channel)]);
 442   end;
 443   FHttpThread := THTTPDownloadThread.Create(BottleServer, Pref.CgiFetchLog, Param);
 444   if Pref.UseHttpProxy then begin
 445     FHttpThread.ProxyServer := Pref.ProxyAddress;
 446     FHttpThread.ProxyPort   := Pref.ProxyPort;
 447   end;
 448   FHttpThread.FreeOnTerminate := true;
 449   FHttpThread.OnSuccess := HttpSuccess;
 450   FHttpThread.OnConnectionFailed := HttpFailure;
 451   FHttpThread.OnHttpWork := HttpWork;
 452
 453   FLoadBytes := 0;
 454   FHttpThread.Resume;
 455 end;
 456
 457 procedure TBottleLogList.LoadFromXMLFile(const FileName: String);
 458 begin
 459   Self.Clear;
 460   AddSystemLog('\83\8d\81[\83h\92\86...');
 461   FXMLThread := TLogXMLThread.Create(FileName);
 462   FXMLThread.FreeOnTerminate := true; // \8f\9f\8eè\82É\8fÁ\82¦\82Ä\82à\82ç\82¤
 463   with FXMLThread do
 464   begin
 465     OnLoaded := XMLLoaded;
 466     OnLoadFailure := XMLLoadFailure;
 467     Resume;
 468   end;
 469 end;
 470
 471 procedure TBottleLogList.SaveToSstpLog(const FileName: String;
 472   const WithChannel: boolean = false);
 473 var i: integer;
 474     Str: TStringList;
 475     Item: TLogItem;
 476     Date: String;
 477 const
 478   DayStr: array[1..7] of String = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
 479 begin
 480   Str := nil;
 481   try
 482     Str := TStringList.Create;
 483     for i := 0 to Self.Count - 1 do begin
 484       Item := Self.Items[i] as TLogItem;
 485       if Item.LogType = ltBottle then begin
 486         Date := FormatDateTime('yyyy/mm/dd hh:nn:ss ', Item.LogTime);
 487         Date := Date + '(' + DayStr[DayOfWeek(Item.LogTime)] + ')';
 488         if WithChannel then
 489           Date := Date + ',' + Item.Channel +',SEND,' + Item.Script
 490         else
 491           Date := Date + ',0.0.0.0,SEND,' + Item.Script;
 492         Str.Add(Date);
 493       end;
 494     end;
 495     Str.SaveToFile(FileName);
 496   finally
 497     Str.Free;
 498   end;
 499 end;
 500
 501 procedure TBottleLogList.SaveToText(const FileName: String);
 502 var i: integer;
 503     Str: TStringList;
 504 begin
 505   Str := nil;
 506   try
 507     Str := TStringList.Create;
 508     for i := 0 to Self.Count - 1 do
 509       if (Self.Items[i] as TLogItem).LogType = ltBottle then
 510         Str.Add((Self.Items[i] as TLogItem).Script);
 511     Str.SaveToFile(FileName);
 512   finally
 513     Str.Free;
 514   end;
 515 end;
 516
 517 procedure TBottleLogList.SaveToXMLFile(const FileName: String);
 518 var i: integer;
 519     MessageNode, Child: TdomElement;
 520     Item: TLogItem;
 521     DOM: TdomDocument;
 522     Parser: TXmlToDomParser;
 523     Impl: TDomImplementation;
 524     FS: TFileStream;
 525 begin
 526   Impl := TDomImplementation.create(nil);
 527   try
 528     Parser := TXmlToDomParser.create(nil);
 529     Parser.DOMImpl := Impl;
 530     try
 531       try
 532         DOM := Parser.fileToDom(ExtractFilePath(Application.ExeName)+'xbtl.dat');
 533         // \82±\82ê\82Í\96¾\8e¦\93I\82ÉFree\82µ\82È\82\82Ä\82æ\82¢
 534         with DOM do
 535         begin
 536           documentElement.setAttribute('saved',
 537             FormatDateTime('yy/mm/dd hh:nn:ss', Now));
 538           documentElement.setAttribute('generator', VersionString);
 539           documentElement.setAttribute('version', '1.0');
 540           for i := 0 to Self.Count-1 do begin
 541             Item := Self.GetBottles(i);
 542             MessageNode := createElement('message');
 543             MessageNode.setAttribute('mid', Item.MID);
 544             documentElement.appendChild(MessageNode);
 545
 546             // \93ú\95t
 547             Child := createElement('date');
 548             Child.appendChild(createTextNode(FormatDateTime('yy/mm/dd hh:nn:ss', Item.LogTime)));
 549             MessageNode.appendChild(Child);
 550             // \83`\83\83\83\93\83l\83\8b
 551             Child := createElement('channel');
 552             Child.appendChild(createTextNode(Item.Channel));
 553             MessageNode.appendChild(Child);
 554             // \83X\83N\83\8a\83v\83g
 555             Child := createElement('script');
 556             Child.appendChild(createTextNode(Item.Script));
 557             MessageNode.appendChild(Child);
 558             // \93\8a\95[
 559             Child := createElement('votes');
 560             Child.appendChild(createTextNode(IntToStr(Item.Votes)));
 561             MessageNode.appendChild(Child);
 562             // \93¯\88Ó
 563             Child := createElement('agrees');
 564             Child.appendChild(createTextNode(IntToStr(Item.Agrees)));
 565             MessageNode.appendChild(Child);
 566             // \83S\81[\83X\83g
 567             Child := createElement('ghost');
 568             Child.appendChild(createTextNode(Item.Ghost));
 569             MessageNode.appendChild(Child);
 570
 571           end;
 572         end;
 573         FS := TFileStream.Create(FileName, fmCreate or fmShareExclusive);
 574         try
 575           DOM.writeCodeAsShiftJIS(FS);
 576         finally
 577           FS.Free;
 578         end;
 579       except
 580         ShowMessage('xbtl.dat\82ð\8dÄ\83C\83\93\83X\83g\81[\83\8b\82µ\82Ä\82\82¾\82³\82¢\81B');
 581       end;
 582     finally
 583       Parser.DOMImpl.freeDocument(DOM);
 584       Parser.Free;
 585     end;
 586   finally
 587     Impl.Free;
 588   end;
 589 end;
 590
 591 procedure TBottleLogList.SetOnLoaded(const Value: TNotifyEvent);
 592 begin
 593   FOnLoaded := Value;
 594 end;
 595
 596 procedure TBottleLogList.SetOnLoadFailure(
 597   const Value: TBottleLogLoadFailureEvent);
 598 begin
 599   FOnLoadFailure := Value;
 600 end;
 601
 602 procedure TBottleLogList.SetOnLoadWork(const Value: TNotifyEvent);
 603 begin
 604   FOnLoadWork := Value;
 605 end;
 606
 607 procedure TBottleLogList.SetSelectedIndex(const Value: integer);
 608 begin
 609   FSelectedIndex := Value;
 610 end;
 611
 612 procedure TBottleLogList.SetTitle(const Value: String);
 613 begin
 614   FTitle := Value;
 615 end;
 616
 617 procedure TBottleLogList.SortBottles(LogSortType: TBottleLogSortType);
 618 begin
 619   if FOldSortColumn = LogSortType then
 620     ASortDesc := not FOldSortDesc
 621   else begin
 622     ASortDesc := false;
 623   end;
 624   ASortType := LogSortType;
 625   Self.Sort(LogCompare);
 626   FOldSortColumn := ASortType;
 627   FOldSortDesc := ASortDesc;
 628 end;
 629
 630 procedure TBottleLogList.XMLLoaded(Sener: TObject);
 631 begin
 632   Self.Assign(FXMLThread.List);
 633   if Assigned(FOnLoaded) then FOnLoaded(Self);
 634   FXMLThread := nil;
 635 end;
 636
 637 procedure TBottleLogList.XMLLoadFailure(Sender: TObject;
 638   const Message: String);
 639 begin
 640   if Assigned(FOnLoadFailure) then
 641     DoLoadFailure(Message);
 642 end;
 643
 644 { TLogXMLThread }
 645
 646 constructor TLogXMLThread.Create(FileName: String);
 647 begin
 648   inherited Create(true);
 649   FList := TObjectList.Create(false); // OwnsObject = false (!!)
 650   FFileName := FileName;
 651 end;
 652
 653 destructor TLogXMLThread.Destroy;
 654 begin
 655   FList.Free;
 656   inherited;
 657 end;
 658
 659 procedure TLogXMLThread.DoLoaded;
 660 begin
 661   if Assigned(FOnLoaded) then
 662     FOnLoaded(self);
 663 end;
 664
 665 procedure TLogXMLThread.DoLoadFailure;
 666 begin
 667   if Assigned(FOnLoadFailure) then
 668     FOnLoadFailure(self, FLoadFailureMessage);
 669 end;
 670
 671 procedure TLogXMLThread.Execute;
 672 var i, j, votes, agrees: integer;
 673     Time: TDateTime;
 674     ANode, Child: TdomElement;
 675     Item: TLogItem;
 676     DOM: TdomDocument;
 677     Parser: TXmlToDomParser;
 678     Impl: TDomImplementation;
 679     Str, mid, channel, script, ghost: String;
 680 begin
 681   FList.Clear;
 682   Impl := TDomImplementation.create(nil);
 683   try
 684     Parser := TXmlToDomParser.create(nil);
 685     Parser.DOMImpl := Impl;
 686     try
 687       try
 688         DOM := Parser.fileToDom(FFileName); //\82±\82ê\82Í\96¾\8e¦\93I\82ÉFree\82µ\82È\82\82Ä\82æ\82¢
 689         DOM.normalize;
 690         if not DOM.validate(nil, erReplace) then
 691           raise EXMLFileOpenException.Create('\97L\8cø\82È\83{\83g\83\8b\83\8d\83O\8c`\8e®\82Å\82Í\82 \82è\82Ü\82¹\82ñ\81B');
 692         with DOM do
 693         begin
 694           if DocumentElement = nil then
 695           begin
 696             FLoadFailureMessage := '\97L\8cø\82È\8c`\8e®\82Å\82Í\82 \82è\82Ü\82¹\82ñ\81B' +
 697              '\83\8b\81[\83g\83^\83O\82ª\82 \82è\82Ü\82¹\82ñ';
 698             Synchronize(DoLoadFailure);
 699             Exit;
 700           end;
 701           if DocumentElement.nodeName <> 'bottlelog' then
 702           begin
 703             FLoadFailureMessage := '\97L\8cø\82È\8c`\8e®\82Å\82Í\82 \82è\82Ü\82¹\82ñ\81B' +
 704               'bottlelog\82ª\8c©\82Â\82©\82è\82Ü\82¹\82ñ';
 705             Synchronize(DoLoadFailure);
 706             Exit;
 707           end;
 708           Str :=  DocumentElement.getAttribute('version');
 709           if Str <> '1.0' then
 710           begin
 711             FLoadFailureMessage := Format('\97L\8cø\82È\8c`\8e®\82Å\82Í\82 \82è\82Ü\82¹\82ñ\81B' +
 712               '\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]);
 713             Synchronize(DoLoadFailure);
 714             Exit;
 715           end;
 716           for i := 0 to DocumentElement.childNodes.length-1 do
 717           begin
 718             if documentElement.childNodes.item(i).nodeType <> ntElement_Node then
 719               Continue;
 720             ANode := documentElement.childNodes.item(i) as TdomElement;
 721             if ANode.nodeName <> 'message' then
 722               Continue;
 723             mid := ANode.getAttribute('mid');
 724             channel := '';
 725             script := '';
 726             ghost := '';
 727             votes := 0;
 728             agrees := 0;
 729             Time := Now;
 730             for j := 0 to ANode.childNodes.length-1 do
 731             begin
 732               if ANode.childNodes.item(j).nodeType <> ntElement_Node then
 733                 Continue;
 734               Child := ANode.childNodes.item(j) as TdomElement;
 735               if Child.nodeName = 'channel' then
 736                 channel := Trim(Child.textContent)
 737               else if Child.nodeName = 'script' then
 738                 script := Trim(Child.textContent)
 739               else if Child.nodeName = 'ghost' then
 740                 ghost := Trim(Child.textContent)
 741               else if Child.nodeName = 'votes' then
 742                 votes := StrToIntDef(Child.textContent, 0)
 743               else if Child.nodeName = 'agrees' then
 744                 agrees := StrToIntDef(Child.textContent, 0)
 745               else if Child.nodeName = 'date' then
 746                 TryStrToDateTime(Trim(Child.textContent), Time);
 747             end;
 748             Item := TLogItem.Create(ltBottle, mid, channel, script, ghost, time);
 749             Item.Votes  := votes;
 750             Item.Agrees := agrees;
 751             Item.State := lsOpened;
 752             try
 753               FList.Add(Item);
 754             except
 755               Item.Free;
 756             end;
 757           end;
 758           Synchronize(DoLoaded);
 759         end;
 760       except
 761         on E: EParserException do
 762         begin
 763           FLoadFailureMessage := 'XML\89ð\90Í\83G\83\89\81[\81B' + E.Message;
 764           Synchronize(DoLoadFailure);
 765           Exit;
 766         end;
 767         on E: Exception do
 768         begin
 769           FLoadFailureMessage := 'XML\83I\81[\83v\83\93\8e\9e\82É\83G\83\89\81[\82ª\94\90¶\82µ\82Ü\82µ\82½\81B' +
 770             E.Message;
 771           Synchronize(DoLoadFailure);
 772           Exit;
 773         end;
 774       end;
 775     finally
 776       Parser.DOMImpl.freeDocument(DOM);
 777       Parser.Free;
 778     end;
 779   finally
 780     Impl.Free;
 781   end;
 782 end;
 783
 784 procedure TLogXMLThread.SetOnLoaded(const Value: TNotifyEvent);
 785 begin
 786   FOnLoaded := Value;
 787 end;
 788
 789 procedure TLogXMLThread.SetOnLoadFailure(const Value: TBottleLogLoadFailureEvent);
 790 begin
 791   FOnLoadFailure := Value;
 792 end;
 793
 794 end.