NGWordUnit.pas

   1 unit NGWordUnit;
   2
   3 interface
   4 uses
   5     Windows,Messages, ShellAPI, SysUtils, Classes,StdCtrls,StrUtils,
   6     GikoXMLDoc, GikoSystem, bmRegExp;
   7
   8 type
   9         //\83\8a\83X\83g\82Ì\95\\8e¦\83A\83C\83e\83\80\91I\91ð
  10         TGikoNGType = (gntAll, gntName, gntMail, gntDateId, gntBody);
  11
  12     {\
  13     NG\83\8f\81[\83h\83N\83\89\83X
  14     }
  15         TNGWord = class( TObject )
  16         private
  17         FRank : Integer;
  18         FNGType : TGikoNGType;
  19         FWord : String;
  20         public
  21         procedure ReadXMLElement(element :IXMLNode);
  22         function ToXMLString(): String;
  23         property Rank : Integer read FRank write FRank;
  24         property NGType : TGikoNGType read FNGType write FNGType;
  25         property Word :  String read FWord write FWord;
  26         end;
  27
  28     {\
  29     NG\83\8f\81[\83h\8fW\8d\87\83N\83\89\83X
  30     }
  31         TNGWords = class( TList )
  32         private
  33         FRank : Integer;
  34         FInvisible: Boolean;
  35         FAWKStr: TAWKStr;
  36         public
  37         constructor Create;
  38         procedure Free;
  39         property Rank : Integer read FRank write FRank;
  40         property Invisible : Boolean read FInvisible write FInvisible;
  41         function ReadXMLElement(element :IXMLNode): Boolean;
  42         function ToXMLString(): String;
  43         function ToString(): String;
  44         procedure Delete(word: TNGWord); overload;
  45         function IsNG(PRes : PResRec): Boolean;
  46         end;
  47
  48     {\
  49     NG\83\8f\81[\83h\8aÇ\97\9d\83N\83\89\83X
  50     }
  51     TNGWordList = class( TList )
  52     private
  53     public
  54         procedure Free;
  55         procedure LoadFromFile(fileName: String);
  56         procedure SaveToFrile(fileName: String);
  57         procedure Delte(NGWords: TNGWords); overload;
  58         function IsNG(PRes : PResRec): Integer;
  59     end;
  60
  61     function CompareRank(Item1, Item2: Pointer): Integer;
  62 var
  63         NGWordList: TNGWordList;
  64
  65 implementation
  66
  67 uses
  68     MojuUtils, Sort;
  69
  70 function CompareRank(Item1, Item2: Pointer): Integer;
  71 begin
  72     if TObject(item1) is TNGWords then begin
  73         Result := CompareInt(
  74             TNGWords(Item1).Rank, TNGWords(Item2).Rank);
  75     end else begin
  76         Result := CompareInt(
  77             TNGWord(Item1).Rank, TNGWord(Item2).Rank);
  78     end;
  79 end;
  80 constructor TNGWords.Create;
  81 begin
  82     FRank := 0;
  83     FAWKStr := TAWKStr.Create(nil);
  84 end;
  85 procedure TNGWords.Free;
  86 var
  87     i: Integer;
  88 begin
  89     for i := 0 to Count - 1 do begin
  90         TObject(Items[i]).Free;
  91     end;
  92     FAWKStr.Free;
  93     inherited Free;
  94 end;
  95 function TNGWords.ReadXMLElement(element :IXMLNode): Boolean;
  96 var
  97     i, bound : Integer;
  98     NGWordNode: IXMLNode;
  99     NG: TNGWord;
 100 begin
 101     Result := False;
 102     if element.NodeName = 'NGWords' then begin
 103         Rank := StrToIntDef(element.Attributes['rank'],
 104                 MaxInt);
 105         Invisible := StrToBoolDef(element.Attributes['invisible'],
 106                 False);
 107         bound := element.ChildNodes.Count - 1;
 108         for i := 0 to bound do begin
 109             NGWordNode := element.ChildNodes[i];
 110             if NGWordNode.NodeName = 'NGWord' then begin
 111                 NG := TNGWord.Create;
 112                 NG.ReadXMLElement( NGWordNode );
 113                 Add(NG);
 114             end;
 115         end;
 116         Sort(@CompareRank);
 117         Result := True;
 118     end;
 119 end;
 120 function TNGWords.ToXMLString(): String;
 121 var
 122     i: Integer;
 123 begin
 124     Result := '<NGWords ' +
 125         'rank="' + IntToStr(FRank) + '" ' +
 126         'invisible="' + BoolToStr(Invisible) + '" >'#13#10;
 127     for i := 0 to Count - 1 do begin
 128         Result := Result + TNGWord(Items[i]).ToXMLString + #13#10;
 129     end;
 130     Result := Result + '</NGWords>';
 131 end;
 132 function TNGWords.ToString(): String;
 133 var
 134     i: Integer;
 135 begin
 136     Result := '';
 137     for i := 0 to Count - 1 do begin
 138         Result := Result + TNGWord(Items[i]).Word + ' , ';
 139     end;
 140 end;
 141 procedure TNGWords.Delete(word: TNGWord);
 142 var
 143     i: Integer;
 144 begin
 145     for i := Count - 1 downto 0 do begin
 146         if ( Items[i] = word ) then begin
 147             TNGWord(Items[i]).Free;
 148             Self.Delete(i);
 149             break;
 150         end;
 151     end;
 152 end;
 153 function TNGWords.IsNG(PRes : PResRec): Boolean;
 154 var
 155     i, oLength: Integer;
 156     RStart, RLength: Integer;
 157     word: TNGWord;
 158 begin
 159     Result := True;
 160     for i := 0 to Count - 1 do begin
 161         word := TNGWord(Items[i]);
 162         FAWKStr.RegExp := word.Word;
 163         case Ord(word.FNGType) of
 164             Ord(gntAll):
 165             begin
 166                 Result := FAWKStr.Match(FAWKStr.ProcessEscSeq(PRes.FTitle),
 167                      RStart, RLength) <> 0;
 168                 if Result then break;
 169                 Result := FAWKStr.Match(FAWKStr.ProcessEscSeq(PRes.FMailTo),
 170                      RStart, RLength) <> 0;
 171                 if Result then break;
 172                 Result := FAWKStr.Match(FAWKStr.ProcessEscSeq(PRes.FName),
 173                      RStart, RLength) <> 0;
 174                 if Result then break;
 175                 Result := FAWKStr.Match(FAWKStr.ProcessEscSeq(PRes.FDateTime),
 176                      RStart, RLength) <> 0;
 177                 if Result then break;
 178                 Result := FAWKStr.Match(FAWKStr.ProcessEscSeq(PRes.FBody),
 179                      RStart, RLength) <> 0;
 180             end;
 181             Ord(gntName):
 182                 Result := FAWKStr.Match(FAWKStr.ProcessEscSeq(PRes.FName),
 183                      RStart, RLength) <> 0;
 184             Ord(gntMail):
 185                 Result := FAWKStr.Match(FAWKStr.ProcessEscSeq(PRes.FMailTo),
 186                      RStart, RLength) <> 0;
 187             Ord(gntDateId):
 188                 Result := FAWKStr.Match(FAWKStr.ProcessEscSeq(PRes.FDateTime),
 189                      RStart, RLength) <> 0;
 190             Ord(gntBody):
 191                 Result := FAWKStr.Match(FAWKStr.ProcessEscSeq(PRes.FBody),
 192                      RStart, RLength) <> 0;
 193         end;
 194         if not Result then Exit;
 195     end;
 196 end;
 197
 198
 199 procedure TNGWord.ReadXMLElement(element :IXMLNode);
 200 begin
 201     FRank := StrToIntDef(element.Attributes['rank'],
 202                   MaxInt);
 203     FNGType := TGikoNGType(StrToIntDef(
 204         Trim(element.Attributes['ngtype']),
 205         Integer(gntAll)));
 206
 207     FWord := Trim(element.Attributes['word']);
 208     if FWord <> '' then begin
 209       FWord := MojuUtils.UnSanitize( FWord );
 210     end;
 211 end;
 212
 213 function TNGWord.ToXMLString(): String;
 214 begin
 215     Result := '<NGWord ' +
 216         'rank="' + IntToStr(FRank) + '" ' +
 217         'ngtype="' + IntToStr(Integer(FNGType)) + '" ' +
 218         'word="' +  MojuUtils.Sanitize(FWord) + '" />';
 219 end;
 220
 221 procedure TNGWordList.Free;
 222 var
 223     i: Integer;
 224 begin
 225     for i := Self.Count - 1 downto 0 do begin
 226          TNGWords(Self.Items[i]).Free;
 227     end;
 228     inherited Free;
 229 end;
 230
 231 procedure TNGWordList.SaveToFrile(fileName: String);
 232 var
 233     xmlStrings: TStringList;
 234     i: Integer;
 235 begin
 236     xmlStrings := TStringList.Create;
 237     try
 238         xmlStrings.Add('<?xml version="1.0" encoding="Shift_JIS" standalone="yes"?>');
 239         xmlStrings.Add('<root>');
 240         for i := 0 to Self.Count - 1 do begin
 241             xmlStrings.Add(
 242                 TNGWords(Self.Items[i]).ToXMLString);
 243
 244         end;
 245         xmlStrings.Add('</root>');
 246         xmlStrings.SaveToFile(fileName);
 247     finally
 248         xmlStrings.Free;
 249     end;
 250 end;
 251
 252 procedure TNGWordList.LoadFromFile(fileName: String);
 253
 254 var
 255         i, bound                : Integer;
 256         XMLDoc                  : IXMLDocument;
 257         XMLNode: IXMLNode;
 258     NG : TNGWords;
 259 {$IFDEF DEBUG}
 260         st, rt : Cardinal;
 261 {$ENDIF}
 262 begin
 263 {$IFDEF DEBUG}
 264         st := GetTickCount;
 265 {$ENDIF}
 266         if FileExists( FileName ) then begin
 267         if (Self.Count > 0) then begin
 268             Self.Free;
 269             Self.Capacity := 0;
 270         end;
 271                 try
 272                         XMLDoc := IXMLDocument.Create;
 273                         //XMLDoc := LoadXMLDocument(FileName);
 274                         LoadXMLDocument(FileName, XMLDoc);
 275                         try
 276                                 XMLNode := XMLDoc.DocumentElement;
 277
 278                                 if XMLNode.NodeName = 'root' then begin
 279                                         bound := XMLNode.ChildNodes.Count - 1;
 280                                         for i := 0 to bound do begin
 281                         NG := TNGWords.Create;
 282                         if (NG.ReadXMLElement(XMLNode.ChildNodes[i])) then
 283                             Self.Add(NG);
 284                                         end;
 285                                 end;
 286                 Sort(@CompareRank);
 287                         finally
 288                                 XMLDoc.Free;
 289                         end;
 290                 except
 291                 end;
 292         end;
 293 {$IFDEF DEBUG}
 294         rt := GetTickCount - st;
 295         Writeln('Runtime(Load NGWords) : ' + IntToStr(rt) + ' ms');
 296 {$ENDIF}
 297 end;
 298 procedure TNGWordList.Delte(NGWords: TNGWords);
 299 var
 300     i: Integer;
 301 begin
 302     for i := Count - 1 downto 0 do begin
 303         if ( Items[i] = NGWords ) then begin
 304             TNGWords(Items[i]).Free;
 305             Self.Delete(i);
 306             break;
 307         end;
 308     end;
 309 end;
 310 //! NG\94»\92è
 311 function TNGWordList.IsNG(PRes : PResRec): Integer;
 312 var
 313     i: Integer;
 314     tRes : TResRec;
 315 begin
 316     Result := -1;
 317     if Count > 0 then begin
 318         for i := 0 to Count - 1 do begin
 319             if (TNGWords(Items[i]).IsNG(PRes)) then begin
 320                 Result := i;
 321                 break;
 322             end;
 323         end;
 324     end;
 325 end;
 326
 327 // \83V\83\93\83O\83\8b\83g\83\93\82Ì\83C\83\93\83X\83^\83\93\83X
 328 initialization
 329          NGWordList := TNGWordList.Create;
 330
 331 finalization
 332         if NGWordList <> nil then begin
 333                 NGWordList.Free;
 334                 NGWordList := nil;
 335         end;
 336
 337 end.