6 Contnrs, Classes, SysUtils, Dialogs, Forms, HttpThread, BottleDef,
7 DateUtils, IdURI, xmldom, XMLIntf,
12 TLogType = (ltBottle, ltSystemLog);
13 TLogState = (lsUnopened, lsPlaying, lsOpened);
14 TLogItem = class(TObject)
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);
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;
48 TBottleLogSortType = (stLogTime, stChannel, stScript, stVote, stAgree);
49 TBottleLogLoadFailureEvent = procedure(Sender: TObject; const Message: String) of object;
51 TBottleLogList = class(TObjectList)
53 FOnLoaded: TNotifyEvent;
54 FHttpThread: THTTPDownloadThread;
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
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);
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);
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
94 function LogCompare(Item1, Item2: Pointer): integer;
97 ////////////////////////////////////////////////////////////////////////////////
100 function LogCompare(Item1, Item2: Pointer): Integer;
102 Log1, Log2: TLogItem;
104 Log1 := TLogItem(Item1);
105 Log2 := TLogItem(Item2);
109 if Log1.LogTime = Log2.LogTime then Result := 0
110 else if Log1.LogTime < Log2.LogTime then Result := 1 else Result := -1;
113 Result := AnsiCompareStr(Log1.Channel, Log2.Channel);
116 Result := AnsiCompareStr(Log1.Script, Log2.Script);
119 Result := Log2.Votes - Log1.Votes;
122 Result := Log2.Agrees - Log1.Agrees;
125 if ASortDesc then Result := -Result; //
\8f¸
\8f\87
130 constructor TLogItem.Create(LogType: TLogType; const MID, Channel, Script,
131 Ghost: String; LogTime: TDateTime);
133 Self.LogType := LogType;
135 Self.Script := Script;
136 Self.Channel := Channel;
138 Self.LogTime := LogTime;
139 Self.State := lsUnopened;
142 procedure TLogItem.SetChannel(const Value: String);
147 procedure TLogItem.SetLogType(const Value: TLogType);
152 procedure TLogItem.SetMID(const Value: String);
157 procedure TLogItem.SetScript(const Value: String);
162 procedure TLogItem.SetLogTime(const Value: TDateTime);
167 procedure TLogItem.SetAgreements(const Value: Integer);
169 FAgreements := Value;
172 procedure TLogItem.SetVotes(const Value: Integer);
177 procedure TLogItem.SetGhost(const Value: String);
183 procedure TLogItem.SetState(const Value: TLogState);
190 procedure TBottleLogList.AddScriptLog(const Script, Channel, MID,
192 var LogItem: TLogItem;
194 LogItem := TLogItem.Create(ltBottle, MID, Channel, Script, Ghost, Now());
198 procedure TBottleLogList.AddSystemLog(const MessageString: String);
199 var LogItem: TLogItem;
201 LogItem := TLogItem.Create(ltSystemLog, '', '', MessageString, '', Now());
205 function TBottleLogList.Bottle(MID: String): TLogItem;
209 for i := 0 to Count-1 do
210 if (Items[i] as TLogItem).MID = MID then begin
211 Result := Items[i] as TLogItem;
216 constructor TBottleLogList.Create(const Title: String);
221 FSelectedIndex := -1; //
\91I
\91ð
\82³
\82ê
\82Ä
\82¢
\82È
\82¢
224 destructor TBottleLogList.Destroy;
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;
235 function TBottleLogList.GetBottles(Index: integer): TLogItem;
237 Result := Items[Index] as TLogItem;
240 procedure TBottleLogList.HttpFailure(Sender: TObject);
242 if Assigned(FOnLoadFailure) then FOnLoadFailure(Self, '
\83T
\81[
\83o
\82Ì
\90Ú
\91±
\82É
\8e¸
\94s
\82µ
\82Ü
\82µ
\82½');
245 procedure TBottleLogList.HttpSuccess(Sender: TObject);
246 var Stream: TStringStream;
247 StrList: TStringList;
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);
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);
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ß)
276 procedure TBottleLogList.LoadFromStream(Stream: TStream);
278 SourceStream: TStringStream;
281 function S2D (const S: String): TDateTime;
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);
293 SourceStream := TStringStream.Create('');
294 SourceStream.Seek(0, soFromBeginning);
295 SourceStream.CopyFrom(Stream, Stream.Size);
296 Source := TStringList.Create;
297 Source.Text := SourceStream.DataString;
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ñ');
302 if Source[0] <> 'OK' then begin
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;
318 On EConvertError do begin
319 if Assigned(FOnLoadFailure) then FOnLoadFailure(Self, '
\83\8d\83O
\82Ì
\8c`
\8e®
\82ª
\95s
\90³
\82Å
\82·');
323 FOldSortColumn := stLogTime;
324 FOldSortDesc := false;
325 if Assigned(FOnLoaded) then FOnLoaded(Self);
328 procedure TBottleLogList.LoadFromWeb(DateLo, DateHi: TDateTime;
329 Channel: String; MinVote, MinAgree: integer);
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;
344 FHttpThread.FreeOnTerminate := true;
345 FHttpThread.OnSuccess := HttpSuccess;
346 FHttpThread.OnConnectionFailed := HttpFailure;
350 procedure TBottleLogList.SaveToSstpLog(const FileName: String;
351 const WithChannel: boolean = false);
357 DayStr: array[1..7] of String = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
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)] + ')';
368 Date := Date + ',' + Item.Channel +',SEND,' + Item.Script
370 Date := Date + ',0.0.0.0,SEND,' + Item.Script;
374 Str.SaveToFile(FileName);
380 procedure TBottleLogList.SaveToText(const FileName: String);
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);
396 procedure TBottleLogList.SaveToXmlFile(const FileName: String;
397 XMLDocument: TXMLDocument);
399 ANode, BNode: IXMLNode;
402 with XMLDocument do begin
403 XML.LoadFromFile(ExtractFilePath(Application.ExeName)+'xbtl.xml');
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;
427 XMLDocument.XML.SaveToFile(FileName);
430 procedure TBottleLogList.SetOnLoaded(const Value: TNotifyEvent);
435 procedure TBottleLogList.SetOnLoadFailure(
436 const Value: TBottleLogLoadFailureEvent);
438 FOnLoadFailure := Value;
441 procedure TBottleLogList.SetSelectedIndex(const Value: integer);
443 FSelectedIndex := Value;
446 procedure TBottleLogList.SetTitle(const Value: String);
451 procedure TBottleLogList.SortBottles(LogSortType: TBottleLogSortType);
453 if FOldSortColumn = LogSortType then
454 ASortDesc := not FOldSortDesc
458 ASortType := LogSortType;
459 Self.Sort(LogCompare);
460 FOldSortColumn := ASortType;
461 FOldSortDesc := ASortDesc;