bottleclient/Logs.pas

   1 unit Logs;
   2
   3 interface
   4
   5 uses
   6   Contnrs, Classes, SysUtils, Dialogs, Forms, HttpThread, BottleDef,
   7   DateUtils, IdURI, xmldom, XMLIntf,
   8   msxmldom, XMLDoc;
   9
  10 type
  11
  12   TLogType = (ltBottle, ltSystemLog);
  13   TLogState = (lsUnopened, lsPlaying, lsOpened);
  14   TLogItem = class(TObject)
  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);
  37     property LogType: TLogType read FLogType write SetLogType;
  38     property MID: String read FMID write SetMID;
  39     property Channel: String read FChannel write SetChannel;
  40     property LogTime: TDateTime read FLogTime write SetLogTime;
  41     property Script: String read FScript write SetScript;
  42     property Ghost: String read FGhost write SetGhost;
  43     property Votes: Integer read FVotes write SetVotes;
  44     property Agrees: Integer read FAgreements write SetAgreements;
  45     property State: TLogState read FState write SetState;
  46   end;
  47
  48   TBottleLogSortType = (stLogTime, stChannel, stScript, stVote, stAgree);
  49   TBottleLogLoadFailureEvent = procedure(Sender: TObject; const Message: String) of object;
  50
  51   TBottleLogList = class(TObjectList)
  52   private
  53     FOnLoaded: TNotifyEvent;
  54     FHttpThread: THTTPDownloadThread;
  55     FTitle: String;
  56     FOnLoadFailure: TBottleLogLoadFailureEvent;
  57     FOldSortColumn: TBottleLogSortType; // \83\8d\83O\91\8b
  58     FOldSortDesc: boolean;   // \83\8d\83O\91\8b
  59     FSelectedIndex: integer; // \83\8d\83O\91\8b
  60
  61     function GetBottles(Index: integer): TLogItem;
  62     procedure SetOnLoaded(const Value: TNotifyEvent);
  63     procedure HttpSuccess(Sender: TObject);
  64     procedure HttpFailure(Sender: TObject);
  65     procedure SetTitle(const Value: String);
  66     procedure SetOnLoadFailure(const Value: TBottleLogLoadFailureEvent);
  67     procedure SetSelectedIndex(const Value: integer);
  68   public
  69     constructor Create(const Title: String);
  70     destructor Destroy; override;
  71     procedure SortBottles(LogSortType: TBottleLogSortType);
  72     function Bottle(MID: String): TLogItem;
  73     property Bottles[Index: integer]: TLogItem read GetBottles;
  74     procedure LoadFromWeb(DateLo: TDateTime; DateHi: TDateTime; Channel: String;
  75       MinVote: integer; MinAgree: integer);
  76     property Title: String read FTitle write SetTitle;
  77     procedure LoadFromStream(Stream: TStream);
  78     property OnLoaded: TNotifyEvent read FOnLoaded write SetOnLoaded;
  79     property OnLoadFailure: TBottleLogLoadFailureEvent read FOnLoadFailure write SetOnLoadFailure;
  80     property SelectedIndex: integer read FSelectedIndex write SetSelectedIndex;
  81     procedure AddScriptLog(const Script, Channel, MID, Ghost: String);
  82     procedure AddSystemLog(const MessageString: String);
  83     procedure SaveToText(const FileName: String);
  84     procedure SaveToSstpLog(const FileName: String;
  85       const WithChannel: boolean = false);
  86     procedure SaveToXmlFile(const FileName: String; XmlDocument: TXmlDocument);
  87   end;
  88
  89 var
  90   CurrentBottleLog: TBottleLogList; //\83J\83\8c\83\93\83g
  91   ASortType: TBottleLogSortType; //LogCompare\8aÖ\90\94\82©\82ç\8c©\82¦\82é\82æ\82¤\82É\88ê\8e\9e\91Þ\94ð\97p
  92   ASortDesc: boolean;
  93
  94 function LogCompare(Item1, Item2: Pointer): integer;
  95
  96
  97 ////////////////////////////////////////////////////////////////////////////////
  98 implementation
  99
 100 function LogCompare(Item1, Item2: Pointer): Integer;
 101 var
 102   Log1, Log2: TLogItem;
 103 begin
 104   Log1 := TLogItem(Item1);
 105   Log2 := TLogItem(Item2);
 106   Result := 0;
 107   case ASortType of
 108     stLogTime: begin
 109       if Log1.LogTime = Log2.LogTime then Result := 0
 110       else if Log1.LogTime < Log2.LogTime then Result := 1 else Result := -1;
 111     end;
 112     stChannel: begin
 113       Result := AnsiCompareStr(Log1.Channel, Log2.Channel);
 114     end;
 115     stScript: begin
 116       Result := AnsiCompareStr(Log1.Script, Log2.Script);
 117     end;
 118     stVote: begin
 119       Result := Log2.Votes - Log1.Votes;
 120     end;
 121     stAgree: begin
 122       Result := Log2.Agrees - Log1.Agrees;
 123     end;
 124   end;
 125   if ASortDesc then Result := -Result; //\8f¸\8f\87
 126 end;
 127
 128 { TLogItem }
 129
 130 constructor TLogItem.Create(LogType: TLogType; const MID, Channel, Script,
 131   Ghost: String; LogTime: TDateTime);
 132 begin
 133   Self.LogType := LogType;
 134   Self.MID := MID;
 135   Self.Script := Script;
 136   Self.Channel := Channel;
 137   Self.Ghost := Ghost;
 138   Self.LogTime := LogTime;
 139   Self.State := lsUnopened;
 140 end;
 141
 142 procedure TLogItem.SetChannel(const Value: String);
 143 begin
 144   FChannel := Value;
 145 end;
 146
 147 procedure TLogItem.SetLogType(const Value: TLogType);
 148 begin
 149   FLogType := Value;
 150 end;
 151
 152 procedure TLogItem.SetMID(const Value: String);
 153 begin
 154   FMID := Value;
 155 end;
 156
 157 procedure TLogItem.SetScript(const Value: String);
 158 begin
 159   FScript := Value;
 160 end;
 161
 162 procedure TLogItem.SetLogTime(const Value: TDateTime);
 163 begin
 164   FLogTime := Value;
 165 end;
 166
 167 procedure TLogItem.SetAgreements(const Value: Integer);
 168 begin
 169   FAgreements := Value;
 170 end;
 171
 172 procedure TLogItem.SetVotes(const Value: Integer);
 173 begin
 174   FVotes := Value;
 175 end;
 176
 177 procedure TLogItem.SetGhost(const Value: String);
 178 begin
 179   FGhost := Value;
 180 end;
 181
 182
 183 procedure TLogItem.SetState(const Value: TLogState);
 184 begin
 185   FState := Value;
 186 end;
 187
 188 { TBottleLogList }
 189
 190 procedure TBottleLogList.AddScriptLog(const Script, Channel, MID,
 191   Ghost: String);
 192 var LogItem: TLogItem;
 193 begin
 194   LogItem := TLogItem.Create(ltBottle, MID, Channel, Script, Ghost, Now());
 195   Insert(0, LogItem);
 196 end;
 197
 198 procedure TBottleLogList.AddSystemLog(const MessageString: String);
 199 var LogItem: TLogItem;
 200 begin
 201   LogItem := TLogItem.Create(ltSystemLog, '', '', MessageString, '', Now());
 202   Insert(0, LogItem);
 203 end;
 204
 205 function TBottleLogList.Bottle(MID: String): TLogItem;
 206 var i: integer;
 207 begin
 208   Result := nil;
 209   for i := 0 to Count-1 do
 210     if (Items[i] as TLogItem).MID = MID then begin
 211       Result := Items[i] as TLogItem;
 212       exit;
 213     end;
 214 end;
 215
 216 constructor TBottleLogList.Create(const Title: String);
 217 begin
 218   inherited Create;
 219   FTitle := Title;
 220   OwnsObjects := true;
 221   FSelectedIndex := -1; // \91I\91ð\82³\82ê\82Ä\82¢\82È\82¢
 222 end;
 223
 224 destructor TBottleLogList.Destroy;
 225 begin
 226   inherited;
 227   // 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
 228   // FHttpThread <> nil \82È\82ç\8eÀ\91Ì\82ª\91¶\8dÝ\82·\82é\82±\82Æ\82Í\8am\8eÀ\82Å\82 \82é\81B
 229   if FHttpThread <> nil then begin
 230     FHttpThread.OnSuccess := nil;
 231     FHttpThread.OnConnectionFailed := nil;
 232   end;
 233 end;
 234
 235 function TBottleLogList.GetBottles(Index: integer): TLogItem;
 236 begin
 237   Result := Items[Index] as TLogItem;
 238 end;
 239
 240 procedure TBottleLogList.HttpFailure(Sender: TObject);
 241 begin
 242   if Assigned(FOnLoadFailure) then FOnLoadFailure(Self, '\83T\81[\83o\82Ì\90Ú\91±\82É\8e¸\94s\82µ\82Ü\82µ\82½');
 243 end;
 244
 245 procedure TBottleLogList.HttpSuccess(Sender: TObject);
 246 var Stream: TStringStream;
 247     StrList: TStringList;
 248 begin
 249   Stream := nil;
 250   StrList := nil;
 251   try
 252     Stream := TStringStream.Create(FHttpThread.RecvString);
 253     StrList := TStringList.Create;
 254     StrList.Text := Stream.DataString;
 255     if StrList[0] <> 'Result: OK' then begin
 256       if Assigned(FOnLoadFailure) then
 257         FOnLoadFailure(Self, '\83T\81[\83o\82ª\83G\83\89\81[\82ð\95Ô\82µ\82Ü\82µ\82½'#13#10 + Stream.DataString);
 258     end else begin
 259       while StrList.Count > 0 do
 260         if StrList[0] <> '' then StrList.Delete(0) else Break; //\83w\83b\83_\81[\82ð\8dí\8f\9c\82·\82é
 261       if StrList.Count > 0 then StrList.Delete(0); //\83w\83b\83_\81[\8cã\82Ì\8bó\8ds\8dí\8f\9c
 262       Stream.Seek(0, soFromBeginning);
 263       Stream.Size := Length(StrList.Text);
 264       Stream.WriteString(StrList.Text);
 265       Stream.Seek(0, soFromBeginning);
 266       LoadFromStream(Stream);
 267     end;
 268   finally
 269     Stream.Free;
 270     // nil\82Å\82È\82¢\8fê\8d\87\82É\82Í\8eÀ\91Ì\82ª\91¶\8dÝ\82·\82é\82±\82Æ\82ð\8am\8eÀ\82É\82·\82é
 271     // \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ß)
 272     FHttpThread := nil;
 273   end;
 274 end;
 275
 276 procedure TBottleLogList.LoadFromStream(Stream: TStream);
 277 var i: integer;
 278     SourceStream: TStringStream;
 279     Source: TStringList;
 280     LogItem: TLogItem;
 281   function S2D (const S: String): TDateTime;
 282   begin
 283     Result := EncodeDateTime(
 284       StrToInt(Copy(S, 1, 4)), StrToInt(Copy(S, 5, 2)), StrToInt(Copy(S, 7, 2)),
 285       StrToInt(Copy(S, 9, 2)), StrToInt(Copy(S, 11, 2)), StrToInt(Copy(S, 13, 2)), 0);
 286   end;
 287 begin
 288   Self.Clear;
 289   Source := nil;
 290   SourceStream := nil;
 291   try
 292     try
 293       SourceStream := TStringStream.Create('');
 294       SourceStream.Seek(0, soFromBeginning);
 295       SourceStream.CopyFrom(Stream, Stream.Size);
 296       Source := TStringList.Create;
 297       Source.Text := SourceStream.DataString;
 298       i := 0;
 299       if Source.Count = 0 then begin
 300         if Assigned(FOnLoadFailure) then FOnLoadFailure(Self, '\83\8d\83O\82ª\93Ç\82Ý\8eæ\82ê\82Ü\82¹\82ñ');
 301       end;
 302       if Source[0] <> 'OK' then begin
 303       end;
 304       while (i + 7) < Source.Count do begin
 305         LogItem := TLogItem.Create(ltBottle, Source[i+1], Source[i+2],
 306           Source[i+7], Source[i+3], S2D(Source[i]));
 307         LogItem.Votes  := StrToInt(Source[i+5]);
 308         LogItem.Agrees := StrToInt(Source[i+6]);
 309         LogItem.State := lsOpened;
 310         i := i + 8;
 311         Self.Add(LogItem);
 312       end;
 313     finally
 314       SourceStream.Free;
 315       Source.Free;
 316     end;
 317   except
 318     On EConvertError do begin
 319       if Assigned(FOnLoadFailure) then FOnLoadFailure(Self, '\83\8d\83O\82Ì\8c`\8e®\82ª\95s\90³\82Å\82·');
 320       Self.Clear;
 321     end;
 322   end;
 323   FOldSortColumn := stLogTime;
 324   FOldSortDesc := false;
 325   if Assigned(FOnLoaded) then FOnLoaded(Self);
 326 end;
 327
 328 procedure TBottleLogList.LoadFromWeb(DateLo, DateHi: TDateTime;
 329   Channel: String; MinVote, MinAgree: integer);
 330 var Param: String;
 331 begin
 332   Self.Clear;
 333   AddSystemLog('\83_\83E\83\93\83\8d\81[\83h\92\86\82Å\82·');
 334   Param := Format('year_lo=%d&month_lo=%d&day_lo=%d&year_hi=%d&month_hi=%d&day_hi=%d&' +
 335     'minvote=%d&minagree=%d&channel=%s&sort=timedesc&delimiter=%%0D%%0A',
 336     [YearOf(DateLo), MonthOf(DateLo), DayOf(DateLo),
 337      YearOf(DateHi), MonthOf(DateHi), DayOf(DateHi), MinVote, MinAgree,
 338      TIdURI.ParamsEncode(Channel)]);
 339   FHttpThread := THTTPDownloadThread.Create(BottleServer, Pref.CgiFetchLog, Param);
 340   if Pref.UseHttpProxy then begin
 341     FHttpThread.ProxyServer := Pref.ProxyAddress;
 342     FHttpThread.ProxyPort   := Pref.ProxyPort;
 343   end;
 344   FHttpThread.FreeOnTerminate := true;
 345   FHttpThread.OnSuccess := HttpSuccess;
 346   FHttpThread.OnConnectionFailed := HttpFailure;
 347   FHttpThread.Resume;
 348 end;
 349
 350 procedure TBottleLogList.SaveToSstpLog(const FileName: String;
 351   const WithChannel: boolean = false);
 352 var i: integer;
 353     Str: TStringList;
 354     Item: TLogItem;
 355     Date: String;
 356 const
 357   DayStr: array[1..7] of String = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
 358 begin
 359   Str := nil;
 360   try
 361     Str := TStringList.Create;
 362     for i := 0 to Self.Count - 1 do begin
 363       Item := Self.Items[i] as TLogItem;
 364       if Item.LogType = ltBottle then begin
 365         Date := FormatDateTime('yyyy/mm/dd hh:nn:ss ', Item.LogTime);
 366         Date := Date + '(' + DayStr[DayOfWeek(Item.LogTime)] + ')';
 367         if WithChannel then
 368           Date := Date + ',' + Item.Channel +',SEND,' + Item.Script
 369         else
 370           Date := Date + ',0.0.0.0,SEND,' + Item.Script;
 371         Str.Add(Date);
 372       end;
 373     end;
 374     Str.SaveToFile(FileName);
 375   finally
 376     Str.Free;
 377   end;
 378 end;
 379
 380 procedure TBottleLogList.SaveToText(const FileName: String);
 381 var i: integer;
 382     Str: TStringList;
 383 begin
 384   Str := nil;
 385   try
 386     Str := TStringList.Create;
 387     for i := 0 to Self.Count - 1 do
 388       if (Self.Items[i] as TLogItem).LogType = ltBottle then
 389         Str.Add((Self.Items[i] as TLogItem).Script);
 390     Str.SaveToFile(FileName);
 391   finally
 392     Str.Free;
 393   end;
 394 end;
 395
 396 procedure TBottleLogList.SaveToXmlFile(const FileName: String;
 397   XMLDocument: TXMLDocument);
 398 var i: integer;
 399     ANode, BNode: IXMLNode;
 400     Item: TLogItem;
 401 begin
 402   with XMLDocument do begin
 403     XML.LoadFromFile(ExtractFilePath(Application.ExeName)+'xbtl.xml');
 404     Active := true;
 405     DocumentElement.Attributes['saved'] := FormatDateTime('yy/mm/dd hh:nn:ss', Now);
 406     DocumentElement.Attributes['generator'] := VersionString;
 407     DocumentElement.Attributes['version'] := '1.0';
 408     for i := 0 to Self.Count-1 do begin
 409       Item := Self[i] as TLogItem;
 410       if Item.LogType <> ltBottle then Continue;
 411       ANode := DocumentElement.AddChild('message');
 412       ANode.Attributes['mid'] := Item.MID;
 413       BNode := ANode.AddChild('date');
 414       BNode.Text := FormatDateTime('yy/mm/dd hh:nn:ss', Item.LogTime);
 415       BNode := ANode.AddChild('channel');
 416       BNode.Text := Item.Channel;
 417       BNode := ANode.AddChild('script');
 418       BNode.Text := Item.Script;
 419       BNode := ANode.AddChild('votes');
 420       BNode.Text := IntToStr(Item.Votes);
 421       BNode := ANode.AddChild('agrees');
 422       BNode.Text := IntToStr(Item.Agrees);
 423       BNode := ANode.AddChild('ghost');
 424       BNode.Text := Item.Ghost;
 425     end;
 426   end;
 427   XMLDocument.XML.SaveToFile(FileName);
 428 end;
 429
 430 procedure TBottleLogList.SetOnLoaded(const Value: TNotifyEvent);
 431 begin
 432   FOnLoaded := Value;
 433 end;
 434
 435 procedure TBottleLogList.SetOnLoadFailure(
 436   const Value: TBottleLogLoadFailureEvent);
 437 begin
 438   FOnLoadFailure := Value;
 439 end;
 440
 441 procedure TBottleLogList.SetSelectedIndex(const Value: integer);
 442 begin
 443   FSelectedIndex := Value;
 444 end;
 445
 446 procedure TBottleLogList.SetTitle(const Value: String);
 447 begin
 448   FTitle := Value;
 449 end;
 450
 451 procedure TBottleLogList.SortBottles(LogSortType: TBottleLogSortType);
 452 begin
 453   if FOldSortColumn = LogSortType then
 454     ASortDesc := not FOldSortDesc
 455   else begin
 456     ASortDesc := false;
 457   end;
 458   ASortType := LogSortType;
 459   Self.Sort(LogCompare);
 460   FOldSortColumn := ASortType;
 461   FOldSortDesc := ASortDesc;
 462 end;
 463
 464 end.