bottleclient/Logs.pas

   1 unit Logs;
   2
   3 interface
   4
   5 uses
   6   Contnrs, Classes, SysUtils, Dialogs, Forms, HttpThread, BottleDef,
   7   DateUtils, IdURI;
   8
   9 type
  10
  11   TLogType = (ltBottle, ltSystemLog);
  12   TLogState = (lsUnopened, lsPlaying, lsOpened);
  13   TLogItem = class(TObject)
  14   private
  15     FScript: String;
  16     FChannel: String;
  17     FMID: String;
  18     FLogTime: TDateTime;
  19     FLogType: TLogType;
  20     FGhost: String;
  21     FVotes: Integer;
  22     FAgreements: Integer;
  23     FState: TLogState;
  24     procedure SetChannel(const Value: String);
  25     procedure SetLogType(const Value: TLogType);
  26     procedure SetMID(const Value: String);
  27     procedure SetScript(const Value: String);
  28     procedure SetLogTime(const Value: TDateTime);
  29     procedure SetGhost(const Value: String);
  30     procedure SetVotes(const Value: Integer);
  31     procedure SetAgreements(const Value: Integer);
  32     procedure SetState(const Value: TLogState);
  33   public
  34     constructor Create(LogType: TLogType; const MID, Channel, Script,
  35       Ghost: String; LogTime: TDateTime);
  36     property LogType: TLogType read FLogType write SetLogType;
  37     property MID: String read FMID write SetMID;
  38     property Channel: String read FChannel write SetChannel;
  39     property LogTime: TDateTime read FLogTime write SetLogTime;
  40     property Script: String read FScript write SetScript;
  41     property Ghost: String read FGhost write SetGhost;
  42     property Votes: Integer read FVotes write SetVotes;
  43     property Agrees: Integer read FAgreements write SetAgreements;
  44     property State: TLogState read FState write SetState;
  45   end;
  46
  47   TBottleLogSortType = (stLogTime, stChannel, stScript, stVote, stAgree);
  48   TBottleLogLoadFailureEvent = procedure(Sender: TObject; const Message: String) of object;
  49
  50   TBottleLogList = class(TObjectList)
  51   private
  52     FOnLoaded: TNotifyEvent;
  53     FHttpThread: THTTPDownloadThread;
  54     FTitle: String;
  55     FOnLoadFailure: TBottleLogLoadFailureEvent;
  56     FOldSortColumn: TBottleLogSortType; // \83\8d\83O\91\8b
  57     FOldSortDesc: boolean;   // \83\8d\83O\91\8b
  58     FSelectedIndex: integer; // \83\8d\83O\91\8b
  59
  60     function GetBottles(Index: integer): TLogItem;
  61     procedure SetOnLoaded(const Value: TNotifyEvent);
  62     procedure HttpSuccess(Sender: TObject);
  63     procedure HttpFailure(Sender: TObject);
  64     procedure SetTitle(const Value: String);
  65     procedure SetOnLoadFailure(const Value: TBottleLogLoadFailureEvent);
  66     procedure SetSelectedIndex(const Value: integer);
  67   public
  68     constructor Create(const Title: String);
  69     destructor Destroy; override;
  70     procedure SortBottles(LogSortType: TBottleLogSortType);
  71     function Bottle(MID: String): TLogItem;
  72     property Bottles[Index: integer]: TLogItem read GetBottles;
  73     procedure LoadFromWeb(DateLo: TDateTime; DateHi: TDateTime; Channel: String;
  74       MinVote: integer; MinAgree: integer);
  75     property Title: String read FTitle write SetTitle;
  76     procedure LoadFromStream(Stream: TStream);
  77     property OnLoaded: TNotifyEvent read FOnLoaded write SetOnLoaded;
  78     property OnLoadFailure: TBottleLogLoadFailureEvent read FOnLoadFailure write SetOnLoadFailure;
  79     property SelectedIndex: integer read FSelectedIndex write SetSelectedIndex;
  80     procedure AddScriptLog(const Script, Channel, MID, Ghost: String);
  81     procedure AddSystemLog(const MessageString: String);
  82   end;
  83
  84 var
  85   CurrentBottleLog: TBottleLogList; //\83J\83\8c\83\93\83g
  86   ASortType: TBottleLogSortType; //LogCompare\8aÖ\90\94\82©\82ç\8c©\82¦\82é\82æ\82¤\82É\88ê\8e\9e\91Þ\94ð\97p
  87   ASortDesc: boolean;
  88
  89 function LogCompare(Item1, Item2: Pointer): integer;
  90
  91
  92 ////////////////////////////////////////////////////////////////////////////////
  93 implementation
  94
  95 function LogCompare(Item1, Item2: Pointer): Integer;
  96 var
  97   Log1, Log2: TLogItem;
  98 begin
  99   Log1 := TLogItem(Item1);
 100   Log2 := TLogItem(Item2);
 101   Result := 0;
 102   case ASortType of
 103     stLogTime: begin
 104       if Log1.LogTime = Log2.LogTime then Result := 0
 105       else if Log1.LogTime < Log2.LogTime then Result := 1 else Result := -1;
 106     end;
 107     stChannel: begin
 108       Result := AnsiCompareStr(Log1.Channel, Log2.Channel);
 109     end;
 110     stScript: begin
 111       Result := AnsiCompareStr(Log1.Script, Log2.Script);
 112     end;
 113     stVote: begin
 114       Result := Log2.Votes - Log1.Votes;
 115     end;
 116     stAgree: begin
 117       Result := Log2.Agrees - Log1.Agrees;
 118     end;
 119   end;
 120   if ASortDesc then Result := -Result; //\8f¸\8f\87
 121 end;
 122
 123 { TLogItem }
 124
 125 constructor TLogItem.Create(LogType: TLogType; const MID, Channel, Script,
 126   Ghost: String; LogTime: TDateTime);
 127 begin
 128   Self.LogType := LogType;
 129   Self.MID := MID;
 130   Self.Script := Script;
 131   Self.Channel := Channel;
 132   Self.Ghost := Ghost;
 133   Self.LogTime := LogTime;
 134   Self.State := lsUnopened;
 135 end;
 136
 137 procedure TLogItem.SetChannel(const Value: String);
 138 begin
 139   FChannel := Value;
 140 end;
 141
 142 procedure TLogItem.SetLogType(const Value: TLogType);
 143 begin
 144   FLogType := Value;
 145 end;
 146
 147 procedure TLogItem.SetMID(const Value: String);
 148 begin
 149   FMID := Value;
 150 end;
 151
 152 procedure TLogItem.SetScript(const Value: String);
 153 begin
 154   FScript := Value;
 155 end;
 156
 157 procedure TLogItem.SetLogTime(const Value: TDateTime);
 158 begin
 159   FLogTime := Value;
 160 end;
 161
 162 procedure TLogItem.SetAgreements(const Value: Integer);
 163 begin
 164   FAgreements := Value;
 165 end;
 166
 167 procedure TLogItem.SetVotes(const Value: Integer);
 168 begin
 169   FVotes := Value;
 170 end;
 171
 172 procedure TLogItem.SetGhost(const Value: String);
 173 begin
 174   FGhost := Value;
 175 end;
 176
 177
 178 procedure TLogItem.SetState(const Value: TLogState);
 179 begin
 180   FState := Value;
 181 end;
 182
 183 { TBottleLogList }
 184
 185 procedure TBottleLogList.AddScriptLog(const Script, Channel, MID,
 186   Ghost: String);
 187 var LogItem: TLogItem;
 188 begin
 189   LogItem := TLogItem.Create(ltBottle, MID, Channel, Script, Ghost, Now());
 190   Insert(0, LogItem);
 191 end;
 192
 193 procedure TBottleLogList.AddSystemLog(const MessageString: String);
 194 var LogItem: TLogItem;
 195 begin
 196   LogItem := TLogItem.Create(ltSystemLog, '', '', MessageString, '', Now());
 197   Insert(0, LogItem);
 198 end;
 199
 200 function TBottleLogList.Bottle(MID: String): TLogItem;
 201 var i: integer;
 202 begin
 203   Result := nil;
 204   for i := 0 to Count-1 do
 205     if (Items[i] as TLogItem).MID = MID then begin
 206       Result := Items[i] as TLogItem;
 207       exit;
 208     end;
 209 end;
 210
 211 constructor TBottleLogList.Create(const Title: String);
 212 begin
 213   inherited Create;
 214   FTitle := Title;
 215   OwnsObjects := true;
 216 end;
 217
 218 destructor TBottleLogList.Destroy;
 219 begin
 220   inherited;
 221   // 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
 222   // FHttpThread <> nil \82È\82ç\8eÀ\91Ì\82ª\91¶\8dÝ\82·\82é\82±\82Æ\82Í\8am\8eÀ\82Å\82 \82é\81B
 223   if FHttpThread <> nil then begin
 224     FHttpThread.OnSuccess := nil;
 225     FHttpThread.OnConnectionFailed := nil;
 226   end;
 227 end;
 228
 229 function TBottleLogList.GetBottles(Index: integer): TLogItem;
 230 begin
 231   Result := Items[Index] as TLogItem;
 232 end;
 233
 234 procedure TBottleLogList.HttpFailure(Sender: TObject);
 235 begin
 236   if Assigned(FOnLoadFailure) then FOnLoadFailure(Self, '\83T\81[\83o\82Ì\90Ú\91±\82É\8e¸\94s\82µ\82Ü\82µ\82½');
 237 end;
 238
 239 procedure TBottleLogList.HttpSuccess(Sender: TObject);
 240 var Stream: TStringStream;
 241     StrList: TStringList;
 242 begin
 243   Stream := nil;
 244   StrList := nil;
 245   try
 246     Stream := TStringStream.Create(FHttpThread.RecvString);
 247     StrList := TStringList.Create;
 248     StrList.Text := Stream.DataString;
 249     if StrList[0] <> 'Result: OK' then begin
 250       if Assigned(FOnLoadFailure) then
 251         FOnLoadFailure(Self, '\83T\81[\83o\82ª\83G\83\89\81[\82ð\95Ô\82µ\82Ü\82µ\82½'#13#10 + Stream.DataString);
 252     end else begin
 253       while StrList.Count > 0 do
 254         if StrList[0] <> '' then StrList.Delete(0) else Break; //\83w\83b\83_\81[\82ð\8dí\8f\9c\82·\82é
 255       if StrList.Count > 0 then StrList.Delete(0); //\83w\83b\83_\81[\8cã\82Ì\8bó\8ds\8dí\8f\9c
 256       Stream.Seek(0, soFromBeginning);
 257       Stream.Size := Length(StrList.Text);
 258       Stream.WriteString(StrList.Text);
 259       Stream.Seek(0, soFromBeginning);
 260       LoadFromStream(Stream);
 261     end;
 262   finally
 263     Stream.Free;
 264     // nil\82Å\82È\82¢\8fê\8d\87\82É\82Í\8eÀ\91Ì\82ª\91¶\8dÝ\82·\82é\82±\82Æ\82ð\8am\8eÀ\82É\82·\82é
 265     // \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ß)
 266     FHttpThread := nil;
 267   end;
 268 end;
 269
 270 procedure TBottleLogList.LoadFromStream(Stream: TStream);
 271 var i: integer;
 272     SourceStream: TStringStream;
 273     Source: TStringList;
 274     LogItem: TLogItem;
 275   function S2D (const S: String): TDateTime;
 276   begin
 277     Result := EncodeDateTime(
 278       StrToInt(Copy(S, 1, 4)), StrToInt(Copy(S, 5, 2)), StrToInt(Copy(S, 7, 2)),
 279       StrToInt(Copy(S, 9, 2)), StrToInt(Copy(S, 11, 2)), StrToInt(Copy(S, 13, 2)), 0);
 280   end;
 281 begin
 282   Self.Clear;
 283   Source := nil;
 284   SourceStream := nil;
 285   try
 286     try
 287       SourceStream := TStringStream.Create('');
 288       SourceStream.Seek(0, soFromBeginning);
 289       SourceStream.CopyFrom(Stream, Stream.Size);
 290       Source := TStringList.Create;
 291       Source.Text := SourceStream.DataString;
 292       i := 0;
 293       if Source.Count = 0 then begin
 294         if Assigned(FOnLoadFailure) then FOnLoadFailure(Self, '\83\8d\83O\82ª\93Ç\82Ý\8eæ\82ê\82Ü\82¹\82ñ');
 295       end;
 296       if Source[0] <> 'OK' then begin
 297       end;
 298       while (i + 7) < Source.Count do begin
 299         LogItem := TLogItem.Create(ltBottle, Source[i+1], Source[i+2],
 300           Source[i+7], Source[i+3], S2D(Source[i]));
 301         LogItem.Votes  := StrToInt(Source[i+5]);
 302         LogItem.Agrees := StrToInt(Source[i+6]);
 303         LogItem.State := lsOpened;
 304         i := i + 8;
 305         Self.Add(LogItem);
 306       end;
 307     finally
 308       SourceStream.Free;
 309       Source.Free;
 310     end;
 311   except
 312     On EConvertError do begin
 313       if Assigned(FOnLoadFailure) then FOnLoadFailure(Self, '\83\8d\83O\82Ì\8c`\8e®\82ª\95s\90³\82Å\82·');
 314       Self.Clear;
 315     end;
 316   end;
 317   FOldSortColumn := stLogTime;
 318   FOldSortDesc := false;
 319   if Assigned(FOnLoaded) then FOnLoaded(Self);
 320 end;
 321
 322 procedure TBottleLogList.LoadFromWeb(DateLo, DateHi: TDateTime;
 323   Channel: String; MinVote, MinAgree: integer);
 324 var Param: String;
 325 begin
 326   Self.Clear;
 327   AddSystemLog('\83_\83E\83\93\83\8d\81[\83h\92\86\82Å\82·');
 328   Param := Format('year_lo=%d&month_lo=%d&day_lo=%d&year_hi=%d&month_hi=%d&day_hi=%d&' +
 329     'minvote=%d&minagree=%d&channel=%s&sort=timedesc&delimiter=%%0D%%0A',
 330     [YearOf(DateLo), MonthOf(DateLo), DayOf(DateLo),
 331      YearOf(DateHi), MonthOf(DateHi), DayOf(DateHi), MinVote, MinAgree,
 332      TIdURI.ParamsEncode(Channel)]);
 333   FHttpThread := THTTPDownloadThread.Create(BottleServer, Pref.CgiFetchLog, Param);
 334   if Pref.UseHttpProxy then begin
 335     FHttpThread.ProxyServer := Pref.ProxyAddress;
 336     FHttpThread.ProxyPort   := Pref.ProxyPort;
 337   end;
 338   FHttpThread.FreeOnTerminate := true;
 339   FHttpThread.OnSuccess := HttpSuccess;
 340   FHttpThread.OnConnectionFailed := HttpFailure;
 341   FHttpThread.Resume;
 342 end;
 343
 344 procedure TBottleLogList.SetOnLoaded(const Value: TNotifyEvent);
 345 begin
 346   FOnLoaded := Value;
 347 end;
 348
 349 procedure TBottleLogList.SetOnLoadFailure(
 350   const Value: TBottleLogLoadFailureEvent);
 351 begin
 352   FOnLoadFailure := Value;
 353 end;
 354
 355 procedure TBottleLogList.SetSelectedIndex(const Value: integer);
 356 begin
 357   FSelectedIndex := Value;
 358 end;
 359
 360 procedure TBottleLogList.SetTitle(const Value: String);
 361 begin
 362   FTitle := Value;
 363 end;
 364
 365 procedure TBottleLogList.SortBottles(LogSortType: TBottleLogSortType);
 366 begin
 367   if FOldSortColumn = LogSortType then
 368     ASortDesc := not FOldSortDesc
 369   else begin
 370     ASortDesc := false;
 371   end;
 372   ASortType := LogSortType;
 373   Self.Sort(LogCompare);
 374   FOldSortColumn := ASortType;
 375   FOldSortDesc := ASortDesc;
 376 end;
 377
 378 end.