{HttpApp,} YofUtils, {URLMon,} BoardGroup, {gzip,} {Dolib,}
{bmRegExp,} AbonUnit, MojuUtils, Setting,
ExternalBoardManager, ExternalBoardPlugInMain{,}
- {Sort,} ,GikoBayesian, HintWindow, ActiveX;
+ {Sort,} ,GikoBayesian, {HintWindow,} ActiveX, ResPopupBrowser;
type
//! \89½\8ds\82Ü\82Å\82½\82ß\82é\82©\82Ì\83T\83C\83Y
FBuffSize: Integer;
//! \83u\83\89\83E\83U\82ÌIHTMLDocument2\83C\83\93\83^\83t\83F\81[\83X\82ð\95Û\8e\9d\82·\82é open\82©\82çclose\82Ì\8aÔ\82Å
- FBrowserDoc: Variant;
+ FBrowserDoc: OleVariant;
public
constructor Create(Browser: TWebBrowser; BuffSize: Integer);
destructor Destory;
sLen :Integer): String;
function isOutsideRange(item: TThreadItem; index: Integer ): Boolean;
function getKeywordLink(item: TThreadItem): String;
+ function GetResString(index: Integer; const Line: String; PResLink : PResLinkRec): String;
public
{ Public \90é\8c¾ }
procedure AddAnchorTag(PRes: PResRec);
procedure CreateHTML2(Browser: TWebBrowser; ThreadItem: TThreadItem; var sTitle: string);
procedure CreateHTML3(var html: TStringList; ThreadItem: TThreadItem; var sTitle: string);
//\83\8c\83X\83|\83b\83v\83A\83b\83v\82Ì\8dì\90¬
- procedure SetResPopupText(Hint :TResPopup; threadItem: TThreadItem; StNum, ToNum: Integer; Title, First: Boolean);
+ procedure SetResPopupText(Hint :TResPopupBrowser; threadItem: TThreadItem; StNum, ToNum: Integer; Title, First: Boolean);
//\83\8a\83\93\83N\82Ì\95¶\8e\9a\97ñ\82©\82ç\83\8c\83X\83|\83b\83v\83A\83b\83v\97p\82ÌURL\82É\95Ï\8a·\82·\82é
class function GetRespopupURL(AText, AThreadURL : string): string;
//\8ew\92è\82µ\82½\83p\83X\82É\83X\83L\83\93\82à\82µ\82\82ÍCSS\82Ì\83t\83@\83C\83\8b\82Ì\83R\83s\81[\82ð\8dì\82é
_END: string = '&END=';
var
i, j, k: Integer;
+ hpos, qpos : Integer;
tmp: string;
res: string;
begin
end else begin
k := LastDelimiter('/', tmp);
Delete(tmp, 1, k);
- if AnsiPos('-', tmp) < AnsiPos('"', tmp) then
- Delete(tmp, AnsiPos('-', tmp), Length(tmp))
- else
- Delete(tmp, AnsiPos('"', tmp), Length(tmp));
+ hpos := AnsiPos('-', tmp);
+ qpos := AnsiPos('"', tmp);
+ if ( (hpos > 0) and (qpos > 0) ) then begin
+ if ( qpos < hpos ) then begin
+ Delete(tmp, qpos, Length(tmp));
+ end else begin
+ Delete(tmp, hpos, Length(tmp));
+ end;
+ end else begin
+ if ( qpos > 0 ) then begin
+ Delete(tmp, qpos, Length(tmp));
+ end else if ( qpos > 0 ) then begin
+ Delete(tmp, hpos, Length(tmp));
+ end;
+ end;
PRes.FBody := PRes.FBody + '<a href="#' + tmp + '">';
end;
procedure THTMLCreate.CreateDefaultHTML (html:TBufferedWebBrowser; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string );
var
i: integer;
- No: string;
NewReceiveNo: Integer;
- Res: TResRec;
ThreadName: String;
ResLink : TResLinkRec;
begin
end;
if (Trim(ReadList[i]) <> '') then begin
- No := IntToStr(i + 1);
- DivideStrLine(ReadList[i], @Res);
- AddAnchorTag(@Res);
- ConvRes(@Res, @ResLink);
- Res.FDateTime := AddBeProfileLink(Res.FDateTime, i + 1);
- if Res.FMailTo = '' then
- html.Add('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> \96¼\91O\81F<font color="forestgreen"><b> ' + Res.FName + ' </b></font> \93\8a\8de\93ú\81F <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>'#13#10)
- else if GikoSys.Setting.ShowMail then
- html.Add('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a>
\96¼
\91O
\81F<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> [' + Res.FMailTo + ']
\93\8a\8de
\93ú
\81F <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>'#13#10)
- else
- html.Add('<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a>
\96¼
\91O
\81F<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a>
\93\8a\8de
\93ú
\81F <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>'#13#10);
+ html.Add(GetResString(i, ReadList[i], @ResLink));
end;
if ThreadItem.Kokomade = (i + 1) then begin
html.Add('</dl>');
html.Add(getKeywordLink(ThreadItem));
html.Add('</dl>'#13#10'<a name="bottom"></a>'#13#10'</body></html>');
end;
-
+function THTMLCreate.GetResString(index: Integer; const Line: String; PResLink : PResLinkRec): String;
+var
+ No : String;
+ Res: TResRec;
+begin
+ No := IntToStr(index + 1);
+ DivideStrLine(Line, @Res);
+ Res.FBody := DeleteLink(Res.FBody);
+ AddAnchorTag(@Res);
+ ConvRes(@Res, PResLink);
+ Res.FDateTime := AddBeProfileLink(Res.FDateTime, index + 1);
+ if Res.FMailTo = '' then
+ Result := '<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> \96¼\91O\81F<font color="forestgreen"><b> ' + Res.FName + ' </b></font> \93\8a\8de\93ú\81F <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>'#13#10
+ else if GikoSys.Setting.ShowMail then
+ Result := '<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a>
\96¼
\91O
\81F<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> [' + Res.FMailTo + ']
\93\8a\8de
\93ú
\81F <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>'#13#10
+ else
+ Result := '<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a>
\96¼
\91O
\81F<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a>
\93\8a\8de
\93ú
\81F <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>'#13#10;
+end;
procedure THTMLCreate.CreateHTML2(Browser: TWebBrowser; ThreadItem: TThreadItem; var sTitle: string);
var
ReadList: TStringList;
end;
end;
-procedure THTMLCreate.SetResPopupText(Hint : TResPopup; threadItem: TThreadItem; StNum, ToNum: Integer; Title, First: Boolean);
+procedure THTMLCreate.SetResPopupText(Hint : TResPopupBrowser; threadItem: TThreadItem; StNum, ToNum: Integer; Title, First: Boolean);
var
i: Integer;
tmp: string;
wkInt: Integer;
- Res: TResRec;
- Header: string;
- Body: string;
boardPlugIn : TBoardPlugIn;
+ Html: TStringList;
+ ResLink : TResLinkRec;
begin
+
+ Html := TStringList.Create;
try
if StNum > ToNum then begin
wkInt := StNum;
if StNum + MAX_POPUP_RES < ToNum then
ToNum := StNum + MAX_POPUP_RES;
+ Hint.Title := '';
+ Hint.RawDocument := '';
+ Hint.Thread := nil;
+
//\83^\83C\83g\83\8b\95\\8e¦
if Title then
if ThreadItem <> nil then
Hint.Title := ThreadItem.Title;
if ThreadItem <> nil then begin
+ Hint.Thread := ThreadItem;
+ ResLink.FBbs := ThreadItem.ParentBoard.BBSID;
+ ResLink.FKey := ChangeFileExt(ThreadItem.FileName, '');
//if ThreadItem.IsBoardPlugInAvailable then begin
if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin
//===== \83v\83\89\83O\83C\83\93\82É\82æ\82é\95\\8e¦
//\82±\82±\82Å\82Q\82¿\82á\82ñ\82Ë\82é\82Ìdat\82Ì\8c`\8e®\82Å\82P\8ds\93Ç\82Ý\8d\9e\82ß\82ê\82Î¥¥¥\81B\81«\93Ç\82ß\82é\82æ\82¤\82É\82È\82Á\82½
tmp := boardPlugIn.GetDat( DWORD( threadItem ), i );
if (tmp <> '') And ( not GikoSys.FAbon.CheckAbonPopupRes(tmp) And( not GikoSys.FAbon.CheckIndividualAbonList(line))) then begin
- DivideStrLine(tmp, @Res);
- if (GikoSys.Setting.ShowMail = false) or (Length(res.FMailTo) = 0) then
- Header := IntToStr(Line) + ' \96¼\91O\81F ' + Res.FName + ' \93\8a\8de\93ú\81F ' + Res.FDateTime
- else
- Header := IntToStr(Line) + ' \96¼\91O\81F ' + Res.FName + ' [' + res.FMailTo + '] \93\8a\8de\93ú\81F ' + Res.FDateTime;
- Header := DeleteFontTag(Header);
- Header := CustomStringReplace(Header, '<br>', '',true);
-
- Body := CustomStringReplace(Res.FBody, '<br> ', #10,true);
- Body := CustomStringReplace(Body, '<br>', #10,true);
- Body := CustomStringReplace(Body, '</a>', '',true);
- Body := THTMLCreate.DeleteLink(Body);
- Body := CustomStringReplace(Body, '<', '<');
- Body := CustomStringReplace(Body, '>', '>');
- Body := CustomStringReplace(Body, '"', '"');
- Body := CustomStringReplace(Body, '&', '&');
- Body := CustomStringReplace(Body, ' ', ' ');
-
- Hint.Add(Header, Body);
+ Html.Add(GetResString(Line-1, tmp, @ResLink));
end;
end;
end else begin
FileName := ThreadItem.FilePath;
tmp := GikoSys.ReadThreadFile(FileName, Line);
if (tmp <> '') And ( not GikoSys.FAbon.CheckAbonPopupRes(tmp) And( not GikoSys.FAbon.CheckIndividualAbonList(line))) then begin
- DivideStrLine(tmp, @Res);
- if (GikoSys.Setting.ShowMail = false) or (Length(res.FMailTo) = 0) then
- Header := IntToStr(Line) + ' \96¼\91O\81F ' + Res.FName + ' \93\8a\8de\93ú\81F ' + Res.FDateTime
- else
- Header := IntToStr(Line) + ' \96¼\91O\81F ' + Res.FName + ' [' + res.FMailTo + '] \93\8a\8de\93ú\81F ' + Res.FDateTime;
-
- Body := DeleteFontTag(Res.FBody);
- Body := CustomStringReplace(Body, '<br> ', #10,true);
- Body := CustomStringReplace(Body, '<br>', #10,true);
- Body := CustomStringReplace(Body, '</a>', '',true);
- Body := THTMLCreate.DeleteLink(Body);
- Body := CustomStringReplace(Body, '<', '<');
- Body := CustomStringReplace(Body, '>', '>');
- Body := CustomStringReplace(Body, '"', '"');
- Body := CustomStringReplace(Body, '&', '&');
- Body := CustomStringReplace(Body, ' ', ' ');
- Hint.Add(Header, Body);
+ Html.Add(GetResString(Line-1, tmp, @ResLink));
end;
end;
end;
+ if (Html.Count > 0) then begin
+ Hint.RawDocument := '<DL>' + Html.Text + '</DL>';
+ end;
end;
finally
+ Html.Free;
end;
end;
Line := CustomStringReplace(Line, '\81\97\81M', ',');
end;
//Trim\82µ\82Ä\82Í\82¢\82¯\82È\82¢\8bC\82ª\82·\82é\81@by\82à\82¶\82ã
- PRes.FName := RemoveToken(Line, delimiter);
- PRes.FMailTo := RemoveToken(Line, delimiter);
- PRes.FDateTime := RemoveToken(Line, delimiter);
- PRes.FBody := RemoveToken(Line, delimiter);
+ PRes.FName := MojuUtils.RemoveToken(Line, delimiter);
+ PRes.FMailTo := MojuUtils.RemoveToken(Line, delimiter);
+ PRes.FDateTime := MojuUtils.RemoveToken(Line, delimiter);
+ PRes.FBody := MojuUtils.RemoveToken(Line, delimiter);
//\82Q\82¿\82á\82ñ\82Ë\82é\82Æ\82©\82¾\82Æ\81A\96{\95¶\82Ì\90æ\93ª\82É\82P\82Â\94¼\8ap\8bó\94\92\82ª\93ü\82Á\82Ä\82¢\82é\82Ì\82Å\8dí\8f\9c\82·\82é
//\91¼\82Ì\8cf\8e¦\94Â\82Å\81A\83\8c\83X\8e©\91Ì\82Ì\8bó\94\92\82©\82à\82µ\82ê\82È\82¢\82¯\82Ç\82»\82ê\82Í\92ú\82ß\82é
PRes.FBody := TrimLeft(PRes.FBody);
if PRes.FBody = '' then
PRes.FBody := ' ';
- PRes.FTitle := RemoveToken(Line, delimiter);
+ PRes.FTitle := MojuUtils.RemoveToken(Line, delimiter);
end;
{!
class function THTMLCreate.DeleteLink(const s: string): string;
var
s1: string;
- s2: string;
+ mark: string;
idx: Integer;
- i: Integer;
begin
- i := 0;
- Result := '';
- while True do begin
- s1 := GikoSys.GetTokenIndex(s, '<a href="', i);
- s2 := GikoSys.GetTokenIndex(s, '<a href="', i + 1);
-
- idx := Pos('">', s1);
- if idx <> 0 then
- Delete(s1, 1, idx + 1);
- idx := Pos('">', s2);
- if idx <> 0 then
- Delete(s2, 1, idx + 1);
-
- Result := Result + s1 + s2;
-
- if s2 = '' then
- Break;
+ mark := '<a href="';
+ Result := '';
+ s1 := s;
+ idx := AnsiPos(mark, s1);
+ while idx <> 0 do begin
+ Result := Result + Copy(s1, 1, idx - 1);
+ Delete(s1, 1, idx);
+ // \83^\83O\82Ì\83G\83\93\83h\82ð\92T\82·
+ idx := AnsiPos('">', s1);
+ if idx <> 0 then begin
+ Delete(s1, 1, idx + 1);
+ end;
+ // </a> \82Ü\82Å
+ idx := AnsiPos('</a>', s1);
+ if idx <> 0 then begin
+ Result := Result + Copy(s1, 1, idx - 1);
+ Delete(s1, 1, idx + 3);
+ end;
+ idx := AnsiPos(mark, s1);
+ end;
- inc(i, 2);
- end;
+ Result := Result + s1;
end;
{
\brief HTML\89»\82Ì\82½\82ß\82Ì\92u\8a·
end;
procedure TBufferedWebBrowser.Open;
begin
- FBrowserDoc := Idispatch( olevariant(FBrowser.ControlInterface).Document);
+ FBrowserDoc := FBrowser.ControlInterface.Document;
FBrowserDoc.open;
FBrowserDoc.charset := 'Shift_JIS';
end;
finalization
if HTMLCreater <> nil then begin
- HTMLCreater.Free;
- HTMLCreater := nil;
+ FreeAndNil(HTMLCreater);
end;
end.
OSDN Git Service
