| 15 |
{HttpApp,} YofUtils, {URLMon,} BoardGroup, {gzip,} {Dolib,} |
{HttpApp,} YofUtils, {URLMon,} BoardGroup, {gzip,} {Dolib,} |
| 16 |
{bmRegExp,} AbonUnit, MojuUtils, Setting, |
{bmRegExp,} AbonUnit, MojuUtils, Setting, |
| 17 |
ExternalBoardManager, ExternalBoardPlugInMain{,} |
ExternalBoardManager, ExternalBoardPlugInMain{,} |
| 18 |
{Sort,} ,GikoBayesian, HintWindow, ActiveX; |
{Sort,} ,GikoBayesian, HintWindow, ActiveX, ResPopupBrowser; |
| 19 |
|
|
| 20 |
type |
type |
| 21 |
|
|
| 69 |
sLen :Integer): String; |
sLen :Integer): String; |
| 70 |
function isOutsideRange(item: TThreadItem; index: Integer ): Boolean; |
function isOutsideRange(item: TThreadItem; index: Integer ): Boolean; |
| 71 |
function getKeywordLink(item: TThreadItem): String; |
function getKeywordLink(item: TThreadItem): String; |
| 72 |
|
function GetResString(index: Integer; const Line: String; PResLink : PResLinkRec): String; |
| 73 |
public |
public |
| 74 |
{ Public 宣言 } |
{ Public 宣言 } |
| 75 |
procedure AddAnchorTag(PRes: PResRec); |
procedure AddAnchorTag(PRes: PResRec); |
| 79 |
procedure CreateHTML2(Browser: TWebBrowser; ThreadItem: TThreadItem; var sTitle: string); |
procedure CreateHTML2(Browser: TWebBrowser; ThreadItem: TThreadItem; var sTitle: string); |
| 80 |
procedure CreateHTML3(var html: TStringList; ThreadItem: TThreadItem; var sTitle: string); |
procedure CreateHTML3(var html: TStringList; ThreadItem: TThreadItem; var sTitle: string); |
| 81 |
//レスポップアップの作成 |
//レスポップアップの作成 |
| 82 |
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 |
//リンクの文字列からレスポップアップ用のURLに変換する |
//リンクの文字列からレスポップアップ用のURLに変換する |
| 84 |
class function GetRespopupURL(AText, AThreadURL : string): string; |
class function GetRespopupURL(AText, AThreadURL : string): string; |
| 85 |
//指定したパスにスキンもしくはCSSのファイルのコピーを作る |
//指定したパスにスキンもしくはCSSのファイルのコピーを作る |
| 885 |
procedure THTMLCreate.CreateDefaultHTML (html:TBufferedWebBrowser; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string ); |
procedure THTMLCreate.CreateDefaultHTML (html:TBufferedWebBrowser; ThreadItem: TThreadItem; ReadList: TStringList; sTitle: string ); |
| 886 |
var |
var |
| 887 |
i: integer; |
i: integer; |
|
No: string; |
|
| 888 |
NewReceiveNo: Integer; |
NewReceiveNo: Integer; |
|
Res: TResRec; |
|
| 889 |
ThreadName: String; |
ThreadName: String; |
| 890 |
ResLink : TResLinkRec; |
ResLink : TResLinkRec; |
| 891 |
begin |
begin |
| 919 |
end; |
end; |
| 920 |
|
|
| 921 |
if (Trim(ReadList[i]) <> '') then begin |
if (Trim(ReadList[i]) <> '') then begin |
| 922 |
No := IntToStr(i + 1); |
html.Add(GetResString(i, ReadList[i], @ResLink)); |
|
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> 名前:<font color="forestgreen"><b> ' + Res.FName + ' </b></font> 投稿日: <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> 名前:<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> [' + Res.FMailTo + '] 投稿日: <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> 名前:<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> 投稿日: <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>'#13#10); |
|
| 923 |
end; |
end; |
| 924 |
if ThreadItem.Kokomade = (i + 1) then begin |
if ThreadItem.Kokomade = (i + 1) then begin |
| 925 |
html.Add('</dl>'); |
html.Add('</dl>'); |
| 930 |
html.Add(getKeywordLink(ThreadItem)); |
html.Add(getKeywordLink(ThreadItem)); |
| 931 |
html.Add('</dl>'#13#10'<a name="bottom"></a>'#13#10'</body></html>'); |
html.Add('</dl>'#13#10'<a name="bottom"></a>'#13#10'</body></html>'); |
| 932 |
end; |
end; |
| 933 |
|
function THTMLCreate.GetResString(index: Integer; const Line: String; PResLink : PResLinkRec): String; |
| 934 |
|
var |
| 935 |
|
No : String; |
| 936 |
|
Res: TResRec; |
| 937 |
|
begin |
| 938 |
|
No := IntToStr(index + 1); |
| 939 |
|
DivideStrLine(Line, @Res); |
| 940 |
|
AddAnchorTag(@Res); |
| 941 |
|
ConvRes(@Res, PResLink); |
| 942 |
|
Res.FDateTime := AddBeProfileLink(Res.FDateTime, index + 1); |
| 943 |
|
if Res.FMailTo = '' then |
| 944 |
|
Result := '<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> 名前:<font color="forestgreen"><b> ' + Res.FName + ' </b></font> 投稿日: <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>'#13#10 |
| 945 |
|
else if GikoSys.Setting.ShowMail then |
| 946 |
|
Result := '<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> 名前:<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> [' + Res.FMailTo + '] 投稿日: <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>'#13#10 |
| 947 |
|
else |
| 948 |
|
Result := '<a name="' + No + '"></a><dt><a href="menu:' + No + '">' + No + '</a> 名前:<a href="mailto:' + Res.FMailTo + '"><b> ' + Res.FName + ' </B></a> 投稿日: <span class="date">' + Res.FDateTime+ '</span><br><dd>' + Res.Fbody + ' <br><br><br>'#13#10; |
| 949 |
|
end; |
| 950 |
procedure THTMLCreate.CreateHTML2(Browser: TWebBrowser; ThreadItem: TThreadItem; var sTitle: string); |
procedure THTMLCreate.CreateHTML2(Browser: TWebBrowser; ThreadItem: TThreadItem; var sTitle: string); |
| 951 |
var |
var |
| 952 |
ReadList: TStringList; |
ReadList: TStringList; |
| 1254 |
end; |
end; |
| 1255 |
end; |
end; |
| 1256 |
|
|
| 1257 |
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); |
| 1258 |
var |
var |
| 1259 |
i: Integer; |
i: Integer; |
| 1260 |
tmp: string; |
tmp: string; |
| 1263 |
|
|
| 1264 |
wkInt: Integer; |
wkInt: Integer; |
| 1265 |
|
|
|
Res: TResRec; |
|
|
Header: string; |
|
|
Body: string; |
|
| 1266 |
boardPlugIn : TBoardPlugIn; |
boardPlugIn : TBoardPlugIn; |
| 1267 |
|
Html: TStringList; |
| 1268 |
|
ResLink : TResLinkRec; |
| 1269 |
begin |
begin |
| 1270 |
|
|
| 1271 |
|
Html := TStringList.Create; |
| 1272 |
try |
try |
| 1273 |
if StNum > ToNum then begin |
if StNum > ToNum then begin |
| 1274 |
wkInt := StNum; |
wkInt := StNum; |
| 1286 |
Hint.Title := ThreadItem.Title; |
Hint.Title := ThreadItem.Title; |
| 1287 |
|
|
| 1288 |
if ThreadItem <> nil then begin |
if ThreadItem <> nil then begin |
| 1289 |
|
ResLink.FBbs := ThreadItem.ParentBoard.BBSID; |
| 1290 |
|
ResLink.FKey := ChangeFileExt(ThreadItem.FileName, ''); |
| 1291 |
//if ThreadItem.IsBoardPlugInAvailable then begin |
//if ThreadItem.IsBoardPlugInAvailable then begin |
| 1292 |
if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin |
if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin |
| 1293 |
//===== プラグインによる表示 |
//===== プラグインによる表示 |
| 1301 |
//ここで2ちゃんねるのdatの形式で1行読み込めれば・・・。↓読めるようになった |
//ここで2ちゃんねるのdatの形式で1行読み込めれば・・・。↓読めるようになった |
| 1302 |
tmp := boardPlugIn.GetDat( DWORD( threadItem ), i ); |
tmp := boardPlugIn.GetDat( DWORD( threadItem ), i ); |
| 1303 |
if (tmp <> '') And ( not GikoSys.FAbon.CheckAbonPopupRes(tmp) And( not GikoSys.FAbon.CheckIndividualAbonList(line))) then begin |
if (tmp <> '') And ( not GikoSys.FAbon.CheckAbonPopupRes(tmp) And( not GikoSys.FAbon.CheckIndividualAbonList(line))) then begin |
| 1304 |
DivideStrLine(tmp, @Res); |
Html.Add(GetResString(Line-1, tmp, @ResLink)); |
|
if (GikoSys.Setting.ShowMail = false) or (Length(res.FMailTo) = 0) then |
|
|
Header := IntToStr(Line) + ' 名前: ' + Res.FName + ' 投稿日: ' + Res.FDateTime |
|
|
else |
|
|
Header := IntToStr(Line) + ' 名前: ' + Res.FName + ' [' + res.FMailTo + '] 投稿日: ' + 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); |
|
| 1305 |
end; |
end; |
| 1306 |
end; |
end; |
| 1307 |
end else begin |
end else begin |
| 1310 |
FileName := ThreadItem.FilePath; |
FileName := ThreadItem.FilePath; |
| 1311 |
tmp := GikoSys.ReadThreadFile(FileName, Line); |
tmp := GikoSys.ReadThreadFile(FileName, Line); |
| 1312 |
if (tmp <> '') And ( not GikoSys.FAbon.CheckAbonPopupRes(tmp) And( not GikoSys.FAbon.CheckIndividualAbonList(line))) then begin |
if (tmp <> '') And ( not GikoSys.FAbon.CheckAbonPopupRes(tmp) And( not GikoSys.FAbon.CheckIndividualAbonList(line))) then begin |
| 1313 |
DivideStrLine(tmp, @Res); |
Html.Add(GetResString(Line-1, tmp, @ResLink)); |
|
if (GikoSys.Setting.ShowMail = false) or (Length(res.FMailTo) = 0) then |
|
|
Header := IntToStr(Line) + ' 名前: ' + Res.FName + ' 投稿日: ' + Res.FDateTime |
|
|
else |
|
|
Header := IntToStr(Line) + ' 名前: ' + Res.FName + ' [' + res.FMailTo + '] 投稿日: ' + 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); |
|
| 1314 |
end; |
end; |
| 1315 |
end; |
end; |
| 1316 |
end; |
end; |
| 1317 |
|
if (Html.Count > 0) then begin |
| 1318 |
|
Hint.Write('<DL>' + Html.Text + '</DL>'); |
| 1319 |
|
end; |
| 1320 |
end; |
end; |
| 1321 |
finally |
finally |
| 1322 |
|
Html.Free; |
| 1323 |
end; |
end; |
| 1324 |
end; |
end; |
| 1325 |
|
|