| 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; |
{Sort,} ,GikoBayesian, HintWindow; |
| 19 |
|
|
| 20 |
type |
type |
| 21 |
THTMLCreate = class(TObject) |
THTMLCreate = class(TObject) |
| 46 |
// function ConvRes(const Body, Bbs, Key, ParamBBS, ParamKey, ParamStart, ParamTo, ParamNoFirst, ParamTrue, FullURL : string): string; overload; |
// function ConvRes(const Body, Bbs, Key, ParamBBS, ParamKey, ParamStart, ParamTo, ParamNoFirst, ParamTrue, FullURL : string): string; overload; |
| 47 |
procedure CreateHTML2(doc: Variant; ThreadItem: TThreadItem; var sTitle: string); |
procedure CreateHTML2(doc: Variant; ThreadItem: TThreadItem; var sTitle: string); |
| 48 |
procedure CreateHTML3(var html: TStringList; ThreadItem: TThreadItem; var sTitle: string); |
procedure CreateHTML3(var html: TStringList; ThreadItem: TThreadItem; var sTitle: string); |
| 49 |
|
//レスポップアップの作成 |
| 50 |
|
procedure SetResPopupText(Hint :TResPopup; threadItem: TThreadItem; StNum, ToNum: Integer; Title, First: Boolean); |
| 51 |
|
//リンクの文字列からレスポップアップ用のURLに変換する |
| 52 |
|
class function GetRespopupURL(AText, AThreadURL : string): string; |
| 53 |
|
//指定したパスにスキンもしくはCSSのファイルのコピーを作る |
| 54 |
|
class procedure SkinorCSSFilesCopy(path: string); |
| 55 |
end; |
end; |
| 56 |
|
|
| 57 |
var |
var |
| 1224 |
end; |
end; |
| 1225 |
end; |
end; |
| 1226 |
|
|
| 1227 |
|
procedure THTMLCreate.SetResPopupText(Hint : TResPopup; threadItem: TThreadItem; StNum, ToNum: Integer; Title, First: Boolean); |
| 1228 |
|
var |
| 1229 |
|
i: Integer; |
| 1230 |
|
tmp: string; |
| 1231 |
|
FileName: string; |
| 1232 |
|
Line: Integer; |
| 1233 |
|
|
| 1234 |
|
wkInt: Integer; |
| 1235 |
|
|
| 1236 |
|
Res: TResRec; |
| 1237 |
|
Header: string; |
| 1238 |
|
Body: string; |
| 1239 |
|
boardPlugIn : TBoardPlugIn; |
| 1240 |
|
begin |
| 1241 |
|
try |
| 1242 |
|
if StNum > ToNum then begin |
| 1243 |
|
wkInt := StNum; |
| 1244 |
|
StNum := ToNum; |
| 1245 |
|
ToNum := wkInt; |
| 1246 |
|
end; |
| 1247 |
|
|
| 1248 |
|
//最大10レスまで表示 |
| 1249 |
|
if StNum + MAX_POPUP_RES < ToNum then |
| 1250 |
|
ToNum := StNum + MAX_POPUP_RES; |
| 1251 |
|
|
| 1252 |
|
//タイトル表示 |
| 1253 |
|
if Title then |
| 1254 |
|
if ThreadItem <> nil then |
| 1255 |
|
Hint.Title := ThreadItem.Title; |
| 1256 |
|
|
| 1257 |
|
if ThreadItem <> nil then begin |
| 1258 |
|
//if ThreadItem.IsBoardPlugInAvailable then begin |
| 1259 |
|
if ThreadItem.ParentBoard.IsBoardPlugInAvailable then begin |
| 1260 |
|
//===== プラグインによる表示 |
| 1261 |
|
//boardPlugIn := ThreadItem.BoardPlugIn; |
| 1262 |
|
boardPlugIn := ThreadItem.ParentBoard.BoardPlugIn; |
| 1263 |
|
|
| 1264 |
|
// フォントやサイズの設定 |
| 1265 |
|
// 文字コードはプラグインに任せる |
| 1266 |
|
for i := StNum to ToNum do begin |
| 1267 |
|
Line := i; |
| 1268 |
|
//ここで2ちゃんねるのdatの形式で1行読み込めれば・・・。↓読めるようになった |
| 1269 |
|
tmp := boardPlugIn.GetDat( DWORD( threadItem ), i ); |
| 1270 |
|
if (tmp <> '') And ( not GikoSys.FAbon.CheckAbonPopupRes(tmp) And( not GikoSys.FAbon.CheckIndividualAbonList(line))) then begin |
| 1271 |
|
Res := DivideStrLine(tmp); |
| 1272 |
|
if (GikoSys.Setting.ShowMail = false) or (Length(res.FMailTo) = 0) then |
| 1273 |
|
Header := IntToStr(Line) + ' 名前: ' + Res.FName + ' 投稿日: ' + Res.FDateTime |
| 1274 |
|
else |
| 1275 |
|
Header := IntToStr(Line) + ' 名前: ' + Res.FName + ' [' + res.FMailTo + '] 投稿日: ' + Res.FDateTime; |
| 1276 |
|
Header := DeleteFontTag(Header); |
| 1277 |
|
Header := CustomStringReplace(Header, '<br>', '',true); |
| 1278 |
|
|
| 1279 |
|
Body := CustomStringReplace(Res.FBody, '<br> ', #10,true); |
| 1280 |
|
Body := CustomStringReplace(Body, '<br>', #10,true); |
| 1281 |
|
Body := CustomStringReplace(Body, '</a>', '',true); |
| 1282 |
|
Body := GikoSys.DeleteLink(Body); |
| 1283 |
|
Body := CustomStringReplace(Body, '<', '<'); |
| 1284 |
|
Body := CustomStringReplace(Body, '>', '>'); |
| 1285 |
|
Body := CustomStringReplace(Body, '"', '"'); |
| 1286 |
|
Body := CustomStringReplace(Body, '&', '&'); |
| 1287 |
|
Body := CustomStringReplace(Body, ' ', ' '); |
| 1288 |
|
|
| 1289 |
|
Hint.Add(Header, Body); |
| 1290 |
|
end; |
| 1291 |
|
end; |
| 1292 |
|
end else begin |
| 1293 |
|
for i := StNum to ToNum do begin |
| 1294 |
|
Line := i; |
| 1295 |
|
FileName := ThreadItem.FilePath; |
| 1296 |
|
tmp := GikoSys.ReadThreadFile(FileName, Line); |
| 1297 |
|
if (tmp <> '') And ( not GikoSys.FAbon.CheckAbonPopupRes(tmp) And( not GikoSys.FAbon.CheckIndividualAbonList(line))) then begin |
| 1298 |
|
Res := DivideStrLine(tmp); |
| 1299 |
|
if (GikoSys.Setting.ShowMail = false) or (Length(res.FMailTo) = 0) then |
| 1300 |
|
Header := IntToStr(Line) + ' 名前: ' + Res.FName + ' 投稿日: ' + Res.FDateTime |
| 1301 |
|
else |
| 1302 |
|
Header := IntToStr(Line) + ' 名前: ' + Res.FName + ' [' + res.FMailTo + '] 投稿日: ' + Res.FDateTime; |
| 1303 |
|
|
| 1304 |
|
Body := DeleteFontTag(Res.FBody); |
| 1305 |
|
Body := CustomStringReplace(Body, '<br> ', #10,true); |
| 1306 |
|
Body := CustomStringReplace(Body, '<br>', #10,true); |
| 1307 |
|
Body := CustomStringReplace(Body, '</a>', '',true); |
| 1308 |
|
Body := GikoSys.DeleteLink(Body); |
| 1309 |
|
Body := CustomStringReplace(Body, '<', '<'); |
| 1310 |
|
Body := CustomStringReplace(Body, '>', '>'); |
| 1311 |
|
Body := CustomStringReplace(Body, '"', '"'); |
| 1312 |
|
Body := CustomStringReplace(Body, '&', '&'); |
| 1313 |
|
Body := CustomStringReplace(Body, ' ', ' '); |
| 1314 |
|
Hint.Add(Header, Body); |
| 1315 |
|
end; |
| 1316 |
|
end; |
| 1317 |
|
end; |
| 1318 |
|
end; |
| 1319 |
|
finally |
| 1320 |
|
end; |
| 1321 |
|
end; |
| 1322 |
|
|
| 1323 |
|
//リンクの文字列からレスポップアップ用のURLに変換する |
| 1324 |
|
class function THTMLCreate.GetRespopupURL(AText, AThreadURL : string): string; |
| 1325 |
|
var |
| 1326 |
|
wkInt: Integer; |
| 1327 |
|
begin |
| 1328 |
|
Result := ''; |
| 1329 |
|
if Pos('about:blank..', AText) = 1 then begin |
| 1330 |
|
wkInt := LastDelimiter( '/', AThreadURL ); |
| 1331 |
|
if Pos( '?', Copy( AThreadURL, wkInt, MaxInt ) ) = 0 then begin |
| 1332 |
|
// Thread.URL は PATH_INFO 渡し |
| 1333 |
|
Result := Copy( AThreadURL, 1, LastDelimiter( '/', AThreadURL ) ); |
| 1334 |
|
wkInt := LastDelimiter( '/', AText ); |
| 1335 |
|
if Pos( '?', Copy( AText, wkInt, MaxInt ) ) = 0 then |
| 1336 |
|
// Text も PATH_INFO 渡し |
| 1337 |
|
Result := Result + Copy( AText, LastDelimiter( '/', AText ) + 1, MaxInt ) |
| 1338 |
|
else |
| 1339 |
|
// Text は QUERY_STRING 渡し |
| 1340 |
|
Result := Result + Copy( AText, LastDelimiter( '?', AText ) + 1, MaxInt ); |
| 1341 |
|
end else begin |
| 1342 |
|
// Thread.URL は QUERY_STRING 渡し |
| 1343 |
|
Result := Copy( AThreadURL, 1, LastDelimiter( '?', AThreadURL ) ); |
| 1344 |
|
wkInt := LastDelimiter( '/', AText ); |
| 1345 |
|
if Pos( '?', Copy( AText, wkInt, MaxInt ) ) = 0 then begin |
| 1346 |
|
// Text は PATH_INFO 渡し |
| 1347 |
|
// URL に板とキーが足らないので Text から頂戴する |
| 1348 |
|
wkInt := LastDelimiter( '/', Copy( AText, 1, wkInt - 1 ) ); |
| 1349 |
|
wkInt := LastDelimiter( '/', Copy( AText, 1, wkInt - 1 ) ); |
| 1350 |
|
Result := Copy( Result, 1, Length( Result ) - 1 ) + Copy( AText, wkInt, MaxInt ); |
| 1351 |
|
end else begin |
| 1352 |
|
// Text も QUERY_STRING 渡し |
| 1353 |
|
Result := Result + Copy( AText, LastDelimiter( '?', AText ) + 1, MaxInt ) |
| 1354 |
|
end; |
| 1355 |
|
end; |
| 1356 |
|
end else if Pos('about:blank/bbs/', AText) = 1 then begin |
| 1357 |
|
//したらばJBBSの仕変の吸収 |
| 1358 |
|
AText := CustomStringReplace(AText, 'about:blank/bbs/', 'about:blank../../bbs/'); |
| 1359 |
|
Result := GetRespopupURL(AText, AThreadURL); |
| 1360 |
|
end else begin |
| 1361 |
|
Result := AText; |
| 1362 |
|
end; |
| 1363 |
|
|
| 1364 |
|
end; |
| 1365 |
|
//指定したパスにスキンもしくはCSSのファイルのコピーを作る |
| 1366 |
|
class procedure THTMLCreate.SkinorCSSFilesCopy(path: string); |
| 1367 |
|
var |
| 1368 |
|
tmp, tmpD, tmpF: string; |
| 1369 |
|
current: string; |
| 1370 |
|
dirs: TStringList; |
| 1371 |
|
files: TStringList; |
| 1372 |
|
i, j: Integer; |
| 1373 |
|
begin |
| 1374 |
|
if GikoSys.Setting.UseSkin then begin |
| 1375 |
|
current := ExtractFilePath(GikoSys.GetSkinDir); |
| 1376 |
|
tmp := GikoSys.Setting.CSSFileName; |
| 1377 |
|
end else if GikoSys.Setting.UseCSS then begin |
| 1378 |
|
current := ExtractFilePath(GikoSys.GetStyleSheetDir); |
| 1379 |
|
tmp := ExtractFilePath(GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName); |
| 1380 |
|
end; |
| 1381 |
|
dirs := TStringList.Create; |
| 1382 |
|
try |
| 1383 |
|
dirs.Add(tmp); |
| 1384 |
|
if tmp <> current then begin |
| 1385 |
|
GikoSys.GetDirectoryList(current, '*.*', dirs, true); |
| 1386 |
|
for i := 0 to dirs.Count - 1 do begin |
| 1387 |
|
files := TStringList.Create; |
| 1388 |
|
try |
| 1389 |
|
files.BeginUpdate; |
| 1390 |
|
gikoSys.GetFileList(dirs[i], '*.*', files, true); |
| 1391 |
|
files.EndUpdate; |
| 1392 |
|
tmpD := CustomStringReplace(dirs[i], GikoSys.GetConfigDir, path); |
| 1393 |
|
if (AnsiPos(dirs[i], tmp) <> 0) and not (DirectoryExists(tmpD)) then |
| 1394 |
|
ForceDirectories(tmpD); |
| 1395 |
|
|
| 1396 |
|
if(dirs[i] = tmp) and (dirs[i] <> current) then begin |
| 1397 |
|
for j := 0 to files.Count - 1 do begin |
| 1398 |
|
tmpF := CustomStringReplace(files[j], GikoSys.GetConfigDir, path); |
| 1399 |
|
if not FileExists(tmpF) then begin |
| 1400 |
|
CopyFile(PChar(files[j]), PChar(tmpF),True); |
| 1401 |
|
end; |
| 1402 |
|
end; |
| 1403 |
|
end; |
| 1404 |
|
finally |
| 1405 |
|
files.Free; |
| 1406 |
|
end; |
| 1407 |
|
end; |
| 1408 |
|
end else begin |
| 1409 |
|
tmpD := CustomStringReplace(dirs[0], GikoSys.GetConfigDir, path); |
| 1410 |
|
if not DirectoryExists(tmpD) then |
| 1411 |
|
ForceDirectories(tmpD); |
| 1412 |
|
tmpF := CustomStringReplace(GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName |
| 1413 |
|
, GikoSys.GetConfigDir, path); |
| 1414 |
|
if not FileExists(tmpF) then begin |
| 1415 |
|
CopyFile(PChar(GikoSys.GetStyleSheetDir + GikoSys.Setting.CSSFileName) |
| 1416 |
|
, PChar(tmpF), True); |
| 1417 |
|
end; |
| 1418 |
|
end; |
| 1419 |
|
finally |
| 1420 |
|
dirs.Free; |
| 1421 |
|
end; |
| 1422 |
|
end; |
| 1423 |
|
|
| 1424 |
|
|
| 1425 |
|
|
| 1426 |
initialization |
initialization |
| 1427 |
HTMLCreater := THTMLCreate.Create; |
HTMLCreater := THTMLCreate.Create; |
| 1428 |
|
|