bottleclient/Logs.pas

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