interface
uses
- Contnrs, Classes, SysUtils, Dialogs, Forms, HttpThread, BottleDef,
- DateUtils, IdURI, xmldom, XMLIntf,
- msxmldom, XMLDoc;
+ Contnrs, Controls, Classes, SysUtils, Dialogs, Forms, HttpThread, BottleDef,
+ DateUtils, SsParser, XDOM_2_3_J3, Graphics, SppList;
type
TLogType = (ltBottle, ltSystemLog);
TLogState = (lsUnopened, lsPlaying, lsOpened);
- TLogItem = class(TObject)
+
+ THasURL = (huUndefined, huYes, huNo);
+
+ TLogItem = class(TPersistent)
private
FScript: String;
FChannel: String;
FVotes: Integer;
FAgreements: Integer;
FState: TLogState;
+ FHasURL: THasURL;
procedure SetChannel(const Value: String);
procedure SetLogType(const Value: TLogType);
procedure SetMID(const Value: String);
procedure SetVotes(const Value: Integer);
procedure SetAgreements(const Value: Integer);
procedure SetState(const Value: TLogState);
+ procedure SetHasURL(const Value: THasURL);
public
constructor Create(LogType: TLogType; const MID, Channel, Script,
- Ghost: String; LogTime: TDateTime);
+ Ghost: String; LogTime: TDateTime); overload;
+ constructor Create(Source: TLogItem); overload;
property LogType: TLogType read FLogType write SetLogType;
property MID: String read FMID write SetMID;
property Channel: String read FChannel write SetChannel;
property Votes: Integer read FVotes write SetVotes;
property Agrees: Integer read FAgreements write SetAgreements;
property State: TLogState read FState write SetState;
+ property HasURL: THasURL read FHasURL write SetHasURL;
+ procedure Assign(Source: TPersistent); override;
end;
- TBottleLogSortType = (stLogTime, stChannel, stScript, stVote, stAgree);
+ TBottleLogSortType = (stLogTime, stChannel, stGhost, stScript, stVote, stAgree);
TBottleLogLoadFailureEvent = procedure(Sender: TObject; const Message: String) of object;
+ TBottleLogHTMLOutputWork = procedure(Sender: TObject; const Count: integer;
+ var Canceled: boolean) of object;
EXMLFileOpenException = class(Exception);
+ TBottleLogDownloadCondition = packed record
+ IsRange: boolean;
+ RecentCount: integer;
+ DateLo: TDateTime;
+ DateHi: TDateTime;
+ MinVote: integer;
+ MinAgree: integer;
+ Channel: string;
+ end;
+
+ TLogXMLThread = class(TThread)
+ private
+ FList: TObjectList;
+ FFileName: String;
+ FOnLoadFailure: TBottleLogLoadFailureEvent;
+ FOnLoaded: TNotifyEvent;
+ FLoadFailureMessage: String;
+ procedure SetOnLoaded(const Value: TNotifyEvent);
+ procedure SetOnLoadFailure(const Value: TBottleLogLoadFailureEvent);
+ protected
+ procedure Execute; override;
+ procedure DoLoaded;
+ procedure DoLoadFailure;
+ public
+ property OnLoaded: TNotifyEvent read FOnLoaded write SetOnLoaded;
+ property OnLoadFailure: TBottleLogLoadFailureEvent
+ read FOnLoadFailure write SetOnLoadFailure;
+ property List: TObjectList read FList;
+ constructor Create(FileName: String);
+ destructor Destroy; override;
+ end;
+
+ THTMLOutputUseColor = (ucUse, ucNoUse);
+ THTMLOutputImageType = (itNone, itBMP, itPNG, itJPG);
+ THTMLOutputRange = (orAll, orUpward, orSelected);
+
+ THTMLOutputOptions = record
+ ImageDir: String;
+ UseColor: THTMLOutputUseColor;
+ ImageType: THTMLOutputImageType;
+ end;
+
TBottleLogList = class(TObjectList)
private
FOnLoaded: TNotifyEvent;
FHttpThread: THTTPDownloadThread;
+ FXMLThread: TLogXMLThread;
+ FLoadBytes: integer;
FTitle: String;
FOnLoadFailure: TBottleLogLoadFailureEvent;
FOldSortColumn: TBottleLogSortType; // \83\8d\83O\91\8b
FOldSortDesc: boolean; // \83\8d\83O\91\8b
- FSelectedIndex: integer; // \83\8d\83O\91\8b
+ FSelectedIndex: integer;
+ FLastDownloadCondition: TBottleLogDownloadCondition;
+ FOnLoadWork: TNotifyEvent; // \83\8d\83O\91\8b
+ FImagePath: String; // HTML\8fo\97Í\8e\9e\82ÌIMG\83^\83O\82Ì\83p\83X(\91\8a\91Î\82Ü\82½\82Í\90â\91Î\83p\83X)
+ FImageFiles: TStringList;
+ FOnHTMLOutputWork: TBottleLogHTMLOutputWork; // \8fd\95¡\89æ\91\9c\8fo\97Í\82µ\82È\82¢\82½\82ß\82Ì\83`\83F\83b\83J
function GetBottles(Index: integer): TLogItem;
procedure SetOnLoaded(const Value: TNotifyEvent);
procedure HttpSuccess(Sender: TObject);
procedure HttpFailure(Sender: TObject);
+ procedure HttpWork(Sender: TObject; LoadBytes: integer);
+ procedure XMLLoaded(Sener: TObject);
+ procedure XMLLoadFailure(Sender: TObject; const Message: String);
procedure SetTitle(const Value: String);
procedure SetOnLoadFailure(const Value: TBottleLogLoadFailureEvent);
procedure SetSelectedIndex(const Value: integer);
+ procedure SetOnLoadWork(const Value: TNotifyEvent);
+ procedure DoLoadFailure(const ErrorMessage: String);
+ function ColorToHex(const Col: TColor): String;
+ procedure PrintHTMLBottle(Strs: TStringList; Bottle: TLogItem;
+ SsParser: TSsParser; const Options: THTMLOutputOptions);
+ function PrintSurfaceImage(Strs: TStringList; const Ghost: String; ID: integer;
+ const Options: THTMLOutputOptions): boolean;
+ procedure SetOnHTMLOutputWork(const Value: TBottleLogHTMLOutputWork);
public
constructor Create(const Title: String);
destructor Destroy; override;
procedure SortBottles(LogSortType: TBottleLogSortType);
function Bottle(MID: String): TLogItem;
property Bottles[Index: integer]: TLogItem read GetBottles;
- procedure LoadFromWeb(DateLo: TDateTime; DateHi: TDateTime; Channel: String;
- MinVote: integer; MinAgree: integer);
+ procedure LoadFromWeb(const Cond: TBottleLogDownloadCondition);
property Title: String read FTitle write SetTitle;
procedure LoadFromStream(Stream: TStream);
property OnLoaded: TNotifyEvent read FOnLoaded write SetOnLoaded;
+ property OnLoadWork: TNotifyEvent read FOnLoadWork write SetOnLoadWork;
property OnLoadFailure: TBottleLogLoadFailureEvent read FOnLoadFailure write SetOnLoadFailure;
property SelectedIndex: integer read FSelectedIndex write SetSelectedIndex;
procedure AddScriptLog(const Script, Channel, MID, Ghost: String);
procedure SaveToText(const FileName: String);
procedure SaveToSstpLog(const FileName: String;
const WithChannel: boolean = false);
- procedure SaveToXMLFile(const FileName: String; XMLDocument: TXMLDocument);
- procedure LoadFromXMLFile(const FileName: String; XMLDocument: TXMLDocument);
+ procedure SaveToXMLFile(const FileName: String);
+ procedure LoadFromXMLFile(const FileName: String);
+ procedure SaveToHTML(const FileName: String;
+ const Options: THTMLOutputOptions; SsParser: TSsParser);
+ procedure ExtractUniqueChannels(Target: TStrings);
+ procedure ExtractUniqueGhosts(Target: TStrings);
+ property OnHTMLOutputWork: TBottleLogHTMLOutputWork read FOnHTMLOutputWork write SetOnHTMLOutputWork;
end;
var
- CurrentBottleLog: TBottleLogList; //\83J\83\8c\83\93\83g
ASortType: TBottleLogSortType; //LogCompare\8aÖ\90\94\82©\82ç\8c©\82¦\82é\82æ\82¤\82É\88ê\8e\9e\91Þ\94ð\97p
ASortDesc: boolean;
////////////////////////////////////////////////////////////////////////////////
implementation
+uses StrUtils;
+
function LogCompare(Item1, Item2: Pointer): Integer;
var
Log1, Log2: TLogItem;
stChannel: begin
Result := AnsiCompareStr(Log1.Channel, Log2.Channel);
end;
+ stGhost: begin
+ Result := AnsiCompareStr(Log1.Ghost, Log2.Ghost);
+ end;
stScript: begin
Result := AnsiCompareStr(Log1.Script, Log2.Script);
end;
FState := Value;
end;
+procedure TLogItem.Assign(Source: TPersistent);
+var Src: TLogItem;
+begin
+ if not (Source is TLogItem) then
+ inherited
+ else begin
+ Src := Source as TLogItem;
+ self.FScript := Src.FScript;
+ self.FChannel := Src.FChannel;
+ self.FMID := Src.FMID;
+ self.FLogTime := Src.FLogTime;
+ self.FLogType := Src.FLogType;
+ self.FGhost := Src.FGhost;
+ self.FVotes := Src.FVotes;
+ self.FAgreements := Src.FAgreements;
+ self.FState := Src.FState;
+ self.FHasURL := Src.FHasURL;
+ end;
+end;
+
+constructor TLogItem.Create(Source: TLogItem);
+begin
+ self.Assign(Source);
+end;
+
+procedure TLogItem.SetHasURL(const Value: THasURL);
+begin
+ FHasURL := Value;
+end;
+
{ TBottleLogList }
procedure TBottleLogList.AddScriptLog(const Script, Channel, MID,
var LogItem: TLogItem;
begin
LogItem := TLogItem.Create(ltBottle, MID, Channel, Script, Ghost, Now());
- Insert(0, LogItem);
+ try
+ Insert(0, LogItem);
+ except
+ LogItem.Free;
+ raise;
+ end;
end;
procedure TBottleLogList.AddSystemLog(const MessageString: String);
var LogItem: TLogItem;
begin
LogItem := TLogItem.Create(ltSystemLog, '', '', MessageString, '', Now());
- Insert(0, LogItem);
+ try
+ Insert(0, LogItem);
+ except
+ LogItem.Free;
+ raise;
+ end;
end;
function TBottleLogList.Bottle(MID: String): TLogItem;
end;
end;
+function TBottleLogList.ColorToHex(const Col: TColor): String;
+var
+ RGB: integer;
+ R, G, B: byte;
+begin
+ RGB := ColorToRGB(Col);
+ R := RGB and $FF;
+ G := (RGB and $FF00) shr 8;
+ B := (RGB and $FF0000) shr 16;
+ RGB := (R shl 16) or (G shl 8) or B;
+ Result := '#' + IntToHex(RGB, 6);
+end;
+
constructor TBottleLogList.Create(const Title: String);
begin
inherited Create;
end;
end;
+procedure TBottleLogList.DoLoadFailure(const ErrorMessage: String);
+begin
+ self.Clear;
+ self.AddSystemLog(ErrorMessage);
+ if Assigned(FOnLoadFailure) then FOnLoadFailure(self, ErrorMessage);
+end;
+
+procedure TBottleLogList.ExtractUniqueChannels(Target: TStrings);
+var i: integer;
+begin
+ // \82±\82Ì\83\8d\83O\92\86\82Ì\83`\83\83\83\93\83l\83\8b\82ð\8eæ\82è\8fo\82·
+ // TStrings\82Ì\8eÀ\91\95\82ÍTHashedStringList\90\84\8f§
+ for i := 0 to Count-1 do
+ if Target.IndexOf(Bottles[i].Channel) < 0 then
+ if Bottles[i].Channel <> '' then
+ Target.Add(Bottles[i].Channel);
+end;
+
+procedure TBottleLogList.ExtractUniqueGhosts(Target: TStrings);
+var i: integer;
+begin
+ // \82±\82Ì\83\8d\83O\92\86\82Ì\83S\81[\83X\83g\82ð\8eæ\82è\8fo\82·
+ // TStrings\82Ì\8eÀ\91\95\82ÍTHashedStringList\90\84\8f§
+ for i := 0 to Count-1 do
+ if Target.IndexOf(Bottles[i].Ghost) < 0 then
+ if Bottles[i].Ghost <> '' then
+ Target.Add(Bottles[i].Ghost);
+end;
+
function TBottleLogList.GetBottles(Index: integer): TLogItem;
begin
Result := Items[Index] as TLogItem;
procedure TBottleLogList.HttpFailure(Sender: TObject);
begin
- if Assigned(FOnLoadFailure) then FOnLoadFailure(Self, '\83T\81[\83o\82Ì\90Ú\91±\82É\8e¸\94s\82µ\82Ü\82µ\82½');
+ if Assigned(FOnLoadFailure) then
+ DoLoadFailure('\83T\81[\83o\82Ì\90Ú\91±\82É\8e¸\94s\82µ\82Ü\82µ\82½');
end;
procedure TBottleLogList.HttpSuccess(Sender: TObject);
var Stream: TStringStream;
StrList: TStringList;
begin
- StrList := nil;
- Stream := nil;
+ Stream := TStringStream.Create(FHttpThread.RecvString);
try
- Stream := TStringStream.Create(FHttpThread.RecvString);
StrList := TStringList.Create;
- StrList.Text := Stream.DataString;
- if StrList[0] <> 'Result: OK' then begin
- if Assigned(FOnLoadFailure) then
- FOnLoadFailure(Self, '\83T\81[\83o\82ª\83G\83\89\81[\82ð\95Ô\82µ\82Ü\82µ\82½'#13#10 + Stream.DataString);
- end else begin
- while StrList.Count > 0 do
- if StrList[0] <> '' then StrList.Delete(0) else Break; //\83w\83b\83_\81[\82ð\8dí\8f\9c\82·\82é
- if StrList.Count > 0 then StrList.Delete(0); //\83w\83b\83_\81[\8cã\82Ì\8bó\8ds\8dí\8f\9c
- Stream.Seek(0, soFromBeginning);
- Stream.Size := Length(StrList.Text);
- Stream.WriteString(StrList.Text);
- Stream.Seek(0, soFromBeginning);
- LoadFromStream(Stream);
+ try
+ StrList.Text := Stream.DataString;
+ if StrList[0] <> 'Result: OK' then begin
+ if Assigned(FOnLoadFailure) then
+ DoLoadFailure('\83T\81[\83o\82ª\83G\83\89\81[\82ð\95Ô\82µ\82Ü\82µ\82½'#13#10 + Stream.DataString);
+ end else begin
+ while StrList.Count > 0 do
+ if StrList[0] <> '' then StrList.Delete(0) else Break; //\83w\83b\83_\81[\82ð\8dí\8f\9c\82·\82é
+ if StrList.Count > 0 then StrList.Delete(0); //\83w\83b\83_\81[\8cã\82Ì\8bó\8ds\8dí\8f\9c
+ Stream.Seek(0, soFromBeginning);
+ Stream.Size := Length(StrList.Text);
+ Stream.WriteString(StrList.Text);
+ Stream.Seek(0, soFromBeginning);
+ LoadFromStream(Stream);
+ end;
+ finally
+ StrList.Free;
end;
finally
Stream.Free;
end;
end;
+procedure TBottleLogList.HttpWork(Sender: TObject; LoadBytes: integer);
+begin
+ self.Clear;
+ AddSystemLog(Format('\83_\83E\83\93\83\8d\81[\83h\92\86\82Å\82· - %4d KB', [LoadBytes div 1024]));
+ FLoadBytes := LoadBytes;
+ if Assigned(FOnLoadWork) then FOnLoadWork(self);
+end;
+
procedure TBottleLogList.LoadFromStream(Stream: TStream);
var i: integer;
+ agree: integer;
+ vote: integer;
SourceStream: TStringStream;
Source: TStringList;
LogItem: TLogItem;
StrToInt(Copy(S, 9, 2)), StrToInt(Copy(S, 11, 2)), StrToInt(Copy(S, 13, 2)), 0);
end;
begin
- Self.Clear;
Source := nil;
SourceStream := nil;
try
Source.Text := SourceStream.DataString;
i := 0;
if Source.Count = 0 then begin
- if Assigned(FOnLoadFailure) then FOnLoadFailure(Self, '\83\8d\83O\82ª\93Ç\82Ý\8eæ\82ê\82Ü\82¹\82ñ');
+ DoLoadFailure('\8ew\92è\8fð\8c\8f\82Ì\83\8d\83O\82Í\91¶\8dÝ\82µ\82Ü\82¹\82ñ');
+ Exit;
end;
if Source[0] <> 'OK' then begin
end;
+ Self.Clear;
while (i + 7) < Source.Count do begin
- LogItem := TLogItem.Create(ltBottle, Source[i+1], Source[i+2],
- Source[i+7], Source[i+3], S2D(Source[i]));
- LogItem.Votes := StrToInt(Source[i+5]);
- LogItem.Agrees := StrToInt(Source[i+6]);
- LogItem.State := lsOpened;
+ vote := StrToInt(Source[i+5]);
+ agree := StrToInt(Source[i+6]);
+
+ //\93\8a\95[\81E\93¯\88Ó\8fð\8c\8f\8ew\92è\82Í\82±\82±\82Å\8eÀ\8c»
+ //FIXME FIXME - \97Í\8bZ\82·\82¬\82Ü\82·\81A\81A\81A
+ if vote >= FLastDownloadCondition.MinVote then begin
+ if agree >= FLastDownloadCondition.MinAgree then begin
+ LogItem := TLogItem.Create(ltBottle, Source[i+1], Source[i+2],
+ Source[i+7], Source[i+3], S2D(Source[i]));
+
+ LogItem.Votes := vote;
+ LogItem.Agrees := agree;
+ LogItem.State := lsOpened;
+ Self.Add(LogItem);
+ end;
+ end;
+
i := i + 8;
- Self.Add(LogItem);
end;
finally
SourceStream.Free;
end;
except
On EConvertError do begin
- if Assigned(FOnLoadFailure) then FOnLoadFailure(Self, '\83\8d\83O\82Ì\8c`\8e®\82ª\95s\90³\82Å\82·');
+ DoLoadFailure('\83T\81[\83o\89\9e\93\9a\82Ì\8c`\8e®\82ª\95s\90³\82Å\82·');
Self.Clear;
end;
end;
if Assigned(FOnLoaded) then FOnLoaded(Self);
end;
-procedure TBottleLogList.LoadFromWeb(DateLo, DateHi: TDateTime;
- Channel: String; MinVote, MinAgree: integer);
+procedure TBottleLogList.LoadFromWeb(const Cond: TBottleLogDownloadCondition);
var Param: String;
begin
Self.Clear;
- AddSystemLog('\83_\83E\83\93\83\8d\81[\83h\92\86\82Å\82·');
- Param := Format('year_lo=%d&month_lo=%d&day_lo=%d&year_hi=%d&month_hi=%d&day_hi=%d&' +
- 'minvote=%d&minagree=%d&channel=%s&sort=timedesc&delimiter=%%0D%%0A',
- [YearOf(DateLo), MonthOf(DateLo), DayOf(DateLo),
- YearOf(DateHi), MonthOf(DateHi), DayOf(DateHi), MinVote, MinAgree,
- TIdURI.ParamsEncode(Channel)]);
- FHttpThread := THTTPDownloadThread.Create(BottleServer, Pref.CgiFetchLog, Param);
+ AddSystemLog('\83_\83E\83\93\83\8d\81[\83h\92\86\82Å\82· - \83T\81[\83o\82©\82ç\89\9e\93\9a\91Ò\82¿');
+
+ FLastDownloadCondition := Cond;
+ with Cond do begin
+ if Cond.IsRange then begin
+ Param := Format('year_lo=%d&month_lo=%d&day_lo=%d&year_hi=%d&month_hi=%d&day_hi=%d&',
+ [YearOf(DateLo), MonthOf(DateLo), DayOf(DateLo),
+ YearOf(DateHi), MonthOf(DateHi), DayOf(DateHi)]);
+ end else begin
+ Param := Format('recent=%d&', [RecentCount]);
+ end;
+ Param := Param + Format('channel=%s&sort=timedesc&delimiter=%%0D%%0A',
+ [ParamsEncode(Channel)]);
+ end;
+ FHttpThread := THTTPDownloadThread.Create(Pref.BottleServer, Pref.CgiFetchLog, Param);
if Pref.UseHttpProxy then begin
FHttpThread.ProxyServer := Pref.ProxyAddress;
FHttpThread.ProxyPort := Pref.ProxyPort;
+ if Pref.ProxyNeedAuthentication then begin
+ FHttpThread.ProxyUser := Pref.ProxyUser;
+ FHttpThread.ProxyPass := Pref.ProxyPass;
+ end;
end;
FHttpThread.FreeOnTerminate := true;
FHttpThread.OnSuccess := HttpSuccess;
FHttpThread.OnConnectionFailed := HttpFailure;
+ FHttpThread.OnHttpWork := HttpWork;
+
+ FLoadBytes := 0;
FHttpThread.Resume;
end;
-procedure TBottleLogList.LoadFromXMLFile(const FileName: String;
- XMLDocument: TXMLDocument);
-var i: integer;
- Time: TDateTime;
- ANode: IXMLNode;
- Item: TLogItem;
+procedure TBottleLogList.LoadFromXMLFile(const FileName: String);
begin
Self.Clear;
- XMLDocument.XML.LoadFromFile(FileName);
- with XMLDocument do begin
+ AddSystemLog('\83\8d\81[\83h\92\86...');
+ FXMLThread := TLogXMLThread.Create(FileName);
+ FXMLThread.FreeOnTerminate := true; // \8f\9f\8eè\82É\8fÁ\82¦\82Ä\82à\82ç\82¤
+ with FXMLThread do
+ begin
+ OnLoaded := XMLLoaded;
+ OnLoadFailure := XMLLoadFailure;
+ Resume;
+ end;
+end;
+
+procedure TBottleLogList.PrintHTMLBottle(Strs: TStringList;
+ Bottle: TLogItem; SsParser: TSsParser; const Options: THTMLOutputOptions);
+var
+ i: integer;
+ InScope1, InSync: boolean;
+ Talk, Tag: String;
+ sur0, sur1, sur: integer;
+ procedure TalkEnd;
+ var Cl: String;
+ begin
+ if Talk = '' then
+ Exit;
+ if InSync then Cl := 'synchronized'
+ else if InScope1 then Cl := 'scope1'
+ else Cl := 'scope0';
+ if Options.ImageType = itNone then
+ begin
+ with Strs do
+ begin
+ Add(' <tr class="' + Cl + '">');
+ Add(' <td class="talk">' + XMLEntity(Talk) + '</td>');
+ Add(' </tr>');
+ end;
+ end else
+ begin
+ with Strs do
+ begin
+ Add(' <tr class="' + Cl + '">');
+ Add(' <td class="surface">');
+ if InSync then
+ begin
+ PrintSurfaceImage(Strs, Bottle.Ghost, Sur0, Options);
+ PrintSurfaceImage(Strs, Bottle.Ghost, Sur1, Options);
+ end else if InScope1 then
+ begin
+ PrintSurfaceImage(Strs, Bottle.Ghost, Sur1, Options);
+ end else
+ begin
+ PrintSurfaceImage(Strs, Bottle.Ghost, Sur0, Options);
+ end;
+ Add(' </td>');
+ Add(' <td class="talk">' + Talk + '</td>');
+ Add(' </tr>');
+ end;
+ end;
+ Talk := '';
+ end; // of sub-procedure TalkEnd
+begin
+ SsParser.EscapeInvalidMeta := false;
+ SsParser.LeaveEscape := false;
+ SsParser.InputString := Bottle.Script;
+ InScope1 := false;
+ InSync := false;
+ sur0 := 0;
+ sur1 := 10;
+ for i := 0 to SsParser.Count-1 do
+ case SsParser.MarkUpType[i] of
+ mtStr, mtMeta:
+ Talk := Talk + XMLEntity(SsParser.Str[i]);
+ mtTag:
+ begin
+ Tag := SsParser.Str[i];
+ if (Tag = '\h') then
+ begin
+ if InScope1 and not InSync then
+ TalkEnd;
+ InScope1 := false;
+ end else if (Tag = '\u') then
+ begin
+ if not InScope1 and not InSync then
+ TalkEnd;
+ InScope1 := true;
+ end else if Tag = '\_s' then
+ begin
+ TalkEnd;
+ InSync := not InSync;
+ end else if SsParser.Match(Tag, '\s%d') = 3 then
+ begin
+ TalkEnd;
+ sur := Ord(Tag[3]) - Ord('0');
+ if InSync then
+ begin
+ sur0 := sur;
+ sur1 := sur;
+ end else if InScope1 then
+ sur1 := sur
+ else
+ sur0 := sur;
+ end else if (SsParser.Match(Tag, '\s[%D]') > 0) or (Tag = '\s[-1]') then
+ begin
+ TalkEnd;
+ sur := StrToInt(SsParser.GetParam(Tag, 1));
+ if InSync then
+ begin
+ sur0 := sur;
+ sur1 := sur;
+ end else if InScope1 then
+ sur1 := sur
+ else
+ sur0 := sur;
+ end else if SsParser.Match(Tag, '\n') >= 2 then
+ begin
+ if Talk <> '' then
+ Talk := Talk + '<br>';
+ end else if Tag = '\c' then
+ begin
+ TalkEnd;
+ end;
+ end;
+ end;
+ TalkEnd;
+end;
+
+function TBottleLogList.PrintSurfaceImage(Strs: TStringList; const Ghost: String;
+ ID: integer; const Options: THTMLOutputOptions): boolean;
+var
+ Bmp: TBitmap;
+ Path, Ext, Name: String;
+begin
+ Result := false;
+ if (ID < 0) or (Ghost = '') then
+ Exit;
+ Ext := 'bmp';
+ Name := Format('%s,%d.%s', [SafeFileName(Ghost), ID, Ext]);
+ if FImageFiles.IndexOf(Name) >= 0 then
+ begin
+ Strs.Add(Format(' <img src="%s\%s" alt="%s,%d">',
+ [FImagePath, XMLEntity(Name), XMLEntity(Ghost), ID]));
+ Result := true;
+ end else
+ begin
+ Bmp := TBitmap.Create;
try
- Active := true;
- except
- on E: Exception do
- raise EXMLFileOpenException.Create('\97L\8cø\82ÈXML\8c`\8e®\82Å\82Í\82 \82è\82Ü\82¹\82ñ\81B'#13#10 + E.Message);
+ if Spps.TryGetImage(Ghost, ID, Bmp) then
+ begin
+ Path := Options.ImageDir + PathDelim + Name;
+ Bmp.SaveToFile(Path);
+ Strs.Add(Format(' <img src="%s\%s" alt="%s,%d">',
+ [FImagePath, XMLEntity(Name), XMLEntity(Ghost), ID]));
+ Result := true;
+ FImageFiles.Add(Name); // \8e\9f\89ñ\82©\82ç\8cÄ\82Ñ\8fo\82³\82È\82\82Ä\82¢\82¢\82æ\82¤\82É\82·\82é
+ end else
+ Strs.Add(Format(' [%d]', [ID]));
+ finally
+ Bmp.Free;
end;
- if DocumentElement = nil then
- raise EXMLFileOpenException.Create('\97L\8cø\82È\8c`\8e®\82Å\82Í\82 \82è\82Ü\82¹\82ñ\81B\83\8b\81[\83g\83^\83O\82ª\82 \82è\82Ü\82¹\82ñ');
- if DocumentElement.NodeName <> 'bottlelog' then
- raise EXMLFileOpenException.Create('\97L\8cø\82È\8c`\8e®\82Å\82Í\82 \82è\82Ü\82¹\82ñ\81Bbottlelog\82ª\8c©\82Â\82©\82è\82Ü\82¹\82ñ');
- if DocumentElement.Attributes['version'] <> '1.0' then
- raise EXMLFileOpenException.Create('\97L\8cø\82È\8c`\8e®\82Å\82Í\82 \82è\82Ü\82¹\82ñ\81B\82±\82Ì\83\8d\83O\83t\83@\83C\83\8b\82Ì\83o\81[\83W\83\87\83\93\82Í\93Ç\82Ý\8d\9e\82ß\82Ü\82¹\82ñ');
- for i := 0 to DocumentElement.ChildNodes.Count-1 do begin
- ANode := DocumentElement.ChildNodes[i];
- Item := nil;
- try
- if TryStrToDateTime(ANode.ChildValues['date'], Time) then begin
- Item := TLogItem.Create(
- ltBottle,
- ANode.Attributes['mid'],
- ANode.ChildNodes['channel'].Text,
- ANode.ChildNodes['script'].Text,
- ANode.ChildNodes['ghost'].Text,
- Time,
- );
- Item.Votes := StrToIntDef(ANode.ChildNodes['votes'].Text, 0);
- Item.Agrees := StrToIntDef(ANode.ChildNodes['agrees'].Text, 0);
- Item.State := lsOpened;
- Self.Add(Item);
+ end;
+end;
+
+procedure TBottleLogList.SaveToHTML(const FileName: String;
+ const Options: THTMLOutputOptions; SsParser: TSsParser);
+var
+ i: integer;
+ Strs: TStringList;
+ ChannelAndGhost: String;
+ Cancel: boolean;
+begin
+ if ExtractFilePath(FileName) = ExtractFilePath(Options.ImageDir) then
+ FImagePath := ExtractFileName(Options.ImageDir)
+ else
+ FImagePath := Options.ImageDir;
+
+ Screen.Cursor := crHourGlass;
+ FImageFiles := TStringList.Create;
+ try
+ Strs := TStringList.Create;
+ try
+ with Strs do
+ begin
+ Add('<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN">');
+ Add('<html>');
+ Add('<style type="text/css"><!--');
+ Add('table.bottle td{font-family: monospace}');
+ if Options.UseColor = ucUse then
+ begin
+ Add(Format('p.bottleattr {color: %s}', [ColorToHex(Pref.TalkColorH)]));
+ Add(Format('body {background-color: %s}', [ColorToHex(Pref.BgColor)]));
+ Add(Format('table.bottle tr.scope0 td.talk{color: %s}', [ColorToHex(Pref.TalkColorH)]));
+ Add(Format('table.bottle tr.scope1 td.talk{color: %s}', [ColorToHex(Pref.TalkColorU)]));
+ Add(Format('table.bottle tr.synchronized td.talk{color: %s}', [ColorToHex(Pref.TalkColorS)]));
+ Add('table.bottle td.surface {text-align: center}');
end;
- except
- Item.Free;
+ Add('--></style>');
+ for i := 0 to Self.Count-1 do
+ begin
+ if Assigned(FOnHTMLOutputWork) then
+ begin
+ Cancel := false;
+ FOnHTMLOutputWork(Self, i, Cancel);
+ if Cancel then
+ Exit;
+ end;
+ if Bottles[i].Ghost <> '' then
+ ChannelAndGhost := XMLEntity(Bottles[i].Channel) + '/' + XMLEntity(Bottles[i].Ghost)
+ else
+ ChannelAndGhost := XMLEntity(Bottles[i].Channel);
+ Add(Format('<p class="bottleattr">%s %s \93\8a\95[%d \93¯\88Ó%d</p>', [
+ FormatDateTime('yyyy/mm/dd hh:nn:ss', Bottles[i].LogTime),
+ ChannelAndGhost,
+ Bottles[i].Votes,
+ Bottles[i].Agrees
+ ]));
+ Add('<table class="bottle">');
+ PrintHTMLBottle(Strs, Bottles[i], SsParser, Options);
+ Add('</table>');
+ Add('<hr>');
+ end;
+ Add('</html>');
+ SaveToFile(FileName);
end;
+ finally
+ Strs.Free;
end;
+ finally
+ FImageFiles.Free;
+ Screen.Cursor := crArrow;
end;
end;
end;
end;
-procedure TBottleLogList.SaveToXMLFile(const FileName: String;
- XMLDocument: TXMLDocument);
+procedure TBottleLogList.SaveToXMLFile(const FileName: String);
var i: integer;
- ANode, BNode: IXMLNode;
+ MessageNode, Child: TdomElement;
Item: TLogItem;
+ DOM: TdomDocument;
+ Parser: TXmlToDomParser;
+ Impl: TDomImplementation;
+ FS: TFileStream;
begin
- with XMLDocument do begin
+ Impl := TDomImplementation.create(nil);
+ try
+ Parser := TXmlToDomParser.create(nil);
+ Parser.DOMImpl := Impl;
try
- XML.LoadFromFile(ExtractFilePath(Application.ExeName)+'xbtl.dat');
- Active := true;
- except
- ShowMessage('xbtl.dat\82ð\8dÄ\83C\83\93\83X\83g\81[\83\8b\82µ\82Ä\82\82¾\82³\82¢\81B');
- raise;
- end;
- DocumentElement.Attributes['saved'] := FormatDateTime('yy/mm/dd hh:nn:ss', Now);
- DocumentElement.Attributes['generator'] := VersionString;
- DocumentElement.Attributes['version'] := '1.0';
- for i := 0 to Self.Count-1 do begin
- Item := Self[i] as TLogItem;
- if Item.LogType <> ltBottle then Continue;
- ANode := DocumentElement.AddChild('message');
- ANode.Attributes['mid'] := Item.MID;
- BNode := ANode.AddChild('date');
- BNode.Text := FormatDateTime('yy/mm/dd hh:nn:ss', Item.LogTime);
- BNode := ANode.AddChild('channel');
- BNode.Text := Item.Channel;
- BNode := ANode.AddChild('script');
- BNode.Text := Item.Script;
- BNode := ANode.AddChild('votes');
- BNode.Text := IntToStr(Item.Votes);
- BNode := ANode.AddChild('agrees');
- BNode.Text := IntToStr(Item.Agrees);
- BNode := ANode.AddChild('ghost');
- BNode.Text := Item.Ghost;
+ try
+ DOM := Parser.fileToDom(ExtractFilePath(Application.ExeName)+'xbtl.dat');
+ // \82±\82ê\82Í\96¾\8e¦\93I\82ÉFree\82µ\82È\82\82Ä\82æ\82¢
+ with DOM do
+ begin
+ documentElement.setAttribute('saved',
+ FormatDateTime('yy/mm/dd hh:nn:ss', Now));
+ documentElement.setAttribute('generator', VersionString);
+ documentElement.setAttribute('version', '1.0');
+ for i := 0 to Self.Count-1 do begin
+ Item := Self.GetBottles(i);
+ MessageNode := createElement('message');
+ MessageNode.setAttribute('mid', Item.MID);
+ documentElement.appendChild(MessageNode);
+
+ // \93ú\95t
+ Child := createElement('date');
+ Child.appendChild(createTextNode(FormatDateTime('yy/mm/dd hh:nn:ss', Item.LogTime)));
+ MessageNode.appendChild(Child);
+ // \83`\83\83\83\93\83l\83\8b
+ Child := createElement('channel');
+ Child.appendChild(createTextNode(Item.Channel));
+ MessageNode.appendChild(Child);
+ // \83X\83N\83\8a\83v\83g
+ Child := createElement('script');
+ Child.appendChild(createTextNode(Item.Script));
+ MessageNode.appendChild(Child);
+ // \93\8a\95[
+ Child := createElement('votes');
+ Child.appendChild(createTextNode(IntToStr(Item.Votes)));
+ MessageNode.appendChild(Child);
+ // \93¯\88Ó
+ Child := createElement('agrees');
+ Child.appendChild(createTextNode(IntToStr(Item.Agrees)));
+ MessageNode.appendChild(Child);
+ // \83S\81[\83X\83g
+ Child := createElement('ghost');
+ Child.appendChild(createTextNode(Item.Ghost));
+ MessageNode.appendChild(Child);
+
+ end;
+ end;
+ FS := TFileStream.Create(FileName, fmCreate or fmShareExclusive);
+ try
+ DOM.writeCodeAsShiftJIS(FS);
+ finally
+ FS.Free;
+ end;
+ except
+ ShowMessage('xbtl.dat\82ð\8dÄ\83C\83\93\83X\83g\81[\83\8b\82µ\82Ä\82\82¾\82³\82¢\81B');
+ end;
+ finally
+ Parser.DOMImpl.freeDocument(DOM);
+ Parser.Free;
end;
+ finally
+ Impl.Free;
end;
- XMLDocument.XML.SaveToFile(FileName);
+end;
+
+procedure TBottleLogList.SetOnHTMLOutputWork(
+ const Value: TBottleLogHTMLOutputWork);
+begin
+ FOnHTMLOutputWork := Value;
end;
procedure TBottleLogList.SetOnLoaded(const Value: TNotifyEvent);
FOnLoadFailure := Value;
end;
+procedure TBottleLogList.SetOnLoadWork(const Value: TNotifyEvent);
+begin
+ FOnLoadWork := Value;
+end;
+
procedure TBottleLogList.SetSelectedIndex(const Value: integer);
begin
FSelectedIndex := Value;
FOldSortDesc := ASortDesc;
end;
+procedure TBottleLogList.XMLLoaded(Sener: TObject);
+begin
+ Self.Assign(FXMLThread.List);
+ if Assigned(FOnLoaded) then FOnLoaded(Self);
+ FXMLThread := nil;
+end;
+
+procedure TBottleLogList.XMLLoadFailure(Sender: TObject;
+ const Message: String);
+begin
+ if Assigned(FOnLoadFailure) then
+ DoLoadFailure(Message);
+end;
+
+{ TLogXMLThread }
+
+constructor TLogXMLThread.Create(FileName: String);
+begin
+ inherited Create(true);
+ FList := TObjectList.Create(false); // OwnsObject = false (!!)
+ FFileName := FileName;
+end;
+
+destructor TLogXMLThread.Destroy;
+begin
+ FList.Free;
+ inherited;
+end;
+
+procedure TLogXMLThread.DoLoaded;
+begin
+ if Assigned(FOnLoaded) then
+ FOnLoaded(self);
+end;
+
+procedure TLogXMLThread.DoLoadFailure;
+begin
+ if Assigned(FOnLoadFailure) then
+ FOnLoadFailure(self, FLoadFailureMessage);
+end;
+
+procedure TLogXMLThread.Execute;
+var i, j, votes, agrees: integer;
+ Time: TDateTime;
+ ANode, Child: TdomElement;
+ Item: TLogItem;
+ DOM: TdomDocument;
+ Parser: TXmlToDomParser;
+ Impl: TDomImplementation;
+ Str, mid, channel, script, ghost: String;
+begin
+ FList.Clear;
+ Impl := TDomImplementation.create(nil);
+ try
+ Parser := TXmlToDomParser.create(nil);
+ Parser.DOMImpl := Impl;
+ try
+ try
+ DOM := Parser.fileToDom(FFileName); //\82±\82ê\82Í\96¾\8e¦\93I\82ÉFree\82µ\82È\82\82Ä\82æ\82¢
+ DOM.normalize;
+ if not DOM.validate(nil, erReplace) then
+ raise EXMLFileOpenException.Create('\97L\8cø\82È\83{\83g\83\8b\83\8d\83O\8c`\8e®\82Å\82Í\82 \82è\82Ü\82¹\82ñ\81B');
+ with DOM do
+ begin
+ if DocumentElement = nil then
+ begin
+ FLoadFailureMessage := '\97L\8cø\82È\8c`\8e®\82Å\82Í\82 \82è\82Ü\82¹\82ñ\81B' +
+ '\83\8b\81[\83g\83^\83O\82ª\82 \82è\82Ü\82¹\82ñ';
+ Synchronize(DoLoadFailure);
+ Exit;
+ end;
+ if DocumentElement.nodeName <> 'bottlelog' then
+ begin
+ FLoadFailureMessage := '\97L\8cø\82È\8c`\8e®\82Å\82Í\82 \82è\82Ü\82¹\82ñ\81B' +
+ 'bottlelog\82ª\8c©\82Â\82©\82è\82Ü\82¹\82ñ';
+ Synchronize(DoLoadFailure);
+ Exit;
+ end;
+ Str := DocumentElement.getAttribute('version');
+ if Str <> '1.0' then
+ begin
+ FLoadFailureMessage := Format('\97L\8cø\82È\8c`\8e®\82Å\82Í\82 \82è\82Ü\82¹\82ñ\81B' +
+ '\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]);
+ Synchronize(DoLoadFailure);
+ Exit;
+ end;
+ for i := 0 to DocumentElement.childNodes.length-1 do
+ begin
+ if documentElement.childNodes.item(i).nodeType <> ntElement_Node then
+ Continue;
+ ANode := documentElement.childNodes.item(i) as TdomElement;
+ if ANode.nodeName <> 'message' then
+ Continue;
+ mid := ANode.getAttribute('mid');
+ channel := '';
+ script := '';
+ ghost := '';
+ votes := 0;
+ agrees := 0;
+ Time := Now;
+ for j := 0 to ANode.childNodes.length-1 do
+ begin
+ if ANode.childNodes.item(j).nodeType <> ntElement_Node then
+ Continue;
+ Child := ANode.childNodes.item(j) as TdomElement;
+ if Child.nodeName = 'channel' then
+ channel := Trim(Child.textContent)
+ else if Child.nodeName = 'script' then
+ script := Trim(Child.textContent)
+ else if Child.nodeName = 'ghost' then
+ ghost := Trim(Child.textContent)
+ else if Child.nodeName = 'votes' then
+ votes := StrToIntDef(Child.textContent, 0)
+ else if Child.nodeName = 'agrees' then
+ agrees := StrToIntDef(Child.textContent, 0)
+ else if Child.nodeName = 'date' then
+ TryStrToDateTime(Trim(Child.textContent), Time);
+ end;
+ Item := TLogItem.Create(ltBottle, mid, channel, script, ghost, time);
+ Item.Votes := votes;
+ Item.Agrees := agrees;
+ Item.State := lsOpened;
+ try
+ FList.Add(Item);
+ except
+ Item.Free;
+ end;
+ end;
+ Synchronize(DoLoaded);
+ end;
+ except
+ on E: EParserException do
+ begin
+ FLoadFailureMessage := 'XML\89ð\90Í\83G\83\89\81[\81B' + E.Message;
+ Synchronize(DoLoadFailure);
+ Exit;
+ end;
+ on E: Exception do
+ begin
+ FLoadFailureMessage := 'XML\83I\81[\83v\83\93\8e\9e\82É\83G\83\89\81[\82ª\94\90¶\82µ\82Ü\82µ\82½\81B' +
+ E.Message;
+ Synchronize(DoLoadFailure);
+ Exit;
+ end;
+ end;
+ finally
+ Parser.DOMImpl.freeDocument(DOM);
+ Parser.Free;
+ end;
+ finally
+ Impl.Free;
+ end;
+end;
+
+procedure TLogXMLThread.SetOnLoaded(const Value: TNotifyEvent);
+begin
+ FOnLoaded := Value;
+end;
+
+procedure TLogXMLThread.SetOnLoadFailure(const Value: TBottleLogLoadFailureEvent);
+begin
+ FOnLoadFailure := Value;
+end;
+
end.
OSDN Git Service
