+{
+NO_ABON \82 \82Ú\81[\82ñ\8dÏ\82Ý\82Ì\83\8c\83X\82à\95\\8e¦\82·\82é(\8b\92²\82³\82ê\82é)
+SPAM_FILTER_ENABLED \83X\83p\83\80\83t\83B\83\8b\83^\82ð\8b@\94\\82³\82¹\82é
+}
+
unit AbonUnit;
interface
Windows,Messages, ShellAPI, SysUtils, Classes,StdCtrls,StrUtils;
type
- TIndiviAbon = record
- Res: Integer;
- option: Integer; // 0:\93§\96¾ 1:\92Ê\8fí\82 \82Ú\81[\82ñ
- end;
+ TIndiviAbon = class( TObject )
+ private
+ FRes: Integer;
+ FOption: Integer; // 0:\93§\96¾ 1:\92Ê\8fí\82 \82Ú\81[\82ñ
+ public
+ property Res : Integer read FRes write FRes;
+ property Option : Integer read FOption write FOption;
+ end;
+
+ TIndiviAbonList = class( TList )
+ private
+ FFilePath : string; //!< \83t\83@\83C\83\8b\83p\83X
+ FLearned : Integer; //!< \83X\83p\83\80\8aw\8fK\8dÏ\82Ý\83\8c\83X No
+
+ function GetItem( index : Integer ) : TIndiviAbon;
+ procedure SetItem( index : Integer; value : TIndiviAbon );
+
+ public
+ destructor Destroy; override;
+
+ property Items[ index : Integer ] : TIndiviAbon
+ read GetItem write SetItem; default;
+ procedure Sort; overload;
+ procedure LoadFromFile( const filePath : string );
+ procedure Save;
+ end;
TAbon = class(TObject)
private
- { Private \90é\8c¾ }
- Froot : String;
- Flistpath : String;
- FNGwordpath : String;
- Ftokens : array of array of string;
- FAbonRes : array of TIndiviAbon;
- FAbonString : String;
-// FCutoffNum : Integer; //\82±\82Ì\90\94\88È\8fã\98A\91±\82·\82é\93¯\82¶\89p\8e\9a\82ðNG\83\8f\81[\83h\82Æ\82·\82é
- FDeleterlo : Boolean; //&rlo;\82ð\8dí\82é\82© //\92Ç\89Á&lro;\82à\8dí\82é
- FReplaceul :Boolean ; //<ul>\83^\83O\82ð<br>\83^\83O\82É\92u\8a·\82·\82é\82©
- FReverse : Boolean ; //NG\83\8f\81[\83h\82Å\82Ì\82 \82Ú\81`\82ñ\82Ì\8c\8b\89Ê\82ð\94½\93]\82³\82¹\82é\82©
- FAbonPopupRes : Boolean; //\83\8c\83X\83|\83b\83v\83A\83b\83v\82Ì\8e\9e\82É\82 \82Ú\81[\82ñ\82·\82é\82©
- FCreateNGwordFile : Boolean; //\8ew\92è\82³\82ê\82½path\82ÉNG\83\8f\81[\83htxt\82ª\96³\82©\82Á\82½\82Æ\82«\82É\8e©\93®\93I\82É\90¶\90¬\82·\82é\82©
- FNGwordFileIndex : Integer; //\8c»\8dÝ\93Ç\82Ý\8d\9e\82ñ\82Å\82éNG\83\8f\81[\83h\82ªlist\82Ì\89½\8ds\96Ú\82©
- FNGwordname : String; //\8c»\8dÝ\93Ç\82Ý\8d\9e\82ñ\82Å\82éNG\83\8f\81[\83h\82Ì\95\\8e¦\96¼
- FIndividualFileName : String; //\8cÂ\95Ê\82 \82Ú\81`\82ñ\82Ì\83t\83@\83C\83\8b\96¼
- FReturnNGwordLineNum : Boolean; //NG\83\8f\81[\83h\82Ì\8ds\90\94\82ð\95Ô\82·\81B
- FSetNGResAnchor : Boolean; //NG\82É\8aY\93\96\82µ\82½\82Æ\82«\82É\96{\95¶\82É\82»\82Ì\83\8c\83X\82Ö\82Ì\83\8c\83X\83A\83\93\83J\81[\82ð\82Â\82¯\82é\82©\82Ç\82¤\82©
- FDeleteSyria: Boolean; //\83V\83\8a\83A\8cê\83u\83\89\83N\83\89\91Î\8dô\81i܀~ݏ\81j
- procedure SetTokens(index: integer ; argline:String);
- function Getlistpath() : String;
- procedure Setlistpath(const Value : String);
- function LoadListFile(path :String;listStringList : TStringList) : Boolean;
- function ReadNGwordslist(line : Integer) : Boolean;
- function LoadFromSetResNumFile(SetResNumFile : String) : Boolean;
+ { Private \90é\8c¾ }
+ Froot : String;
+ Flistpath : String;
+ FNGwordpath : String;
+ Ftokens : array of array of string;
+ FAbonRes : TIndiviAbonList;
+ FAbonString : String;
+ FpAbons : PChar;
+ FpAbone : PChar;
+ FDeleterlo : Boolean; //&rlo;\82ð\8dí\82é\82© //\92Ç\89Á&lro;\82à\8dí\82é
+ FReplaceul :Boolean ; //<ul>\83^\83O\82ð<br>\83^\83O\82É\92u\8a·\82·\82é\82©
+ FReverse : Boolean ; //NG\83\8f\81[\83h\82Å\82Ì\82 \82Ú\81`\82ñ\82Ì\8c\8b\89Ê\82ð\94½\93]\82³\82¹\82é\82©
+ FAbonPopupRes : Boolean; //\83\8c\83X\83|\83b\83v\83A\83b\83v\82Ì\8e\9e\82É\82 \82Ú\81[\82ñ\82·\82é\82©
+ FNGwordFileIndex : Integer; //\8c»\8dÝ\93Ç\82Ý\8d\9e\82ñ\82Å\82éNG\83\8f\81[\83h\82ªlist\82Ì\89½\8ds\96Ú\82©
+ FNGwordname : String; //\8c»\8dÝ\93Ç\82Ý\8d\9e\82ñ\82Å\82éNG\83\8f\81[\83h\82Ì\95\\8e¦\96¼
+ FIndividualFileName : String; //\8cÂ\95Ê\82 \82Ú\81`\82ñ\82Ì\83t\83@\83C\83\8b\96¼
+ FReturnNGwordLineNum : Boolean; //NG\83\8f\81[\83h\82Ì\8ds\90\94\82ð\95Ô\82·\81B
+ FSetNGResAnchor : Boolean; //NG\82É\8aY\93\96\82µ\82½\82Æ\82«\82É\96{\95¶\82É\82»\82Ì\83\8c\83X\82Ö\82Ì\83\8c\83X\83A\83\93\83J\81[\82ð\82Â\82¯\82é\82©\82Ç\82¤\82©
+ FDeleteSyria: Boolean; //\83V\83\8a\83A\8cê\83u\83\89\83N\83\89\91Î\8dô\81i܀~ݏ\81j
+ FIgnoreKana: Boolean; //\91S\8ap\94¼\8ap\82Ð\82ç\82ª\82È\83J\83^\83J\83i\82Ì\88á\82¢\82ð\96³\8e\8b\82·\82é\82©
+ procedure SetTokens(index: integer ; argline:String);
+ function Getlistpath() : String;
+ procedure Setlistpath(const Value : String);
+ function LoadListFile(path :String;listStringList : TStringList) : Boolean;
+ function ReadNGwordslist(line : Integer) : Boolean;
+ function LoadFromSetResNumFile(SetResNumFile : String) : Boolean;
public
- { Public \90é\8c¾ }
- constructor Create; // \83R\83\93\83X\83g\83\89\83N\83^
- destructor Destroy; override; // \83f\83X\83g\83\89\83N\83^
- property Deleterlo: Boolean read FDeleterlo write FDeleterlo default false;
- property Replaceul: Boolean read FReplaceul write FReplaceul default false;
- property Reverse: Boolean read FReverse write FReverse default false;
- property CreateNGwordFile: Boolean read FCreateNGwordFile write FCreateNGwordFile;
- property AbonString : String read FAbonString write FAbonString;
- property AbonPopupRes : Boolean read FAbonPopupRes write FAbonPopupRes default false;
- property listpath : String read Getlistpath write Setlistpath;
- property NGwordFileIndex : Integer read FNGwordFileIndex write FNGwordFileIndex default 0;
- property NGwordname : String read FNGwordname write FNGwordname;
+ { Public \90é\8c¾ }
+ constructor Create; // \83R\83\93\83X\83g\83\89\83N\83^
+ destructor Destroy; override; // \83f\83X\83g\83\89\83N\83^
+ property Deleterlo: Boolean read FDeleterlo write FDeleterlo default false;
+ property Replaceul: Boolean read FReplaceul write FReplaceul default false;
+ property Reverse: Boolean read FReverse write FReverse default false;
+ property AbonString : String read FAbonString write FAbonString;
+ property AbonPopupRes : Boolean read FAbonPopupRes write FAbonPopupRes default false;
+ property listpath : String read Getlistpath write Setlistpath;
+ property NGwordFileIndex : Integer read FNGwordFileIndex write FNGwordFileIndex default 0;
+ property NGwordname : String read FNGwordname write FNGwordname;
property ReturnNGwordLineNum : Boolean read FReturnNGwordLineNum write FReturnNGwordLineNum default false;
- property SetNGResAnchor : Boolean read FSetNGResAnchor write FSetNGResAnchor default false;
- property DeleteSyria : Boolean read FDeleteSyria write FDeleteSyria default false;
- procedure Setroot(root :String);
- function Getroot() : String;
-
- function Getfullpath(argpath : String) : String;
- procedure SetNGwordpath(path :String);
- function GetNGwordpath() : String;
- function LoadFromNGwordFile(path :String) : Boolean;
- function ReLoadFromNGwordFile() : Boolean;
- procedure LoadFromStringList( bufstl : TStringList );
- function CheckAbonPopupRes(line : String) :Boolean;
+ property SetNGResAnchor : Boolean read FSetNGResAnchor write FSetNGResAnchor default false;
+ property DeleteSyria : Boolean read FDeleteSyria write FDeleteSyria default false;
+ property IgnoreKana: Boolean read FIgnoreKana write FIgnoreKana default false;
+ procedure Setroot(root :String);
+ function Getroot() : String;
+
+ function Getfullpath(argpath : String) : String;
+ procedure SetNGwordpath(path :String);
+ function GetNGwordpath() : String;
+ function LoadFromNGwordFile(path :String) : Boolean;
+ function ReLoadFromNGwordFile() : Boolean;
+ procedure LoadFromStringList( bufstl : TStringList );
+ function CheckAbonPopupRes(line : String) :Boolean;
function FindNGwords(const line : String; var NGwordsLineNum : Integer; var Invisible : Boolean) : Boolean;//1\83\89\83C\83\93\82¸\82Â\97p\81B
- function FindNGwordsEx(const line : String; var NGwordsLineNum : Integer; var Invisible : Boolean) : Boolean;//1\83\89\83C\83\93\82¸\82Â\97p\81B
//\82 \82Ú\81`\82ñ\8f\88\97\9d(NG\83\8f\81[\83h\82Å\82Ì\83t\83B\83\8b\83^\83\8a\83\93\83O)
procedure Execute(var ThreadStrings : TStringList); overload;
- procedure Execute(var ThreadStrings : TStringList; NGwords : TStringList); overload;
- procedure Execute(var ThreadStrings : TStringList; NGwords : TStrings); overload;
procedure Execute(var ResString : String; ResNumber : Integer); overload; //\8eå\82Éplugin\82©\82ç\82ÌDat To HTML \97p
- procedure ExecuteEx(var ThreadStrings : TStringList); overload;
- procedure ExecuteEx(var ThreadStrings : TStringList; NGwords : TStringList); overload;
- procedure ExecuteEx(var ThreadStrings : TStringList; NGwords : TStrings); overload;
- procedure ExecuteEx(var ResString : String; ResNumber : Integer); overload; //\8eå\82Éplugin\82©\82ç\82ÌDat To HTML \97p
+{$IFDEF SPAM_FILTER_ENABLED}
+ //! \83X\83p\83\80\83t\83B\83\8b\83^\82Ì\8aw\8fK
+ procedure Learn( resList : TStringList );
+{$ENDIF}
//\8cÂ\95Ê\82 \82Ú\81`\82ñ\82µ\82å\82è
procedure IndividualAbon(var ThreadStrings : TStringList; SetResNumFile : String); overload;
procedure IndividualAbon(var ResString : String; SetResNumFile : String; ResNumber : Integer); overload;
procedure AddIndividualAbon( ResNum : Integer ; option : Integer; SetResNumFile : String);
- procedure DeleteIndividualAbon( ResNum : Integer); overload;
- procedure DeleteIndividualAbon( ResNum : Integer; SetResNumFile : String); overload;
-
- function GetAbonResCount() : Integer; overload;
- function GetAbonResCount(SetResNumFile : String) : Integer; overload;
-
- function GetAbonResString(Num : Integer) : String;
function CheckIndividualAbonList(ResNum : Integer) : Boolean;
procedure EditNGwords(); //NGword.txt\82ð\8aJ\82\81B
function GoBack() : Boolean; //List\82Ì\88ê\82Â\91O\82ÌNG\83\8f\81[\83h\83t\83@\83C\83\8b\82ð\93Ç\82Ý\8d\9e\82Þ
//--
function TreatSyria(AString: string): string;
+ //--
+ function AddToken(AString: string; Invisible: Boolean): Boolean;
end;
var
Abon1 :TAbon;
implementation
-uses MojuUtils;
+uses MojuUtils, GikoSystem, GikoBayesian, Setting;
+
+function InvidiAbonListSort( item1, item2 : Pointer ) : Integer;
+begin
+
+ Result := TIndiviAbon( item1 ).Res - TIndiviAbon( item2 ).Res;
+
+end;
+
+destructor TIndiviAbonList.Destroy;
+var
+ i : Integer;
+begin
+
+ for i := 0 to Count - 1 do
+ if inherited Items[ i ] <> nil then
+ TObject( inherited Items[ i ] ).Free;
+
+ inherited;
+
+end;
+
+function TIndiviAbonList.GetItem( index : Integer ) : TIndiviAbon;
+begin
+
+ Result := TIndiviAbon( inherited Items[ index ] );
+
+end;
+
+procedure TIndiviAbonList.SetItem( index : Integer; value : TIndiviAbon );
+begin
+
+ inherited Items[ index ] := Pointer( value );
+
+end;
+
+procedure TIndiviAbonList.Sort;
+begin
+
+ inherited Sort( InvidiAbonListSort );
+
+end;
+
+procedure TIndiviAbonList.LoadFromFile( const filePath : string );
+var
+ bufStringList : TStringList;
+ bufLine : string;
+ i : Integer;
+ item : TIndiviAbon;
+begin
+
+ if not FileExists( filePath ) then begin
+ FLearned := 0;
+ Exit;
+ end;
+
+ FFilePath := filePath;
+ bufStringList := TStringList.Create;
+ try
+ bufStringList.LoadFromFile( filePath );
+ if bufStringList.Values[ 'Learned' ] <> '' then begin
+ FLearned := StrToInt( bufStringList.Values[ 'Learned' ] );
+ bufStringList.Delete( bufStringList.IndexOfName( 'Learned' ) );
+ end else begin
+ FLearned := 0;
+ end;
+
+ //\8bó\8ds\8dí\8f\9c
+ for i := bufStringList.Count-1 downto 0 do begin
+ if bufStringList.Strings[i] = '' then begin
+ bufStringList.Delete(i);
+ end;
+ end;
+
+ //\91ã\93ü
+ for i := 0 to bufStringList.Count - 1 do begin
+ bufLine := Trim(bufStringList.Strings[i]);
+ item := TIndiviAbon.Create;
+ item.Res := StrToInt(Copy(bufLine,1,AnsiPos('-',bufLine)-1));
+ item.option := StrToInt(Copy(bufLine,AnsiPos('-',bufLine)+1,1));
+ Add( item );
+ end;
+ finally
+ bufStringList.Free;
+ end;
+
+end;
+
+procedure TIndiviAbonList.Save;
+var
+ bufStringList : TStringList;
+ i : Integer;
+begin
+
+ bufStringList := TStringList.Create;
+ try
+ bufStringList.Values[ 'Learned' ] := IntToStr( FLearned );
+
+ for i := 0 to Count - 1 do begin
+ bufStringList.Add(
+ IntToStr( Items[ i ].Res ) + '-' + IntToStr( Items[ i ].Option ) );
+ end;
+
+ bufStringList.SaveToFile( FFilePath );
+ finally
+ bufStringList.Free;
+ end;
+
+end;
constructor TAbon.Create;
begin
// \8f\89\8aú\89»
FAbonString := ' <> <> <> <><>';
- FCreateNGwordFile := true;
- SetLength(FAbonRes,1);
- FAbonRes[0].Res := 0;
- FAbonRes[0].option := -1;
+ FAbonRes := TIndiviAbonList.Create;
+ FpAbons := PChar(FAbonString);
+ FpAbone := FpAbons + Length(FAbonString);
end;
destructor TAbon.Destroy;
begin
+ FAbonRes.Free;
inherited;
end;
//root\82ÍExe\config\NGwords\83t\83H\83\8b\83_
if path = '' then begin
Result := false;
end else begin
+
bufstl := TStringList.Create;
try
- try
+ if not FileExists(path) then begin
+ Result := false;
+ try
+ bufstl.SaveToFile(path);
+ except
+ end;
+ end else begin
bufstl.LoadFromFile(path);
LoadFromStringList( bufstl );
Result := true;
- except
- if CreateNGwordFile = true then begin
- bufstl.SaveToFile(path);
- end;
- Result := false;
end;
finally
bufstl.Free;
pos : Integer;
buftoken : String;
begin
- pos := 0;
bufstl := TStringList.Create;
try
if Length(argline) > 0 then begin
buftoken := Copy(argline,1,pos-1);
Delete(argline,1,pos);
if Length(buftoken) > 0 then begin
- bufstl.Append(buftoken);
+ // >> \82Å\8en\82Ü\82é\83g\81[\83N\83\93\82Í\83R\83\81\83\93\83g\88µ\82¢\82Å\96³\8e\8b\82·\82é
+ if AnsiPos('>>', buftoken) <> 1 then begin
+ bufstl.Append(buftoken);
+ end;
end else if ( bufstl.Count = 0 ) then begin
bufstl.Append('');
end;
pos := AnsiPos(#9,argline);
end;
if Length(argline) > 0 then begin
- bufstl.Append(argline);
+ // >> \82Å\8en\82Ü\82é\83g\81[\83N\83\93\82Í\83R\83\81\83\93\83g\88µ\82¢\82Å\96³\8e\8b\82·\82é
+ if AnsiPos('>>', argline) <> 1 then begin
+ bufstl.Append(argline);
+ end;
end;
ret := bufstl.Count;
SetLength(Ftokens[index],ret);
for i := 0 to bufstl.Count - 1 do begin
- Ftokens[index][i] := bufstl.Strings[i];
+ if IgnoreKana then
+ Ftokens[index][i] := ZenToHan(bufstl.Strings[i])
+ else
+ Ftokens[index][i] := bufstl.Strings[i];
end;
end;
finally
hit : Boolean;
bufline : String;
start : Integer;
+ target : String;
+ pos : PChar;
+ pts, pte : PChar;
+ trgLen : Integer;
begin
hit := false;
- if AnsiPos(FAbonString,line) <> 1 then begin
- for lines := 0 to High(Ftokens) do begin
- hit := true;
- bufline := line;
- if Ftokens[lines][0] <> '' then begin
- Invisible := false;
- start := 0;
- end else begin
- Invisible := true;
- start := 1;
- end;
+ if AnsiStrPosEx(PChar(line), PChar(line)+Length(line), FpAbons, FpAbone) = nil then begin
+ //\91S\94¼\8ap\82Ð\82ç\83J\83i\96³\8e\8b\82·\82é\82©
+ if IgnoreKana then
+ target := ZenToHan(line)
+ else
+ target := line;
+
+ trgLen := Length(target);
- for cells := start to High(Ftokens[lines]) do begin
- if AnsiPos(Ftokens[lines][cells],bufline) = 0 then begin
- hit := false;
- break;
- end else begin
- Delete(bufline,AnsiPos(Ftokens[lines][cells],bufline),Length(Ftokens[lines][cells]));
- end;
- end;
- if hit = true then begin
- NGwordsLineNum := lines + 1;
- break;
- end;
- end;
- end;
- Result := hit;
-end;
-//NG\83\8f\81[\83h\82ª\8aÜ\82Ü\82ê\82Ä\82¢\82½\82çtrue\82ð\95Ô\82µ\81A\82»\82ÌNG\83\8f\81[\83h\82Ì\8ds\90\94\82ðNGwordsLineNum\82É\93ü\82ê\82Ä\95Ô\82·\81B
-//\82à\82µ\82à\93§\96¾\82 \82Ú\81`\82ñ\82É\82·\82é\82È\82çInbisible\82ðtrue\82É\82µ\82Ä\95Ô\82·
-//\94¼\8ap\91S\8ap\96³\8e\8b
-function TAbon.FindNGwordsEx(const line : String; var NGwordsLineNum : Integer; var Invisible : Boolean) : Boolean;//1\83\89\83C\83\93\82¸\82Â\97p\81B
-var
- lines : Integer;
- cells : Integer;
- hit : Boolean;
- bufline : String;
- start : Integer;
-begin
- hit := false;
- if AnsiPos(FAbonString,line) <> 1 then begin
for lines := 0 to High(Ftokens) do begin
+ if Length(Ftokens[lines]) = 0 then begin
+ Continue;
+ end;
hit := true;
- bufline := line;
+ bufline := target;
+ pts := PChar(bufline);
+ pte := pts + trgLen;
+
if Ftokens[lines][0] <> '' then begin
Invisible := false;
start := 0;
end;
for cells := start to High(Ftokens[lines]) do begin
- if AnsiPos(Ftokens[lines][cells],bufline) = 0 then begin
+ pos := AnsiStrPosEx(pts, pte,
+ PChar(Ftokens[lines][cells]), PChar(Ftokens[lines][cells]) + Length(Ftokens[lines][cells]));
+ if pos = nil then begin
hit := false;
break;
end else begin
- Delete(bufline, AnsiPos(Ftokens[lines][cells],bufline),Length(Ftokens[lines][cells]));
+ Delete(bufline, pos - pte + 1, Length(Ftokens[lines][cells]));
+ pts := PChar(bufline);
+ pte := pts + Length(bufline);
end;
end;
if hit = true then begin
end;
end;
-procedure TAbon.Execute(var ThreadStrings : TStringList; NGwords : TStringList);
-var
- i : Integer;
-begin
- SetLength(Ftokens,NGwords.Count);
- for i := 0 to NGwords.Count -1 do begin
- SetTokens(i , NGwords.Strings[i]);
- end;
- Execute(ThreadStrings);
-end;
-procedure TAbon.Execute(var ThreadStrings : TStringList; NGwords : TStrings);
-var
- i : Integer;
- buf : TStringList;
-begin
- buf := TStringList.Create;
- buf.AddStrings(NGwords);
- SetLength(Ftokens,buf.Count);
- for i := 0 to buf.Count -1 do begin
- SetTokens(i , buf.Strings[i]);
- end;
- Execute(ThreadStrings);
- buf.Free;
-end;
-
-//\96\96\94ö\82Ì\83u\81[\83\8b\92l\82Ítrue\82¾\82Æ\81ANG\83\8f\81[\83h\82ð\8aÜ\82Þ\82à\82Ì\82¾\82¯\82ð\95Ô\82·\81B
-procedure TAbon.ExecuteEx(var ThreadStrings : TStringList);
-var
- i : Integer;
- NGwordsLine : Integer;
- bufline : String;
- invisi : Boolean;
-begin
- for i:=0 to ThreadStrings.Count - 1 do begin
- NGwordsLine := 0;
- if FindNGwordsEx(ThreadStrings.Strings[i], NGwordsLine ,invisi) <> Reverse then begin
- if invisi = true then begin
- ThreadStrings.Strings[i] := '';
- end else begin
- if not ReturnNGwordLineNum and not SetNGResAnchor then begin
- ThreadStrings.Strings[i] := FAbonString;
- end else if not ReturnNGwordLineNum then begin
- ThreadStrings.Strings[i] := Format(' <> <> <>>%d<><>',[(i+1)]);
- end else if not SetNGResAnchor then begin
- ThreadStrings.Strings[i] := Format(' <> <> <><B> %d \8ds\96Ú\82ÌNG\83\8f\81[\83h\82ª\8aÜ\82Ü\82ê\82Ä\82¢\82Ü\82·\81B</B><><>',[NGwordsLine]);
- end else begin
- ThreadStrings.Strings[i] := Format(' <> <> <><B> %d \8ds\96Ú\82ÌNG\83\8f\81[\83h\82ª\8aÜ\82Ü\82ê\82Ä\82¢\82Ü\82·\81B</B>>%d <><>',[NGwordsLine,(i+1)]);
- end;
- end;
- end else begin
- bufline := ThreadStrings.Strings[i];
- if Deleterlo = true then begin
- bufline := CustomStringReplace(bufline,'&rlo;','');
- bufline := CustomStringReplace(bufline,'&lro;','');
- end;
- if Replaceul = true then begin
- bufline := CustomStringReplace( bufline,'<ul>','<br>' );
- bufline := CustomStringReplace( bufline,'</ul>','<br>' );
- end;
- if DeleteSyria = true then
- bufline := TreatSyria(bufline);
- ThreadStrings.Strings[i] := bufline;
- end;
- end;
-end;
-procedure TAbon.ExecuteEx(var ResString : String; ResNumber : Integer);
-var
- NGwordsLine : Integer;
- bufline : String;
- invisi : Boolean;
-begin
- NGwordsLine := 0;
- if FindNGwordsEx(ResString, NGwordsLine ,invisi) <> Reverse then begin
- if invisi = true then begin
- ResString := '';
- end else begin
- if not ReturnNGwordLineNum and not SetNGResAnchor then begin
- ResString := FAbonString;
- end else if not ReturnNGwordLineNum then begin
- ResString := Format(' <> <> <>>%d<><>',[(ResNumber)]);
- end else if not SetNGResAnchor then begin
- ResString := Format(' <> <> <><B> %d \8ds\96Ú\82ÌNG\83\8f\81[\83h\82ª\8aÜ\82Ü\82ê\82Ä\82¢\82Ü\82·\81B</B><><>',[NGwordsLine]);
- end else begin
- ResString := Format(' <> <> <><B> %d \8ds\96Ú\82ÌNG\83\8f\81[\83h\82ª\8aÜ\82Ü\82ê\82Ä\82¢\82Ü\82·\81B</B>>%d <><>',[NGwordsLine,(ResNumber)]);
- end;
- end;
- end else begin
- bufline := ResString;
- if Deleterlo = true then begin
- bufline := CustomStringReplace( bufline,'&rlo;','' );
- bufline := CustomStringReplace( bufline,'&lro;','' );
- end;
- if Replaceul = true then begin
- bufline := CustomStringReplace( bufline,'<ul>','<br>' );
- bufline := CustomStringReplace( bufline,'</ul>','<br>' );
- end;
- if DeleteSyria = true then
- bufline := TreatSyria(bufline);
- ResString := bufline;
- end;
-end;
-
-procedure TAbon.ExecuteEx(var ThreadStrings : TStringList; NGwords : TStringList);
-var
- i : Integer;
-begin
- SetLength(Ftokens,NGwords.Count);
- for i := 0 to NGwords.Count -1 do begin
- SetTokens(i , NGwords.Strings[i]);
- end;
- ExecuteEx(ThreadStrings);
-
-end;
-procedure TAbon.ExecuteEx(var ThreadStrings : TStringList; NGwords : TStrings);
-var
- i : Integer;
- buf : TStringList;
-begin
- buf := TStringList.Create;
- buf.AddStrings(NGwords);
- SetLength(Ftokens,buf.Count);
- for i := 0 to buf.Count -1 do begin
- SetTokens(i , buf.Strings[i]);
- end;
- ExecuteEx(ThreadStrings);
- buf.Free;
-end;
//****************************************************************************//
//\8c»\8dÝ\83Z\83b\83g\82³\82ê\82Ä\82¢\82éNGword.txt\82ð\8aJ\82
end;
end;
+
+{$IFDEF SPAM_FILTER_ENABLED}
+procedure TAbon.Learn( resList : TStringList );
+var
+ i, j : Integer;
+ wordCount : TWordCount;
+ spamminess : Extended;
+ indiviAbon : TIndiviAbon;
+const
+ SPAM_THRESHOLD = 0.9;
+begin
+
+ if GikoSys.Setting.SpamFilterAlgorithm = gsfaNone then Exit;
+ j := 0;
+ wordCount := TWordCount.Create;
+ try
+ if (FAbonRes.FLearned = 0) and (FAbonRes.Count = 0) then begin
+ // \8f\89\82ß\82Ä\82Ì\8aw\8fK\82©\82Â\8cÂ\95Ê\82 \82Ú\81`\82ñ\82 \82è\82È\82Ì\82Å\81A\8b\8cver\82©\82ç\82Ì\88Ú\8ds\82É\82Â\82«
+ // \8cÂ\95Ê\82 \82Ú\81`\82ñ\82ð\8eg\82Á\82½\8aw\8fK
+ FAbonRes.Sort;
+ for i := 0 to FAbonRes.Count - 1 do begin
+ while (j < resList.Count) and (j + 1 < FAbonRes[ j ].Res) do begin
+ wordCount.Clear;
+ GikoSys.Bayesian.CountWord( resList[ j ], wordCount );
+ GikoSys.Bayesian.Learn( wordCount, False );
+ Inc( j );
+ end;
+ if j < resList.Count then begin
+ wordCount.Clear;
+ GikoSys.Bayesian.CountWord( resList[ j ], wordCount );
+ GikoSys.Bayesian.Learn( wordCount, True );
+ Inc( j );
+ end;
+ end;
+
+ while j < resList.Count do begin
+ wordCount.Clear;
+ GikoSys.Bayesian.CountWord( resList[ j ], wordCount );
+ GikoSys.Bayesian.Learn( wordCount, False );
+ Inc( j );
+ end;
+ end else begin
+ // \8b\8cver\82©\82ç\82Ì\88Ú\8ds\82Å\82Í\82È\82¢\82Ì\82Å\83\8c\83X\82ð\91S\82Ä\90\84\98_\82Å\8aw\8fK
+ // \81¦\90\84\98_\82ª\8aÔ\88á\82Á\82Ä\82¢\82é\8fê\8d\87\82Í\83\86\81[\83U\82ª\82 \82Ú\81`\82ñ\82ð\8fC\90³\82·\82é\8e\96\82Å\8aw\8fK\82³\82ê\82é
+ for j := FAbonRes.FLearned to resList.Count - 1 do begin
+ wordCount.Clear;
+ spamminess := GikoSys.SpamParse( resList[ j ], wordCount );
+ if spamminess >= SPAM_THRESHOLD then begin
+ // \83X\83p\83\80
+ GikoSys.Bayesian.Learn( wordCount, True );
+ indiviAbon := TIndiviAbon.Create;
+ indiviAbon.Res := j + 1;
+ indiviAbon.Option := 1;
+ FAbonRes.Add( indiviAbon );
+ end else begin
+ // \83n\83\80
+ GikoSys.Bayesian.Learn( wordCount, False );
+ end;
+ end;
+ end;
+
+ FAbonRes.FLearned := resList.Count;
+ FAbonRes.Save;
+ finally
+ wordCount.Free;
+ end;
+
+ FAbonRes.Save;
+ GikoSys.Bayesian.Save;
+
+end;
+{$ENDIF}
+
//\95¡\90\94\82ÌNG\83\8f\81[\83h\83e\83L\83X\83g\82ð\93Ç\82Ý\8d\9e\82Þ=====\82±\82±\82Ü\82Å=================================
//\8cÂ\95Ê\82 \82Ú\81`\82ñ\8eÀ\8ds\8aÖ\90\94
procedure TAbon.IndividualAbon(var ThreadStrings : TStringList; SetResNumFile : String);
var
i : Integer;
-begin
- if FileExists(SetResNumFile) = true then begin
- if LoadFromSetResNumFile(SetResNumFile) = true then begin
- for i := 0 to High(FAbonRes) do begin
- if (FAbonRes[i].Res <= ThreadStrings.Count) and (FAbonRes[i].Res > 0) then begin
- if FAbonRes[i].option = 0 then begin
- ThreadStrings.Strings[FAbonRes[i].Res-1] := '';
- end else begin
- ThreadStrings.Strings[FAbonRes[i].Res-1] := '\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>';
- end;
- end;
-
- end;
- end;
- end else begin
- FIndividualFileName := SetResNumFile;
- SetLength(FAbonRes,1);
- FAbonRes[0].Res := 0;
- FAbonRes[0].option := -1;
- end;
+ f : Boolean;
+begin
+ f := LoadFromSetResNumFile( SetResNumFile );
+ FAbonRes.FFilePath := SetResNumFile; // Learn \82Í\82Å\95Û\91¶\82·\82é\82Ì\82Å
+{$IFDEF SPAM_FILTER_ENABLED}
+ Learn( ThreadStrings );
+{$ENDIF}
+
+ if f then begin
+ for i := 0 to FAbonRes.Count - 1 do begin
+ if (FAbonRes[i].Res <= ThreadStrings.Count) and (FAbonRes[i].Res > 0) then begin
+{$IFDEF NO_ABON}
+ ThreadStrings.Strings[FAbonRes[i].Res-1] :=
+ '<font color="red">\82 \82Ú\81`\82ñ\8dÏ\82Ý</font>' +
+ ThreadStrings.Strings[FAbonRes[i].Res-1];
+{$ELSE}
+ if FAbonRes[i].option = 0 then begin
+ ThreadStrings.Strings[FAbonRes[i].Res-1] := '';
+ end else begin
+ ThreadStrings.Strings[FAbonRes[i].Res-1] := '\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>\82 \82Ú\81`\82ñ<>';
+ end;
+{$ENDIF}
+ end;
+ end;
+ end;
end;
procedure TAbon.IndividualAbon(var ResString : String; SetResNumFile : String; ResNumber : Integer);
var
begin
if FileExists(SetResNumFile) = true then begin
if LoadFromSetResNumFile(SetResNumFile) = true then begin
- for i := 0 to High(FAbonRes) do begin
+ for i := 0 to FAbonRes.Count - 1 do begin
if FAbonRes[i].Res = ResNumber then begin
if FAbonRes[i].option = 0 then begin
ResString := '';
end;
end;
end else begin
- FIndividualFileName := SetResNumFile;
- SetLength(FAbonRes,1);
- FAbonRes[0].Res := 0;
- FAbonRes[0].option := -1;
- end;
+ FIndividualFileName := SetResNumFile;
+ FAbonRes.Free;
+ FAbonRes := TIndiviAbonList.Create;
+ end;
end;
//\8cÂ\95Ê\82 \82Ú\81`\82ñ\83t\83@\83C\83\8b\93Ç\82Ý\8d\9e\82Ý\8aÖ\90\94
function TAbon.LoadFromSetResNumFile(SetResNumFile : String) : Boolean;
-var
- bufStringList : TStringList;
- bufLine : String;
- i : Integer;
begin
- bufStringList := TStringList.Create;
- try
- try
- bufStringList.LoadFromFile(SetResNumFile);
- FIndividualFileName := SetResNumFile;
- //\8bó\8ds\8dí\8f\9c
- for i := bufStringList.Count-1 downto 0 do begin
- if bufStringList.Strings[i] = '' then begin
- bufStringList.Delete(i);
- end;
- end;
-
- //\83\81\83\82\83\8a\8am\95Û
- SetLength(FAbonRes,bufStringList.Count);
- //\91ã\93ü
- for i :=0 to bufStringList.Count - 1 do begin
- bufLine := Trim(bufStringList.Strings[i]);
- FAbonRes[i].Res := StrToInt(Copy(bufLine,1,AnsiPos('-',bufLine)-1));
- FAbonRes[i].option := StrToInt(Copy(bufLine,AnsiPos('-',bufLine)+1,1));
- end;
- except
- Result := false;
- Exit;
- end;
- finally
- bufStringList.Free;
- end;
- Result := true;
+
+ FIndividualFileName := SetResNumFile;
+ FAbonRes.Free;
+ FAbonRes := TIndiviAbonList.Create;
+ if FileExists( SetResNumFile ) then begin
+ FAbonRes.LoadFromFile( SetResNumFile );
+ Result := true;
+ end else begin
+ Result := False;
+ end;
+
end;
//\8cÂ\95Ê\82 \82Ú\81`\82ñ\83t\83@\83C\83\8b\82É\92Ç\89Á
procedure TAbon.AddIndividualAbon( ResNum : Integer ; option : Integer; SetResNumFile : String);
IndividualFile.Free;
end;
end;
-//\8cÂ\95Ê\82 \82Ú\81`\82ñ\83t\83@\83C\83\8b\82©\82ç\8dí\8f\9c
-procedure TAbon.DeleteIndividualAbon( ResNum : Integer);
-var
- IndividualFile : TStringList;
- linebuf : String;
- i : Integer;
-begin
- IndividualFile := TStringList.Create;
- if FAbonRes[0].Res <> 0 then begin
- for i := 0 to High(FAbonRes) do begin
- if FAbonRes[i].Res <> ResNum then begin
- linebuf := IntToStr(FAbonRes[i].Res) + '-' + IntToStr(FabonRes[i].option);
- IndividualFile.Append(linebuf);
- end;
- end;
- end;
- if IndividualFile.Count <> 0 then begin
- try
- IndividualFile.SaveToFile(FIndividualFileName);
- finally
- IndividualFile.Free;
- end;
- end else begin
- if FileExists(FIndividualFileName) = true then begin
- DeleteFile(FIndividualFileName);
- end;
- end;
-end;
-//\8cÂ\95Ê\82 \82Ú\81`\82ñ\82Ì\83\8a\83X\83g\82Ì\8cÂ\90\94\82ð\95Ô\82·
-function TAbon.GetAbonResCount() : Integer;
-var
- i : Integer;
-begin
- if FAbonRes[0].Res = 0 then begin
- Result := 0
- end else begin
- i := High(FAbonRes);
- Result := i+1;
- end;
-end;
-//\8cÂ\95Ê\82 \82Ú\81`\82ñ\82Ì\83\8a\83X\83g\82Ì\82\8e\8ds\96Ú\82Ì\83\8c\83X\82ð\95¶\8e\9a\97ñ\82Å\95Ô\82·
-function TAbon.GetAbonResString(Num : Integer) : String;
-begin
- if (Num <= High(FAbonRes)) and (Num >= 0) then begin
- Result := IntToStr(FAbonRes[Num].Res);
- end else begin
- Result := '';
- end;
-end;
-function TAbon.GetAbonResCount(SetResNumFile : String) : Integer;
-var
- bufStringList : TStringList;
-begin
- Result := 0;
- if FileExists(SetResNumFile) then begin
- bufStringList := TStringList.Create;
- try
- try
- bufStringList.LoadFromFile(SetResNumFile);
- Result := bufStringList.Count;
- except
- end;
- finally
- bufStringList.Free;
- end;
- end;
-end;
-procedure TAbon.DeleteIndividualAbon( ResNum : Integer; SetResNumFile : String);
-var
- i: Integer;
- bufStringList : TStringList;
-begin
- if FileExists(SetResNumFile) then begin
- bufStringList := TStringList.Create;
- try
- try
- bufStringList.LoadFromFile(SetResNumFile);
- i := bufStringList.IndexOf(IntToStr(ResNum)+'-');
- if i > 0 then
- bufStringList.Delete(i);
- except
- end;
- finally
- bufStringList.Free;
- end;
- end;
-end;
//\83|\83b\83v\83A\83b\83v\82Ì\94»\92è\97p
function TAbon.CheckIndividualAbonList(ResNum : Integer) : Boolean;
var
i : Integer;
begin
- if FAbonRes[0].Res <> 0 then begin
- for i := 0 to High(FAbonRes) do begin
+ if (FAbonRes.Count > 0) and (FAbonRes[0].Res <> 0) then begin
+ for i := 0 to FAbonRes.Count - 1 do begin
if FAbonRes[i].Res = ResNum then begin
Result := true;
Exit;
end;
//\83V\83\8a\83A\8cê\83u\83\89\83N\83\89\91Î\8dô
function TAbon.TreatSyria(AString: string): string;
+const
+ UNI_TAG = '&#';
var
//count: Integer; //(܀~ݏ)
- pos: Integer;
- tmp: string;
-begin
- pos := AnsiPos('', AString);
- while pos <> 0 do begin
- if StrToIntDef(Copy(AString, pos+4, 2), -1) > 0 then begin
- if (AString[pos+6] = ';' ) or (AString[pos+6] = ' ') then begin
- tmp := tmp + Copy(AString, 1, pos - 1);
- Delete(AString, 1, pos+6);
- end else if StrToIntDef(AString[pos+6], -1) = -1 then begin
- tmp := tmp + Copy(AString, 1, pos - 1);
- Delete(AString, 1, pos+5);
- end else begin
- tmp := tmp + Copy(AString, 1, pos + 5);
- Delete(AString, 1, pos+5);
- end;
- end else begin
- tmp := tmp + Copy(AString, 1, pos + 5);
- Delete(AString, 1, pos+5);
- end;
- pos := AnsiPos('', AString);
- end;
- if Length(AString) > 0 then
- tmp := tmp + AString;
- AString := tmp;
- tmp := '';
-
- pos := AnsiPos('³', AString);
- while pos <> 0 do begin
- if StrToIntDef(Copy(AString, pos+5, 1), 0) > 2 then begin
- if (AString[pos+6] = ';') or (AString[pos+6] = ' ') then begin
- tmp := tmp + Copy(AString, 1, pos - 1);
- Delete(AString, 1, pos+6);
- end else if StrToIntDef(AString[pos+6], -1) = -1 then begin
- tmp := tmp + Copy(AString, 1, pos - 1);
- Delete(AString, 1, pos+5);
+ ps : PChar;
+ p, pe, s, se : PChar;
+ scode: String;
+ icode: Integer;
+begin
+
+ Result := '';
+
+ p := PChar(AString);
+ pe := p + Length(AString);
+ s := PChar(UNI_TAG);
+ se := s + Length(UNI_TAG);
+
+ p := AnsiStrPosEx(p, pe, s, se);
+
+ while p <> nil do begin
+ //&#\82Ì\8eè\91O\82Ü\82Å\83R\83s\81[\82·\82é
+ Result := Result + Copy(AString, 1, p - PChar(AString));
+ //&#\82Ì\8eè\91O\82Ü\82Å\8dí\8f\9c\82·\82é
+ Delete(AString, 1, p - PChar(AString));
+
+ //AString\82É3\95¶\8e\9a\88È\8fã\82 \82ê\82Î\8e\9f\82Ì3\95¶\8e\9a\96Ú\82ð\83`\83F\83b\83N
+ if Length(AString) > 2 then begin
+ ps := PChar(AString) + 2;
+ if (ps^ = 'x') or (ps^ = 'X') then begin
+ //16\90i\95\\8bL
+ Inc(ps);
+ scode := '0x';
+ while ((ps^ >= '0') and (ps^ <= '9')) or
+ ((ps^ >= 'a') and (ps^ <= 'f')) or
+ ((ps^ >= 'A') and (ps^ <= 'F')) do begin
+
+ scode := scode + String(ps^);
+ Inc(ps);
+ end;
end else begin
- tmp := tmp + Copy(AString, 1, pos + 5);
- Delete(AString, 1, pos+5);
+ //10\90i\95\\8bL
+ scode := '';
+ while ((ps^ >= '0') and (ps^ <= '9')) do begin
+ scode := scode + String(ps^);
+ Inc(ps);
+ end;
end;
+ icode := StrToIntDef(scode, 0);
+
+ //\8dÅ\8cã\82ª;\82Å\95Â\82¶\82Ä\82¢\82È\82¯\82ê\82Î\81A\88ê\95¶\8e\9a\91O\82Ü\82Å\82É\82·\82é
+ if not (ps^ = ';') then
+ Dec(ps);
+
+ //\83V\83\8a\83A\8cê\83u\83\89\83N\83\89\82Ì\82Å\82È\82¢
+ if ( icode < 1758) or
+ ((icode > 1871) and (icode < 1958)) or
+ (icode > 1968) then begin
+ Result := Result + Copy(AString, 1, ps - PChar(AString) + 1);
+ end;
+
+ Delete(AString, 1, ps - PChar(AString) + 1);
end else begin
- tmp := tmp + Copy(AString, 1, pos + 5);
- Delete(AString, 1, pos+5);
+ //\8cã\82ë\82É\95¶\8e\9a\82ª\96³\82¢\82Ì\82Å\81A\82»\82Ì\82Ü\82ÜResult\82É\93Ë\82Á\8d\9e\82Þ
+ Result := Result + AString;
+ AString := '';
end;
- pos := AnsiPos('³', AString);
+ p := PChar(AString);
+ pe := p + Length(AString);
+ p := AnsiStrPosEx(p, pe, s, se);
end;
- if Length(AString) > 0 then
- tmp := tmp + AString;
- Result := tmp;
+
+ //\8ec\82Á\82½\95¶\8e\9a\97ñ\82ð\91«\82µ\82Ä\8c\8b\89Ê\82É\82·\82é
+ Result := Result + AString;
end;
+// NG\83\8f\81[\83h\83t\83@\83C\83\8b\82É\92Ç\89Á \92Ç\89Á\82³\82ê\82½\8fê\8d\87\81ATrue\82ª\82©\82¦\82é
+function TAbon.AddToken(AString: string; Invisible: Boolean): Boolean;
+var
+ bufStringList : TStringList;
+ ngword: String;
+begin
+ Result := False;
+ if FileExists(GetNGwordpath) then begin
+ bufStringList := TStringList.Create;
+ try
+ bufStringList.LoadFromFile(GetNGwordpath);
+ if (Invisible) then begin
+ ngword := #9 + AString;
+ end else begin
+ ngword := AString;
+ end;
+ if (bufStringList.IndexOf(ngword) = -1) then begin
+ bufStringList.Add(ngword);
+ bufStringList.SaveToFile(GetNGwordpath);
+ Result := True;
+ end;
+ finally
+ bufStringList.Free;
+ end;
+ end;
+end;
end.
OSDN Git Service
