Develop and Download Open Source Software

Browse CVS Repository

Contents of /gikonavigoeson/gikonavi/NGWordUnit.pas

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


Revision 1.4 - (show annotations) (download) (as text)
Wed Feb 14 15:01:44 2007 UTC (17 years, 2 months ago) by h677
Branch: MAIN
CVS Tags: HEAD
Changes since 1.3: +0 -0 lines
File MIME type: text/x-pascal
FILE REMOVED
削除

1 unit NGWordUnit;
2
3 interface
4 uses
5 Windows,Messages, ShellAPI, SysUtils, Classes,StdCtrls,StrUtils,
6 GikoXMLDoc, GikoSystem, bmRegExp;
7
8 type
9 //???鴻????;腓冴?≪?ゃ?????御??
10 TGikoNGType = (gntAll, gntName, gntMail, gntDateId, gntBody);
11
12 {\
13 NG???若????????/span>
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???若????????????/span>
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???若??膊∞????????/span>
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?ゅ?
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 // ?激?潟?違?????潟???ゃ?潟?鴻?帥?潟??/span>
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.

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