Develop and Download Open Source Software

Browse CVS Repository

Diff of /gikonavigoeson/gikonavi/AbonUnit.pas

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

revision 1.17 by h677, Wed Oct 8 13:21:25 2003 UTC revision 1.17.2.1 by yoffy, Mon Apr 19 22:46:48 2004 UTC
# Line 30  type Line 30  type
30      FIndividualFileName : String;       //個別あぼ〜んのファイル名      FIndividualFileName : String;       //個別あぼ〜んのファイル名
31      FReturnNGwordLineNum : Boolean;     //NGワードの行数を返す。      FReturnNGwordLineNum : Boolean;     //NGワードの行数を返す。
32      FSetNGResAnchor : Boolean; //NGに該当したときに本文にそのレスへのレスアンカーをつけるかどうか      FSetNGResAnchor : Boolean; //NGに該当したときに本文にそのレスへのレスアンカーをつけるかどうか
33        FDeleteSyria: Boolean;      //シリア語ブラクラ対策(&#1792~&#1871)
34      procedure SetTokens(index: integer ; argline:String);      procedure SetTokens(index: integer ; argline:String);
35      function Getlistpath() : String;      function Getlistpath() : String;
36      procedure Setlistpath(const Value : String);      procedure Setlistpath(const Value : String);
# Line 51  type Line 52  type
52      property NGwordname : String read FNGwordname write FNGwordname;      property NGwordname : String read FNGwordname write FNGwordname;
53          property ReturnNGwordLineNum : Boolean read FReturnNGwordLineNum write FReturnNGwordLineNum default false;          property ReturnNGwordLineNum : Boolean read FReturnNGwordLineNum write FReturnNGwordLineNum default false;
54      property SetNGResAnchor : Boolean read FSetNGResAnchor write FSetNGResAnchor default false;      property SetNGResAnchor : Boolean read FSetNGResAnchor write FSetNGResAnchor default false;
55        property DeleteSyria : Boolean read FDeleteSyria write FDeleteSyria default false;
56      procedure Setroot(root :String);      procedure Setroot(root :String);
57      function Getroot() : String;      function Getroot() : String;
58    
# Line 63  type Line 65  type
65      function CheckAbonPopupRes(line : String) :Boolean;      function CheckAbonPopupRes(line : String) :Boolean;
66      function FindNGwords(line : String) : Boolean; overload;//1ラインずつ用。      function FindNGwords(line : String) : Boolean; overload;//1ラインずつ用。
67      function FindNGwords(line : String; var NGwordsLineNum : Integer) : Boolean; overload;//1ラインずつ用。      function FindNGwords(line : String; var NGwordsLineNum : Integer) : Boolean; overload;//1ラインずつ用。
68        function FindNGwords(line : String; var NGwordsLineNum : Integer; var Invisible : Boolean) : Boolean; overload;//1ラインずつ用。
69      function Cutoff(line : String) : Boolean; //CutOff値以上個の同じ英数が並んでいたらtrue      function Cutoff(line : String) : Boolean; //CutOff値以上個の同じ英数が並んでいたらtrue
70      //あぼ〜ん処理(NGワードでのフィルタリング)      //あぼ〜ん処理(NGワードでのフィルタリング)
71      procedure Execute(var ThreadStrings : TStringList); overload;      procedure Execute(var ThreadStrings : TStringList); overload;
72      procedure Execute(var ThreadStrings : TStringList; NGwords : TStringList); overload;      procedure Execute(var ThreadStrings : TStringList; NGwords : TStringList); overload;
73      procedure Execute(var ThreadStrings : TStringList; NGwords : TStrings); overload;      procedure Execute(var ThreadStrings : TStringList; NGwords : TStrings); overload;
74        procedure Execute(var ResString : String; ResNumber : Integer); overload;   //主にpluginからのDat To HTML 用
75      //個別あぼ〜んしょり      //個別あぼ〜んしょり
76      procedure IndividualAbon(var ThreadStrings : TStringList; SetResNumFile : String);      procedure IndividualAbon(var ThreadStrings : TStringList; SetResNumFile : String); overload;
77            procedure IndividualAbon(var ResString : String; SetResNumFile : String; ResNumber : Integer); overload;
78      procedure AddIndividualAbon( ResNum : Integer ; option : Integer);      procedure AddIndividualAbon( ResNum : Integer ; option : Integer);
79      procedure DeleteIndividualAbon( ResNum : Integer);      procedure DeleteIndividualAbon( ResNum : Integer);
80      function GetAbonResCount() : Integer;      function GetAbonResCount() : Integer;
# Line 89  type Line 94  type
94      procedure GoHome();//Listの1行目を読む      procedure GoHome();//Listの1行目を読む
95      function GoForward() : Boolean; //Listの一つ次のNGワードファイルを読み込む      function GoForward() : Boolean; //Listの一つ次のNGワードファイルを読み込む
96      function GoBack() : Boolean; //Listの一つ前のNGワードファイルを読み込む      function GoBack() : Boolean; //Listの一つ前のNGワードファイルを読み込む
97        //--
98        function TreatSyria(AString: string): string;
99    end;    end;
100  var  var
101      Abon1 :TAbon;      Abon1 :TAbon;
# Line 97  const Line 104  const
104    
105  implementation  implementation
106    
107    uses MojuUtils;
108    
109  constructor TAbon.Create;  constructor TAbon.Create;
110  begin  begin
111      // 初期化      // 初期化
# Line 247  begin Line 256  begin
256                  Delete(argline,1,pos);                  Delete(argline,1,pos);
257                  if Length(buftoken) > 0 then begin                  if Length(buftoken) > 0 then begin
258                                  bufstl.Append(buftoken);                                  bufstl.Append(buftoken);
259                    end else if ( bufstl.Count = 0 ) then begin
260                        bufstl.Append('');
261                  end;                  end;
262                      pos := AnsiPos(#9,argline);                      pos := AnsiPos(#9,argline);
263              end;              end;
# Line 340  begin Line 351  begin
351      end;      end;
352      Result := hit;      Result := hit;
353  end;  end;
354    //NGワードが含まれていたらtrueを返し、そのNGワードの行数をNGwordsLineNumに入れて返す。
355    //もしも透明あぼ〜んにするならInbisibleをtrueにして返す
356    function TAbon.FindNGwords(line : String; var NGwordsLineNum : Integer; var Invisible : Boolean) : Boolean; //1ラインずつ用。
357    var
358        lines : Integer;
359        cells : Integer;
360        hit : Boolean;
361        bufline : String;
362        start : Integer;
363    begin
364        hit := false;
365        if AnsiPos(FAbonString,line) <> 1 then begin
366            for lines := 0 to High(Ftokens) do begin
367                    hit := true;
368                bufline := line;
369                if Ftokens[lines][0] <> ''  then begin
370                    Invisible := false;
371                    start := 0;
372                end else begin
373                    Invisible := true;
374                    start := 1;
375                end;
376    
377                for cells := start to High(Ftokens[lines]) do begin
378                    if AnsiPos(Ftokens[lines][cells],bufline) = 0 then begin
379                        hit := false;
380                        break;
381                    end else begin
382                        Delete(bufline,AnsiPos(Ftokens[lines][cells],bufline),Length(Ftokens[lines][cells]));
383                    end;
384                end;
385                if hit = true then begin
386                    NGwordsLineNum := lines + 1;
387                    break;
388                end;
389            end;
390        end;
391        Result := hit;
392    end;
393    
394  //CutOff値以上個の同じ英数が並んでいたらtrue  //CutOff値以上個の同じ英数が並んでいたらtrue
395  function TAbon.Cutoff(line : String) : Boolean;  function TAbon.Cutoff(line : String) : Boolean;
396  var  var
# Line 367  var Line 418  var
418      i : Integer;      i : Integer;
419      NGwordsLine : Integer;      NGwordsLine : Integer;
420      bufline : String;      bufline : String;
421        invisi : Boolean;
422  begin  begin
423      //FRetStrings.Clear;      for i:=0 to ThreadStrings.Count - 1 do begin
424      if not ReturnNGwordLineNum then begin          NGwordsLine := 0;
425      //if ReturnNGwordLineNum then begin          if FindNGwords(ThreadStrings.Strings[i], NGwordsLine ,invisi) <> Reverse  then begin
426          for i:=0 to ThreadStrings.Count - 1 do begin              if invisi = true then begin
427                  if FindNGwords(ThreadStrings.Strings[i]) <> Reverse  then begin                  ThreadStrings.Strings[i] := '';
428                  if not SetNGResAnchor then              end else begin
429                          ThreadStrings.Strings[i] := FAbonString                  if not ReturnNGwordLineNum and not SetNGResAnchor then begin
430                  else                      ThreadStrings.Strings[i] := FAbonString;
431                          ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<>&gt;%d<><>',[(i+1)]);                  end else if not ReturnNGwordLineNum then begin
432                  end else begin                      ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<>&gt;%d<><>',[(i+1)]);
433                  bufline := ThreadStrings.Strings[i];                  end else if not SetNGResAnchor then begin
434                  if Deleterlo = true then begin                      ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 行目のNGワードが含まれています。</B><><>',[NGwordsLine]);
435                          bufline := AnsiReplaceText( bufline,'&rlo;','' );                  end else begin
436                      bufline := AnsiReplaceText( bufline,'&lro;','' );                      ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 行目のNGワードが含まれています。</B>&gt;%d <><>',[NGwordsLine,(i+1)]);
437                  end;                  end;
438                  if Replaceul = true then begin              end;
439                          bufline := AnsiReplaceText( bufline,'<ul>','<br>' );          end else begin
440                          bufline := AnsiReplaceText( bufline,'</ul>','<br>' );              bufline := ThreadStrings.Strings[i];
441                  end;              if Deleterlo = true then begin
442                  ThreadStrings.Strings[i] := bufline;                  bufline := CustomStringReplace(bufline,'&rlo;','');
443                  end;                  bufline := CustomStringReplace(bufline,'&lro;','');
444          end;              end;
445                if Replaceul = true then begin
446                    bufline := CustomStringReplace( bufline,'<ul>','<br>' );
447                    bufline := CustomStringReplace( bufline,'</ul>','<br>' );
448                end;
449                    if DeleteSyria = true then
450                    bufline := TreatSyria(bufline);
451                ThreadStrings.Strings[i] := bufline;
452            end;
453        end;
454    end;
455    procedure TAbon.Execute(var ResString : String; ResNumber : Integer);
456    var
457        NGwordsLine : Integer;
458        bufline : String;
459        invisi : Boolean;
460    begin
461        NGwordsLine := 0;
462        if FindNGwords(ResString, NGwordsLine ,invisi) <> Reverse  then begin
463            if invisi = true then begin
464                ResString := '';
465            end else begin
466                if not ReturnNGwordLineNum and not SetNGResAnchor then begin
467                    ResString := FAbonString;
468                end else if not ReturnNGwordLineNum then begin
469                    ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<>&gt;%d<><>',[(ResNumber)]);
470                end else if not SetNGResAnchor then begin
471                    ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 行目のNGワードが含まれています。</B><><>',[NGwordsLine]);
472                end else begin
473                    ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 行目のNGワードが含まれています。</B>&gt;%d <><>',[NGwordsLine,(ResNumber)]);
474                end;
475            end;
476      end else begin      end else begin
477          for i:=0 to ThreadStrings.Count - 1 do begin          bufline := ResString;
478              NGwordsLine := 0;          if Deleterlo = true then begin
479                  if FindNGwords(ThreadStrings.Strings[i], NGwordsLine) <> Reverse  then begin              bufline := CustomStringReplace( bufline,'&rlo;','' );
480                  if not SetNGResAnchor then              bufline := CustomStringReplace( bufline,'&lro;','' );
481                      ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 行目のNGワードが含まれています。</B><><>',[NGwordsLine])          end;
482                  else          if Replaceul = true then begin
483                          ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 行目のNGワードが含まれています。</B>&gt;%d <><>',[NGwordsLine,(i+1)]);              bufline := CustomStringReplace( bufline,'<ul>','<br>' );
484                  end else begin              bufline := CustomStringReplace( bufline,'</ul>','<br>' );
485                  bufline := ThreadStrings.Strings[i];          end;
486                  if Deleterlo = true then begin          if DeleteSyria = true then
487                          bufline := AnsiReplaceText( bufline,'&rlo;','' );                  bufline := TreatSyria(bufline);
488                      bufline := AnsiReplaceText( bufline,'&lro;','' );          ResString := bufline;
                 end;  
                 if Replaceul = true then begin  
                         bufline := AnsiReplaceText( bufline,'<ul>','<br>' );  
                         bufline := AnsiReplaceText( bufline,'</ul>','<br>' );  
                 end;  
                 ThreadStrings.Strings[i] := bufline;  
                 end;  
         end;  
   
489      end;      end;
   
490  end;  end;
491    
492  procedure TAbon.Execute(var ThreadStrings : TStringList; NGwords : TStringList);  procedure TAbon.Execute(var ThreadStrings : TStringList; NGwords : TStringList);
493  var  var
494      i : Integer;      i : Integer;
# Line 733  begin Line 807  begin
807          FAbonRes[0].option := -1;          FAbonRes[0].option := -1;
808      end;      end;
809  end;  end;
810    procedure TAbon.IndividualAbon(var ResString : String; SetResNumFile : String; ResNumber : Integer);
811    var
812            i : Integer;
813    begin
814            if FileExists(SetResNumFile) = true then begin
815            if LoadFromSetResNumFile(SetResNumFile) = true then begin
816                    for i := 0 to High(FAbonRes) do begin
817                     if FAbonRes[i].Res = ResNumber then begin
818                            if FAbonRes[i].option = 0 then begin
819                            ResString := '';
820                        end else begin
821                            ResString := 'あぼ〜ん<>あぼ〜ん<>あぼ〜ん<>あぼ〜ん<>';
822                        end;
823                        Exit;
824                     end;
825                end;
826            end;
827        end else begin
828            FIndividualFileName := SetResNumFile;
829            SetLength(FAbonRes,1);
830            FAbonRes[0].Res := 0;
831            FAbonRes[0].option := -1;
832        end;
833    end;
834    
835  //個別あぼ〜んファイル読み込み関数  //個別あぼ〜んファイル読み込み関数
836  function TAbon.LoadFromSetResNumFile(SetResNumFile : String) : Boolean;  function TAbon.LoadFromSetResNumFile(SetResNumFile : String) : Boolean;
837  var  var
# Line 856  begin Line 955  begin
955          end;          end;
956      end;      end;
957      Result := false;      Result := false;
958        
959    end;
960    //シリア語ブラクラ対策
961    function TAbon.TreatSyria(AString: string): string;
962    var
963            //count: Integer; //(&#1792~&#1871)
964        pos: Integer;
965        tmp: string;
966    begin
967        pos := AnsiPos('&#18', AString);
968            while pos <> 0  do begin
969            if AString[pos+6] = ';' then begin
970                if StrToIntDef(Copy(AString, pos+4, 2), 0) <= 71 then begin
971                        tmp := tmp + Copy(AString, 1, pos - 1);
972                    Delete(AString, 1, pos+6);
973                end else begin
974                        tmp := tmp + Copy(AString, 1, pos + 6);
975                    Delete(AString, 1, pos+6);
976                end;
977            end else begin
978                tmp := tmp + Copy(AString, 1, pos + 3);
979                    Delete(AString, 1, pos+3);
980            end;
981            pos := AnsiPos('&#18', AString);
982        end;
983        if Length(AString) > 0 then
984            tmp := tmp + AString;
985        AString := tmp;
986        tmp := '';
987    
988        pos := AnsiPos('&#179', AString);
989            while pos <> 0 do begin
990            if AString[pos+6] = ';' then begin
991                if StrToIntDef(Copy(AString, pos+5, 1), 0) > 2 then begin
992                        tmp := tmp + Copy(AString, 1, pos - 1);
993                    Delete(AString, 1, pos+6);
994                end else begin
995                        tmp := tmp + Copy(AString, 1, pos + 6);
996                    Delete(AString, 1, pos+6);
997                end;
998                tmp := tmp + Copy(AString, 1, pos - 1);
999                    Delete(AString, 1, pos+6);
1000            end else begin
1001                tmp := tmp + Copy(AString, 1, pos + 4);
1002                    Delete(AString, 1, pos+4);
1003            end;
1004            pos := AnsiPos('&#179', AString);
1005        end;
1006        if Length(AString) > 0 then
1007            tmp := tmp + AString;
1008        Result := tmp;
1009  end;  end;
1010  end.  end.
1011    

Legend:
Removed from v.1.17  
changed lines
  Added in v.1.17.2.1

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