Develop and Download Open Source Software

Browse CVS Repository

Diff of /gikonavigoeson/gikonavi/HTMLCreate.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.7 by h677, Sun Nov 13 14:26:19 2005 UTC revision 1.8 by h677, Mon Nov 14 16:19:19 2005 UTC
# Line 15  uses Line 15  uses
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)
# Line 46  type Line 46  type
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
# Line 1218  begin Line 1224  begin
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, '&lt;', '<');
1284                            Body := CustomStringReplace(Body, '&gt;', '>');
1285                            Body := CustomStringReplace(Body, '&quot;', '"');
1286                            Body := CustomStringReplace(Body, '&amp;', '&');
1287                            Body := CustomStringReplace(Body, '&nbsp;', ' ');
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, '&lt;', '<');
1310                                                    Body := CustomStringReplace(Body, '&gt;', '>');
1311                                                    Body := CustomStringReplace(Body, '&quot;', '"');
1312                                                    Body := CustomStringReplace(Body, '&amp;', '&');
1313                                                     Body := CustomStringReplace(Body, '&nbsp;', ' ');
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    

Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26