ComCtrls, ToolWin, StdCtrls, ExtCtrls, SsParser, BottleDef, Menus,
Clipbrd, Logs, ShellAPI, Commctrl, DirectSstp, Contnrs, StrUtils,
TalkShowFrame, SppList, HtmlOutputConfig, HtmlOutputProgress,
- SearchLog, IniFiles, BRegExp, RegexUtils;
+ SearchLog, IniFiles, BRegExp, RegexUtils,
+ DateUtils, SAXComps, SAX, BSAX, SAXMS;
type
// \83\8d\83O\82Ì\95Û\91¶\95û\96@
FLVScrollDir: TLVScrollDir; // \83X\83N\83\8d\81[\83\8b\95û\8cü
FLVDragDest: integer; //\83h\83\8d\83b\83v\82·\82é\88Ê\92u(\82·\82®\89º\82É\82\82é\83A\83C\83e\83\80\82ÌIndex)
//
+ // SAX\8aÖ\98A
+ FsReadMess, FsReadElm: boolean;
+ FsDate, FsChannel, FsScript, FsVotes, FsAgrees, FsGhost, FsMid: string;
+ FsNowNode: string;
+ FsLoadFailureMessage: string;
+ FsList: TBottleLogList;
+ //
procedure UpdateScript(const Script: String);
procedure UpdateScriptConversationColor(const Script: String);
procedure UpdateScriptScript(const Script: String);
procedure mnURLClick(Sender: TObject);
- procedure ExtractURLs(Script: String; Result: TStrings);
+ function ExtractURLs(Script: String; Urls: TStrings; Labels: TStrings): Boolean;
function GetDefaultFileName(const Name: String; const Ext: String): String;
function BottleLogTitled(const LogName: String): TBottleLogList;
procedure DrawSingleLineScript(LogItem: TLogItem; Rect: TRect;
procedure PreviewStyleChange;
procedure DrawListViewDragBorder(const Rect: TRect);
function DoSaveLogXML(Log: TBottleLogList): integer;
- procedure DoCloseTab(const Index: integer);
+ procedure DoCloseTab(const Index: integer; FCheck: boolean);
function DoSearchLog(Condition: TSearchCond): TBottleLogList;
procedure SearchLogIndivisual(Condition: TSearchCond;
LogList, Result: TBottleLogList; UntilIndex: integer = -1);
function CheckLogSave(const Index: integer): integer;
+ procedure actLvwLog(FAction: boolean);
+ procedure LoadSAXItemReset;
+ procedure LoadSAXLoader(FileName: String);
+ procedure SAXErrorHandler1Error(Sender: TObject;
+ const Error: ISAXParseError);
+ procedure SAXErrorHandler1FatalError(Sender: TObject;
+ const Error: ISAXParseError);
+ procedure SAXErrorHandler1Warning(Sender: TObject;
+ const Error: ISAXParseError);
+ procedure SAXContentHandler1Characters(Sender: TObject;
+ const PCh: WideString);
+ procedure SAXContentHandler1EndElement(Sender: TObject;
+ const NamespaceURI, LocalName, QName: WideString);
+ procedure SAXContentHandler1StartElement(Sender: TObject;
+ const NamespaceURI, LocalName, QName: WideString;
+ const Atts: IAttributes);
+ procedure DoDOMLoad;
+ procedure DoSAXLoad;
protected
procedure CreateParams(var Params: TCreateParams); override;
public
implementation
-uses MainForm;
+uses MainForm, SAXAdapters;
{$R *.DFM}
procedure TfrmLog.tbtnClearClick(Sender: TObject);
begin
if SelectedBottleLog = nil then Exit;
- DoCloseTab(tabBottleLog.TabIndex);
+ DoCloseTab(tabBottleLog.TabIndex, true);
end;
procedure TfrmLog.FormCreate(Sender: TObject);
TalkShowFrame.SetPreviewFont(edtScript.Font);
TalkShowFrame.PrevControl := lvwLog;
- mnSelAction.Checked := Pref.LogAction; // \8f\89\8aú\89»
-
PreviewStyleChange;
UpdateWindow; // Reset window color and enabled status of some buttons
end;
frmSender.actDeleteLogItem.Enabled := Selected;
mnPopUpCopyScript.Enabled := Selected and IsNormalBottle;
mnPopupCopyGhost.Enabled := Selected and IsNormalBottle;
+ mnSelAction.Enabled := Selected and IsNormalBottle;
end;
-procedure TfrmLog.lvwLogDblClick(Sender: TObject);
+procedure TfrmLog.actLvwLog(FAction: boolean);
var Script, ErrorMes: String;
Log, CueItem: TLogItem;
Res: integer;
if Log.LogType <> ltBottle then
Exit;
//\92P\91Ì\83A\83N\83V\83\87\83\93\82ª\97L\8cø\82Å\82 \82ê\82Î\83X\83N\83\8a\83v\83g\82Ì\95Ï\8a·\82µ\82È\82¢
- if Pref.LogAction then
+ if FAction then
begin
Script := Log.Script;
ErrorMes := '';
CueItem := TLogItem.Create(Log);
try
//\83A\83N\83V\83\87\83\93\82ª\97L\8cø\82Å\82 \82ê\82Î\92Ê\8fí\8f\88\97\9d\8fÈ\97ª
- if Pref.LogAction then
+ if FAction then
+ begin
//\8c^\95Ï\8a·\82Æ\8eó\90M
- frmSender.BottleCnv(CueItem)
- else
+ frmSender.BottleCnv(CueItem);
+ CueItem.FreeInstance;
+ end else
begin
//\83`\83\83\83\93\83l\83\8b\83S\81[\83X\83g\91Î\8dô
if CueItem.Ghost = '' then
end;
end;
+procedure TfrmLog.lvwLogDblClick(Sender: TObject);
+begin
+ actLvwLog(false);
+end;
+
procedure TfrmLog.UpdateScriptConversationColor(const Script: String);
var i: integer;
scr: String;
var Log: TLogItem;
Child: TMenuItem;
Urls: TStringList;
+ Labels: TStringList;
+ ProcessedUrl: String;
+ ProcessedLabel: String;
i: integer;
begin
for i := mnJumpURL.Count-1 downto 0 do begin
Log := SelectedBottleLog.Bottles[lvwLog.Selected.Index];
if Log = nil then Exit;
Urls := TStringList.Create;
+ Labels := TStringList.Create;
try
- ExtractURLs(Log.Script, Urls);
+ ExtractURLs(Log.Script, Urls, Labels);
for i := 0 to Urls.Count-1 do begin
Child := TMenuItem.Create(Self);
with Child do begin
- Caption := Format('(&%d) %s', [i+1, StringReplace(Urls[i], '&', '&&', [rfReplaceAll])]);
+ ProcessedUrl := StringReplace(Urls[i], '&', '&&', [rfReplaceAll]);
+ ProcessedLabel := StringReplace(Labels[i], '&', '&&', [rfReplaceAll]);
+ if Length(ProcessedLabel) > 0 then begin
+ Caption := Format('[%s] %s (&%d)', [ProcessedLabel, ProcessedUrl, i+1]);
+ end else begin
+ Caption := Format('%s (&%d)', [ProcessedUrl, i+1]);
+ end;
Tag := i;
OnClick := mnURLClick;
AutoHotkeys := maManual;
mnJumpURL.Enabled := Urls.Count > 0;
finally
Urls.Free;
+ Labels.Free;
end;
end;
var LogItem: TLogItem;
URL: string;
Urls: TStringList;
+
begin
if (lvwLog.Selected = nil) or (SelectedBottleLog = nil) then Exit;
LogItem := SelectedBottleLog[lvwLog.Selected.Index] as TLogItem;
Urls := TStringList.Create;
try
- ExtractURLs(LogItem.Script, Urls);
+ ExtractURLs(LogItem.Script, Urls, nil);
URL := Urls[(Sender as TMenuItem).Tag];
- frmSender.OpenBrowser(URL);
+ OpenBrowser(URL);
finally
Urls.Free;
end;
end;
-procedure TfrmLog.ExtractURLs(Script: String; Result: TStrings);
-var i, u, j: integer;
+function TfrmLog.ExtractURLs(Script: String; Urls: TStrings; Labels: TStrings): Boolean;
+var i, u, j, count: integer;
s: String;
begin
- Result.Clear;
+ count := 0;
SsParser.InputString := Script;
SsParser.LeaveEscape := true;
for i := 0 to SsParser.Count-1 do begin
'-', '%b', [rfReplaceAll]))) > 0 then begin
for j := 1 to u do begin
s := SsParser.GetParam(SsParser[i], j*2);
- if Pos('http://', s) > 0 then Result.Add(s);
+ if Pos('http://', s) > 0 then begin
+ if Urls <> nil then Urls.Add(s);
+ count := count + 1;
+ end;
+ if Labels <> nil then begin
+ s := SsParser.GetParam(SsParser[i], j*2+1);
+ Labels.Add(s);
+ end;
end;
Break;
end;
end;
- if SsParser.Match(SsParser[i], '\URL%b%b') = 0 then begin //\8aÈ\88Õ\94ÅURL\95Ï\8a·
+ if SsParser.Match(SsParser[i], '\URL%b%b') = 0 then begin
//\8aÈ\88Õ\8c`\8e®\URL\83^\83O\95Ï\8a·
s := SsParser.GetParam(SsParser[i], 1);
- if Pos('http://', s) > 0 then Result.Add(s);
+ if Pos('http://', s) > 0 then begin
+ if Urls <> nil then Urls.Add(s);
+ count := count + 1;
+ end
end;
end;
end;
+
+ //\83\89\83x\83\8b\82Ì\90\94\82ðURL\82Ì\90\94\82É\82 \82í\82¹\82é - \82¢\82¿\82¢\82¿\94»\92è\82µ\82È\82\82Ä\82à\82¢\82¢\82æ\82¤\82É
+ if Urls <> nil then begin
+ if Labels <> nil then begin
+ while Urls.Count > Labels.Count do Labels.Add('');
+ end;
+ end;
+ Result := count > 0;
end;
procedure TfrmLog.SelAndFocusMessage(const MID: String);
procedure TfrmLog.mnCloseTabClick(Sender: TObject);
begin
- DoCloseTab(tabBottleLog.Tag);
+ DoCloseTab(tabBottleLog.Tag, true);
end;
procedure TfrmLog.tbtnFindBottleClick(Sender: TObject);
end;
procedure TfrmLog.tbtnOpenLogClick(Sender: TObject);
+begin
+ if Pref.UseSAXReader then
+ DoSAXLoad
+ else
+ DoDOMLoad;
+end;
+
+procedure TfrmLog.DoDOMLoad;
var BottleLog: TBottleLogList;
i, Index: integer;
begin
if Button = mbMiddle then
begin
//\92\86\83{\83^\83\93\83N\83\8a\83b\83N\82Å\83^\83u\8dí\8f\9c
- DoCloseTab(tabBottleLog.IndexOfTabAt(X, Y));
+ DoCloseTab(tabBottleLog.IndexOfTabAt(X, Y), true);
end else
begin
with tabBottleLog do begin
Ico: TIcon;
sub, Ex: integer;
Bottle: TLogItem;
- DummyStr: TStringList;
begin
Bottle := SelectedBottleLog.Bottles[Item.Index];
if Bottle.HasURL = huUndefined then
begin
- DummyStr := TStringList.Create;
try
- ExtractURLs(Bottle.Script, DummyStr);
- if DummyStr.Count > 0 then
+ if ExtractURLs(Bottle.Script, nil, nil) then
Bottle.HasURL := huYes
else
Bottle.HasURL := huNo;
finally
- DummyStr.Free;
+
end;
end;
Result := Res;
end;
-procedure TfrmLog.DoCloseTab(const Index: integer);
+procedure TfrmLog.DoCloseTab(const Index: integer; FCheck: boolean);
var
Confirm: String;
PrevSelection: TBottleLogList; // \95Â\82¶\82½\82Æ\82«\83^\83u\82ª\82¸\82ê\82È\82¢\82æ\82¤\82É\82·\82é\8f\88\97\9d\97p
i: integer;
begin
- if CheckLogSave(Index) = idCancel then exit; // \83\8d\83O\82Ì\95Û\91¶\8am\94F
- if Pref.ConfirmOnTabClose then
+ if Pref.ConfirmOnTabClose and FCheck then
begin
Confirm := Format('\83^\83u"%s"\82ð\95Â\82¶\82Ü\82·\82©?', [(FBottleLogList[Index] as TBottleLogList).Title]);
if MessageDlg(Confirm, mtConfirmation, mbOkCancel, 0) = mrCancel then
Exit;
end;
+ if CheckLogSave(Index) = idCancel then exit; // \83\8d\83O\82Ì\95Û\91¶\8am\94F
PrevSelection := SelectedBottleLog;
FBottleLogList.Delete(Index);
UpdateTab;
// \91S\82Ä\82Ì\83\8a\83X\83g\81i\83^\83u\81j\83`\83F\83b\83N\82·\82é
// frmSender\82©\82ç\8fI\97¹\8e\9e\82É\8cÄ\82Ñ\8fo\82³\82ê\82é
Res := idNo;
- for i := 0 to BottleLogList.Count-1 do
+ for i := BottleLogList.Count-1 downto 0 do
begin
Res := CheckLogSave(i);
if Res = idCancel then break;
+ DoCloseTab(i, false);
end;
Result := Res;
end;
Res := idNo;
if (BottleLogList[Index] as TBottleLogList).LogModified then
begin
- Confirm := Format('\83^\83u %s \82Ì\93à\97e\82Í\95Ï\8dX\82³\82ê\82Ä\82¢\82Ü\82·\81B'#13#10#13#10 +
+ Confirm := Format('\83^\83u"%s"\82Ì\93à\97e\82Í\95Ï\8dX\82³\82ê\82Ä\82¢\82Ü\82·\81B'#13#10#13#10 +
'\95Û\91¶\82µ\82Ü\82·\82©\81H', [(FBottleLogList[Index] as TBottleLogList).Title]);
Res := MessageDlg(Confirm, mtConfirmation, mbYesNoCancel, 0);
if Res = idYes then
Res := DoSaveLogXML(FBottleLogList[Index] as TBottleLogList);
+ if Res = idNo then
+ (BottleLogList[Index] as TBottleLogList).LogModified := false;
end;
Result := Res;
end;
procedure TfrmLog.mnSelActionClick(Sender: TObject);
begin
- // \92P\91Ì\83A\83N\83V\83\87\83\93\82Ì\97L\96³\82ð\90Ý\92è
- if mnSelAction.Checked then
- mnSelAction.Checked := false
- else
- mnSelAction.Checked := true;
- Pref.LogAction := mnSelAction.Checked;
+ // \92P\91Ì\83A\83N\83V\83\87\83\93
+ actLvwLog(true);
end;
procedure TfrmLog.mnAllActionClick(Sender: TObject);
Screen.Cursor := crDefault;
end;
+procedure TfrmLog.LoadSAXLoader(FileName: String);
+var XMLReader: IXMLReader;
+ XMLBufReader: IBufferedXMLReader;
+ Vendor: TSAXVendor;
+ SAXErrorHandler1: TSAXErrorHandler;
+ SAXContentHandler1: TSAXContentHandler;
+ ContentHandler: IContentHandler;
+begin
+ LoadSAXItemReset;
+ FsReadMess := false;
+ FsNowNode := '';
+ FsReadElm := false;
+ FsLoadFailureMessage := '';
+
+ // \83C\83x\83\93\83g\92è\8b`
+ SAXContentHandler1 := TSAXContentHandler.Create(nil);
+ SAXContentHandler1.OnCharacters := SAXContentHandler1Characters;
+ SAXContentHandler1.OnEndElement := SAXContentHandler1EndElement;
+ SAXContentHandler1.OnStartElement := SAXContentHandler1StartElement;
+
+ SAXErrorHandler1 := TSAXErrorHandler.Create(nil);
+ SAXErrorHandler1.OnWarning := SAXErrorHandler1Warning;
+ SAXErrorHandler1.OnError := SAXErrorHandler1Error;
+ SAXErrorHandler1.OnFatalError := SAXErrorHandler1FatalError;
+
+ ContentHandler := SAXContentHandler1;
+ try
+ // Get the Default SAX Vendor and XML Reader
+ Vendor:= GetSAXVendor('MSXML'); // MSXML\82ð\97\98\97p\82·\82é(\97v:SAX_WIDESTRINGS)
+ if Vendor is TBufferedSAXVendor then
+ begin
+ XMLBufReader:= TBufferedSAXVendor(Vendor).BufferedXMLReader;
+ XMLBufReader.setContentHandler(Adapt(ContentHandler, XMLBufReader));
+ XMLBufReader.setErrorHandler(SAXErrorHandler1);
+ // This time we send the InputSource we created
+ XMLBufReader.parse(FileName);
+ XMLBufReader:= nil;
+ end else
+ begin
+ XMLReader:= Vendor.XMLReader;
+ XMLReader.setContentHandler(ContentHandler);
+ XMLReader.setErrorHandler(SAXErrorHandler1);
+ // This time we send the InputSource we created
+ XMLReader.parse(FileName);
+ XMLReader:= nil;
+ end;
+ finally
+ SAXErrorHandler1.Free;
+ SAXContentHandler1.Free;
+ end;
+end;
+
+procedure TfrmLog.LoadSAXItemReset;
+begin
+ FsDate := '';
+ FsChannel := '';
+ FsScript := '';
+ FsVotes := '';
+ FsAgrees := '';
+ FsGhost := '';
+ FsMid := '';
+end;
+
+procedure TfrmLog.SAXErrorHandler1Error(Sender: TObject;
+ const Error: ISAXParseError);
+begin
+ FsList.AddSystemLog(Error.getMessage + ' Line ' + IntToStr(Error.getLineNumber) +
+ ' Column ' + IntToStr(Error.getColumnNumber));
+end;
+
+procedure TfrmLog.SAXErrorHandler1FatalError(Sender: TObject;
+ const Error: ISAXParseError);
+begin
+ FsList.AddSystemLog(Error.getMessage + ' Line ' + IntToStr(Error.getLineNumber) +
+ ' Column ' + IntToStr(Error.getColumnNumber));
+end;
+
+procedure TfrmLog.SAXErrorHandler1Warning(Sender: TObject;
+ const Error: ISAXParseError);
+begin
+ FsList.AddSystemLog(Error.getMessage + ' Line ' + IntToStr(Error.getLineNumber) +
+ ' Column ' + IntToStr(Error.getColumnNumber));
+end;
+
+procedure TfrmLog.SAXContentHandler1Characters(Sender: TObject;
+ const PCh: WideString);
+begin
+ // \83\8d\83O\8fî\95ñ\93Ç\82Ý\8eæ\82è
+ // &\93\99\82Å\95ª\89ð\82³\82ê\82é\82Ì\82Å\8c\8b\8d\87\82·\82é\95K\97v\82ª\82 \82é
+ if(not FsReadElm)then Exit; // \83\8d\83O\8fî\95ñ\88È\8aO\82Í\96³\8e\8b
+ if(FsNowNode = 'date')then
+ FsDate := PCh;
+ if(FsNowNode = 'channel')then
+ FsChannel := FsChannel + PCh;
+ if(FsNowNode = 'script')then
+ FsScript := FsScript + PCh;
+ if(FsNowNode = 'votes')then
+ FsVotes := PCh;
+ if(FsNowNode = 'agrees')then
+ FsAgrees := Pch;
+ if(FsNowNode = 'ghost')then
+ FsGhost := FsGhost + Pch;
+end;
+
+procedure TfrmLog.SAXContentHandler1EndElement(Sender: TObject;
+ const NamespaceURI, LocalName, QName: WideString);
+var Time: TDateTime;
+ Item: TLogItem;
+begin
+ if(qName = 'message')then
+ begin
+ FsReadMess := false; // \83\8d\83O\8fî\95ñ\8fI\82í\82è
+
+ TryStrToDateTime(Trim(FsDate), Time);
+ Item := TLogItem.Create(ltBottle, FsMid, FsChannel, FsScript, FsGhost, Time);
+ Item.Votes := StrToIntDef(FsVotes, 0);
+ Item.Agrees := StrToIntDef(FsAgrees, 0);
+ Item.State := lsOpened;
+ try
+ FsList.Add(Item);
+ except
+ Item.Free;
+ end;
+ LoadSAXItemReset; // \83\8d\83O\8fî\95ñ\83N\83\8a\83A
+ end;
+ FsReadElm := false; // \83^\83O\8fI\97¹
+end;
+
+procedure TfrmLog.SAXContentHandler1StartElement(Sender: TObject;
+ const NamespaceURI, LocalName, QName: WideString;
+ const Atts: IAttributes);
+begin
+ FsNowNode := qName; // \8d¡\8c©\82Ä\82¢\82é\83m\81[\83h
+ if(qName = 'bottlelog')then // EndElment\82Å\83`\83F\83b\83N\82µ\82Ä\82¢\82È\82¢
+ begin
+ if(Atts.getValue('version') <> '1.0')then
+ begin
+ FsLoadFailureMessage := 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ñ\81B', [Atts.getValue('version')]);
+ raise EXMLFileOpenException.Create(FsLoadFailureMessage);
+ exit;
+ end;
+ end else if(qName = 'message')then
+ begin
+ FsReadMess := true; // \83\8d\83O\8fî\95ñ\93Ç\82Ý\8d\9e\82ÝON
+ FsMid := Atts.getValue('mid');
+ end else if((qName = 'date') // \82±\82Ì\83`\83F\83b\83N\97v\82ç\82È\82¢\82©\82à
+ or (qName = 'channel')
+ or (qName = 'script')
+ or (qName = 'votes')
+ or (qName = 'agrees')
+ or (qName = 'ghost'))then
+ begin
+ FsReadElm := true; // \83^\83O\8aJ\8en
+ end;
+end;
+
+procedure TfrmLog.DoSAXLoad;
+var BottleLog: TBottleLogList;
+ i, Index: integer;
+begin
+ Index := -1;
+ OpenDialog.InitialDir := Pref.LogDir;
+ if OpenDialog.Execute then begin
+ Screen.Cursor := crHourGlass;
+ for i := 0 to OpenDialog.Files.Count-1 do begin
+ BottleLog := TBottleLogList.Create(ExtractFileName(OpenDialog.Files[i]));
+ FsList := BottleLog;
+ try
+ with BottleLog do
+ begin
+ try
+ LoadSAXLoader(OpenDialog.Files[i]);
+ except
+ if FsLoadFailureMessage <> '' then
+ FsList.AddSystemLog(FsLoadFailureMessage);
+ end;
+ end;
+ Index := BottleLogList.Add(FsList); // \8dÅ\8cã\82É\8aJ\82¢\82½\83\8d\83O\82Ì\88Ê\92u\82ð\8bL\89¯
+ except
+ BottleLog.Free;
+ FsList.Free;
+ end;
+ end;
+ Screen.Cursor := crDefault;
+ UpdateTab;
+ if Index >= 0 then tabBottleLog.TabIndex := Index;
+ UpdateWindow;
+ end;
+end;
+
end.
OSDN Git Service
