Develop and Download Open Source Software

Browse CVS Repository

Contents of /gikonavigoeson/gikonavi/AbonUnit.pas

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


Revision 1.22 - (show annotations) (download) (as text)
Wed Mar 24 09:51:44 2004 UTC (20 years ago) by h677
Branch: MAIN
CVS Tags: b47
Branch point for: BRANCH_TORA
Changes since 1.21: +59 -1 lines
File MIME type: text/x-pascal
シリア語ブラクラ対策を入れてみた

1 unit AbonUnit;
2
3 interface
4 uses
5 Windows,Messages, ShellAPI, SysUtils, Classes,StdCtrls,StrUtils;
6
7 type
8 TIndiviAbon = record
9 Res: Integer;
10 option: Integer; // 0:?? 1:??絽吾???若?若??
11 end;
12
13 TAbon = class(TObject)
14 private
15 { Private 絎h? }
16 Froot : String;
17 Flistpath : String;
18 FNGwordpath : String;
19 Ftokens : array of array of string;
20 FAbonRes : array of TIndiviAbon;
21 FAbonString : String;
22 FCutoffNum : Integer; //?????遺札筝??g??????????怨???NG???若????????
23 FDeleterlo : Boolean; //&rlo;???????? //菴遵??&lro;??????
24 FReplaceul :Boolean ; //<ul>?帥?違??<br>?帥?違??舟????????
25 FReverse : Boolean ; //NG???若???с?????若?????????????荵≪????????
26 FAbonPopupRes : Boolean; //???鴻???????≪?????????????若?若????????
27 FCreateNGwordFile : Boolean; //??絎???????path??G???若??txt???<???c??????????????????????????
28 FNGwordFileIndex : Integer; //?上????粋昭???с??NG???若????list???茵?????
29 FNGwordname : String; //?上????粋昭???с??NG???若????;腓阪??
30 FIndividualFileName : String; //???ャ???若?????????<?ゃ????
31 FReturnNGwordLineNum : Boolean; //NG???若??????違??菴?????
32 FSetNGResAnchor : Boolean; //NG???綵????????????????????????鴻?吾?????鴻?≪?潟???若???ゃ????????????
33 FDeleteSyria: Boolean; //?激???∵??????????膈?鐚?&#1792~&#1871鐚?
34 procedure SetTokens(index: integer ; argline:String);
35 function Getlistpath() : String;
36 procedure Setlistpath(const Value : String);
37 function LoadListFile(path :String;listStringList : TStringList) : Boolean;
38 function ReadNGwordslist(line : Integer) : Boolean;
39 function LoadFromSetResNumFile(SetResNumFile : String) : Boolean;
40 public
41 { Public 絎h? }
42 constructor Create; // ?潟?潟?鴻????????/span>
43 destructor Destroy; override; // ???鴻????????/span>
44 property Deleterlo: Boolean read FDeleterlo write FDeleterlo default false;
45 property Replaceul: Boolean read FReplaceul write FReplaceul default false;
46 property Reverse: Boolean read FReverse write FReverse default false;
47 property CreateNGwordFile: Boolean read FCreateNGwordFile write FCreateNGwordFile;
48 property AbonString : String read FAbonString write FAbonString;
49 property AbonPopupRes : Boolean read FAbonPopupRes write FAbonPopupRes default false;
50 property listpath : String read Getlistpath write Setlistpath;
51 property NGwordFileIndex : Integer read FNGwordFileIndex write FNGwordFileIndex default 0;
52 property NGwordname : String read FNGwordname write FNGwordname;
53 property ReturnNGwordLineNum : Boolean read FReturnNGwordLineNum write FReturnNGwordLineNum default false;
54 property SetNGResAnchor : Boolean read FSetNGResAnchor write FSetNGResAnchor default false;
55 property DeleteSyria : Boolean read FDeleteSyria write FDeleteSyria default false;
56 procedure Setroot(root :String);
57 function Getroot() : String;
58
59 function Getfullpath(argpath : String) : String;
60 procedure SetNGwordpath(path :String);
61 function GetNGwordpath() : String;
62 function LoadFromNGwordFile(path :String) : Boolean;
63 function ReLoadFromNGwordFile() : Boolean;
64 procedure LoadFromStringList( bufstl : TStringList );
65 function CheckAbonPopupRes(line : String) :Boolean;
66 function FindNGwords(line : String) : Boolean; overload;//1???ゃ?潟???ょ????
67 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
70 //???若????????(NG???若???с?????c???帥???潟??
71 procedure Execute(var ThreadStrings : TStringList); overload;
72 procedure Execute(var ThreadStrings : TStringList; NGwords : TStringList); overload;
73 procedure Execute(var ThreadStrings : TStringList; NGwords : TStrings); overload;
74 procedure Execute(var ResString : String; ResNumber : Integer); overload; //筝祉??lugin??????at To HTML ??/span>
75 //???ャ???若??????????
76 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);
79 procedure DeleteIndividualAbon( ResNum : Integer);
80 function GetAbonResCount() : Integer;
81 function GetAbonResString(Num : Integer) : String;
82 function CheckIndividualAbonList(ResNum : Integer) : Boolean;
83 //--
84 function ExecuteFile(datfilepath : String; NGwordpath : String) : Boolean; overload;//DAT???<?ゃ?????眼????????
85 function ExecuteFile(datfilepath : String; resnum : Integer) : Boolean; overload; //DAT???<?ゃ?????眼????????
86 function ExecuteFile(datfilepath : String; firstres : Integer; count : Integer) : Boolean; overload; //DAT???<?ゃ?????眼????????
87 function ReverseExecuteFile(datfilepath : String) : Boolean; overload; //DAT???<?ゃ?????眼????????
88 function ReverseExecuteFile(datfilepath : String; resnum : Integer) : Boolean; overload; //DAT???<?ゃ?????眼????????
89 function ReverseExecuteFile(datfilepath : String; firstres : Integer; count : Integer) : Boolean; overload; //DAT???<?ゃ?????眼????????
90 //--
91 procedure EditNGwords(); //NGword.txt???????
92 function ShowAllTokens() : String; //???????亥??/span>
93 //--
94 procedure GoHome();//List???茵?????茯???
95 function GoForward() : Boolean; //List????ゆ???G???若?????<?ゃ????茯??粋昭??
96 function GoBack() : Boolean; //List????ゅ????G???若?????<?ゃ????茯??粋昭??
97 //--
98 function TreatSyria(AString: string): string;
99 end;
100 var
101 Abon1 :TAbon;
102 const
103 NGwordListFileName : String = 'NGwords.list';
104
105 implementation
106
107 uses MojuUtils;
108
109 constructor TAbon.Create;
110 begin
111 // ??????
112 FAbonString := '&nbsp;<>&nbsp;<>&nbsp;<>&nbsp;&nbsp;<><>';
113 FCreateNGwordFile := true;
114 SetLength(FAbonRes,1);
115 FAbonRes[0].Res := 0;
116 FAbonRes[0].option := -1;
117
118 end;
119
120 destructor TAbon.Destroy;
121 begin
122 inherited;
123 end;
124 //root??xe\config\NGwords????????
125 procedure TAbon.Setroot(root :String);
126 var
127 bufStringList : TStringList;
128 begin
129 bufStringList := TStringList.Create;
130 try
131 if not DirectoryExists(root) then begin
132 CreateDir(root);
133 end;
134 if root[Length(root)] <> '\' then begin
135 root := root + '\';
136 end;
137 Flistpath := root + NGwordListFileName;
138 LoadListFile(Flistpath, bufStringList);
139 finally
140 bufStringList.Free;
141 end;
142 Froot := root;
143 end;
144 function TAbon.Getroot() : String;
145 begin
146 Result := Froot;
147 end;
148 //NGwordpath??Gword.txt??????????/span>
149 procedure TAbon.SetNGwordpath(path :String);
150 begin
151 FNGwordpath := Getfullpath(path);
152 LoadFromNGwordFile(FNGwordpath);
153 end;
154 function TAbon.GetNGwordpath() : String;
155 begin
156 Result := FNGwordpath;
157 end;
158 //???????鴻?с???????違???????鴻???????????
159 function TAbon.Getfullpath(argpath : String) : String;
160 begin
161 if AnsiPos(':\',argpath) <> 2 then begin //?????ゃ???????????????鴻???<??????/span>
162 if Getroot() = '' then begin
163 Result := ''; //root???鴻??荐??????????????腥冴??????
164 end else begin
165 if (Froot[Length(Froot)] = '\') and (argpath[1] = '\') then begin //????????????/span>
166 Delete(argpath,1,1);
167 end;
168 Insert( Getroot(), argpath , 1);//root???鴻???水??/span>
169 Result := argpath;
170 end;
171 end else begin
172 Result := argpath;
173 end;
174
175 end;
176 //NGword???<?ゃ??????粋昭??/span>
177 function TAbon.LoadFromNGwordFile(path :String) : boolean;
178 var
179 bufstl : TStringList;
180 begin
181 path := Getfullpath(path);
182 if path = '' then begin
183 Result := false;
184 end else begin
185 bufstl := TStringList.Create;
186 try
187 try
188 bufstl.LoadFromFile(path);
189 LoadFromStringList( bufstl );
190 Result := true;
191 except
192 if CreateNGwordFile = true then begin
193 bufstl.SaveToFile(path);
194 end;
195 Result := false;
196 end;
197 finally
198 bufstl.Free;
199 end;
200 end;
201
202 end;
203 //NGword???鴻??茯??粋昭??/span>
204 procedure TAbon.LoadFromStringList( bufstl : TStringList );
205 var
206 i : integer;
207 begin
208 try
209 for i := bufstl.Count -1 downto 0 do begin
210 if bufstl.Strings[i] = '' then begin
211 bufstl.Delete(i);
212 end;
213 end;
214 SetLength(Ftokens,bufstl.Count);
215 for i := 0 to bufstl.Count -1 do begin
216 SetTokens(i , bufstl.Strings[i]);
217 end;
218
219 except
220 Exit;
221 end;
222 end;
223 //NGwordpath???≪??┃絎??????????????????????若?????∽??/span>
224 function TAbon.ReLoadFromNGwordFile() : boolean;
225 begin
226 if GetNGwordpath() ='' then begin
227 Result := false;
228 end else begin
229 Result := LoadFromNGwordFile( GetNGwordpath() );
230 end;
231 end;
232 function TAbon.Getlistpath() : String;
233 begin
234 Result := Flistpath;
235 end;
236 procedure TAbon.Setlistpath(const Value : String);
237 begin
238 Flistpath := Getfullpath(Value);
239 end;
240 //筝?茵???賢?????若???潟?????????????祉????
241 procedure TAbon.SetTokens(index: integer ; argline : String);
242 var
243 ret : Integer;
244 bufstl : TStringList;
245 i : Integer;
246 pos : Integer;
247 buftoken : String;
248 begin
249 pos := 0;
250 bufstl := TStringList.Create;
251 try
252 if Length(argline) > 0 then begin
253 pos := AnsiPos(#9,argline);
254 while pos <> 0 DO begin
255 buftoken := Copy(argline,1,pos-1);
256 Delete(argline,1,pos);
257 if Length(buftoken) > 0 then begin
258 bufstl.Append(buftoken);
259 end else if ( bufstl.Count = 0 ) then begin
260 bufstl.Append('');
261 end;
262 pos := AnsiPos(#9,argline);
263 end;
264 if Length(argline) > 0 then begin
265 bufstl.Append(argline);
266 end;
267 ret := bufstl.Count;
268 SetLength(Ftokens[index],ret);
269 for i := 0 to bufstl.Count - 1 do begin
270 Ftokens[index][i] := bufstl.Strings[i];
271 end;
272 end;
273 finally
274 bufstl.Free;
275 end;
276
277 end;
278 //Debug???<??????G???若?????障??????????
279 function TAbon.ShowAllTokens() : String;
280 var
281 i : Integer;
282 j : Integer;
283 ret : String;
284 begin
285 for i := 0 to High(Ftokens) do begin
286 for j := 0 to High(Ftokens[i]) do begin
287 ret := ret + Ftokens[i][j];
288 end;
289 end;
290 Result := ret;
291
292
293
294 end;
295
296 //****************************************************************************//
297 //NG???若???????障????????true??菴?????
298 function TAbon.FindNGwords(line : String) : Boolean;
299 var
300 lines : Integer;
301 cells : Integer;
302 hit : Boolean;
303 bufline : String;
304 begin
305 hit := false;
306 if AnsiPos(FAbonString,line) <> 1 then begin
307 for lines := 0 to High(Ftokens) do begin
308 hit := true;
309 bufline := line;
310 for cells := 0 to High(Ftokens[lines]) do begin
311 if AnsiPos(Ftokens[lines][cells],bufline) = 0 then begin
312 hit := false;
313 break;
314 end else begin
315 Delete(bufline,AnsiPos(Ftokens[lines][cells],bufline),Length(Ftokens[lines][cells]));
316 end;
317 end;
318 if hit = true then begin
319 break;
320 end;
321 end;
322 end;
323 Result := hit;
324 end;
325 //NG???若???????障??????????true??菴?????????G???若??????違??NGwordsLineNum???ャ???????
326 function TAbon.FindNGwords(line : String; var NGwordsLineNum : Integer) : Boolean;
327 var
328 lines : Integer;
329 cells : Integer;
330 hit : Boolean;
331 bufline : String;
332 begin
333 hit := false;
334 if AnsiPos(FAbonString,line) <> 1 then begin
335 for lines := 0 to High(Ftokens) do begin
336 hit := true;
337 bufline := line;
338 for cells := 0 to High(Ftokens[lines]) do begin
339 if AnsiPos(Ftokens[lines][cells],bufline) = 0 then begin
340 hit := false;
341 break;
342 end else begin
343 Delete(bufline,AnsiPos(Ftokens[lines][cells],bufline),Length(Ftokens[lines][cells]));
344 end;
345 end;
346 if hit = true then begin
347 NGwordsLineNum := lines + 1;
348 break;
349 end;
350 end;
351 end;
352 Result := hit;
353 end;
354 //NG???若???????障??????????true??菴?????????G???若??????違??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
395 function TAbon.Cutoff(line : String) : Boolean;
396 var
397 i : Integer;
398 sheed : AnsiChar;
399 buf : String;
400 ret : Bool;
401 begin
402 ret := false;
403 if FCutoffNum <> 0 then begin
404 for i := 65 to 90 do begin
405 sheed := Chr(i);
406 buf := DupeString(sheed, FCutoffNum);
407 if AnsiContainsText(line, buf) = true then begin
408 ret := true;
409 break;
410 end;
411 end;
412 end;
413 Result := ret;
414 end;
415 //??鮎?????若???ゃ??rue??????NG???若??????????????????菴?????
416 procedure TAbon.Execute(var ThreadStrings : TStringList);
417 var
418 i : Integer;
419 NGwordsLine : Integer;
420 bufline : String;
421 invisi : Boolean;
422 begin
423 for i:=0 to ThreadStrings.Count - 1 do begin
424 NGwordsLine := 0;
425 if FindNGwords(ThreadStrings.Strings[i], NGwordsLine ,invisi) <> Reverse then begin
426 if invisi = true then begin
427 ThreadStrings.Strings[i] := '';
428 end else begin
429 if not ReturnNGwordLineNum and not SetNGResAnchor then begin
430 ThreadStrings.Strings[i] := FAbonString;
431 end else if not ReturnNGwordLineNum then begin
432 ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<>&gt;%d<><>',[(i+1)]);
433 end else if not SetNGResAnchor then begin
434 ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 茵?????G???若???????障???????障????</B><><>',[NGwordsLine]);
435 end else begin
436 ThreadStrings.Strings[i] := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 茵?????G???若???????障???????障????</B>&gt;%d <><>',[NGwordsLine,(i+1)]);
437 end;
438 end;
439 end else begin
440 bufline := ThreadStrings.Strings[i];
441 if Deleterlo = true then begin
442 bufline := CustomStringReplace(bufline,'&rlo;','');
443 bufline := CustomStringReplace(bufline,'&lro;','');
444 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 茵?????G???若???????障???????障????</B><><>',[NGwordsLine]);
472 end else begin
473 ResString := Format('&nbsp;<>&nbsp;<>&nbsp;<><B> %d 茵?????G???若???????障???????障????</B>&gt;%d <><>',[NGwordsLine,(ResNumber)]);
474 end;
475 end;
476 end else begin
477 bufline := ResString;
478 if Deleterlo = true then begin
479 bufline := CustomStringReplace( bufline,'&rlo;','' );
480 bufline := CustomStringReplace( bufline,'&lro;','' );
481 end;
482 if Replaceul = true then begin
483 bufline := CustomStringReplace( bufline,'<ul>','<br>' );
484 bufline := CustomStringReplace( bufline,'</ul>','<br>' );
485 end;
486 if DeleteSyria = true then
487 bufline := TreatSyria(bufline);
488 ResString := bufline;
489 end;
490 end;
491
492 procedure TAbon.Execute(var ThreadStrings : TStringList; NGwords : TStringList);
493 var
494 i : Integer;
495 begin
496 SetLength(Ftokens,NGwords.Count);
497 for i := 0 to NGwords.Count -1 do begin
498 SetTokens(i , NGwords.Strings[i]);
499 end;
500 Execute(ThreadStrings);
501
502 end;
503 procedure TAbon.Execute(var ThreadStrings : TStringList; NGwords : TStrings);
504 var
505 i : Integer;
506 buf : TStringList;
507 begin
508 buf := TStringList.Create;
509 buf.AddStrings(NGwords);
510 SetLength(Ftokens,buf.Count);
511 for i := 0 to buf.Count -1 do begin
512 SetTokens(i , buf.Strings[i]);
513 end;
514 Execute(ThreadStrings);
515 buf.Free;
516 end;
517
518
519 //****************************************************************************//
520 //DAT???眼????????絅眼??===========================================================
521 //NG???若???????????鴻???????????若?若?????水??/span>
522 function TAbon.ExecuteFile(datfilepath : String; NGwordpath : String) : Boolean; //DAT???<?ゃ?????眼????????
523 var
524 datstl : TStringList;
525 ret : Boolean;
526 i : Integer;
527 begin
528 datstl := TStringList.Create;
529 ret := true;
530 try
531 try
532 datstl.LoadFromFile(datfilepath);
533 for i := 0 to datstl.Count -1 do begin
534 if FindNGwords(datstl.Strings[i]) = true then begin
535 datstl.Strings[i] := FAbonString + datstl.Strings[i]
536 end;
537 end;
538
539 datstl.SaveToFile(datfilepath);
540 except
541 ret := false;
542 end;
543 finally
544 datstl.Free;
545 end;
546 Result := ret;
547
548 end;
549 //??絎??????????合?????????????若?若???水??/span>
550 function TAbon.ExecuteFile(datfilepath : String; resnum : Integer) : Boolean; //DAT???<?ゃ?????眼????????
551 var
552 datstl : TStringList;
553 ret : Boolean;
554 begin
555 ret := true;
556 datstl := TStringList.Create;
557 try
558 try
559 datstl.LoadFromFile(datfilepath);
560 if (resnum > 0) and (resnum <= datstl.Count) then begin
561 if AnsiPos(FAbonString, datstl.Strings[resnum-1]) <> 1 then begin
562 datstl.Strings[resnum-1] := FAbonString + datstl.Strings[resnum-1];
563 end;
564 end;
565 datstl.SaveToFile(datfilepath);
566 except
567 ret := false;
568 end;
569 finally
570 datstl.Free;
571 end;
572 Result := ret;
573 end;
574 //firstres????count???????鴻???????????若?若???水??/span>
575 function TAbon.ExecuteFile(datfilepath : String; firstres : Integer; count : Integer) : Boolean; //DAT???<?ゃ?????眼????????
576 var
577 datstl : TStringList;
578 i : Integer;
579 endnum : Integer; //腟?????????合??/span>
580 ret : Boolean;
581 begin
582 ret := true;
583 datstl := TStringList.Create;
584 try
585 try
586 datstl.LoadFromFile(datfilepath);
587 if (firstres > 0) and (firstres <= datstl.Count) then begin
588 if firstres + count -1 > datstl.Count then begin
589 endnum := datstl.Count;
590 end else if count <= 0 then begin
591 endnum := firstres + 1;
592 end else begin
593 endnum := firstres + count -1;
594 end;
595
596 for i := firstres to endnum do begin
597 if AnsiPos(FAbonString, datstl.Strings[i-1]) <> 1 then begin
598 datstl.Strings[i-1] := FAbonString + datstl.Strings[i-1];
599 end;
600 end;
601 end;
602 datstl.SaveToFile(datfilepath);
603 except
604 ret := false;
605 end;
606 finally
607 datstl.Free;
608 end;
609 Result := ret;
610 end;
611 //DAT???眼????????絅眼??==========?????障??========================================
612
613 //?????祉??絅眼??==================================================================
614 function TAbon.ReverseExecuteFile(datfilepath : String) : Boolean; //DAT???<?ゃ?????眼????????
615 var
616 datstl : TStringList;
617 i : Integer;
618 buf : String;
619 ret : Boolean;
620 begin
621 ret := true;
622 datstl := TStringList.Create;
623 try
624 try
625 datstl.LoadFromFile(datfilepath);
626 for i:=0 to datstl.Count -1 do begin
627 if AnsiPos(FAbonString, datstl.Strings[i]) = 1 then begin
628 buf := datstl.Strings[i];
629 Delete(buf,1,Length(FAbonString));
630 datstl.Strings[i] := buf;
631 end;
632 end;
633 datstl.SaveToFile(datfilepath);
634 except
635 ret := false;
636 end;
637 finally
638 datstl.Free;
639 end;
640 Result := ret;
641
642 end;
643 function TAbon.ReverseExecuteFile(datfilepath : String; resnum : Integer) : Boolean; //DAT???<?ゃ?????眼????????
644 var
645 datstl : TStringList;
646 buf : String;
647 ret : Boolean;
648 begin
649 ret := true;
650 datstl := TStringList.Create;
651 try
652 try
653 datstl.LoadFromFile(datfilepath);
654 if (resnum > 0) and (resnum <= datstl.Count) then begin
655 if AnsiPos(FAbonString, datstl.Strings[resnum-1]) = 1 then begin
656 buf := datstl.Strings[resnum-1];
657 Delete(buf,1,Length(FAbonString));
658 datstl.Strings[resnum-1] := buf;
659 end;
660 end;
661 datstl.SaveToFile(datfilepath);
662 except
663 ret := false;
664 end;
665 finally
666 datstl.Free;
667 end;
668 Result := ret;
669
670 end;
671 function TAbon.ReverseExecuteFile(datfilepath : String; firstres : Integer; count : Integer) : Boolean;//DAT???<?ゃ?????眼????????
672 var
673 datstl : TStringList;
674 i : Integer;
675 endnum : Integer; //腟?????????合??/span>
676 buf : String;
677 ret : Boolean;
678 begin
679 ret := true;
680 datstl := TStringList.Create;
681 try
682 try
683 datstl.LoadFromFile(datfilepath);
684 if (firstres > 0) and (firstres <= datstl.Count) then begin
685 if firstres + count -1 > datstl.Count then begin
686 endnum := datstl.Count;
687 end else if count <= 0 then begin
688 endnum := firstres + 1;
689 end else begin
690 endnum := firstres + count -1;
691 end;
692 for i := firstres to endnum do begin
693 if AnsiPos(FAbonString, datstl.Strings[i-1]) = 1 then begin
694 buf := datstl.Strings[i-1];
695 Delete(buf,1,Length(FAbonString));
696 datstl.Strings[i-1] := buf;
697 end;
698 end;
699 end;
700 datstl.SaveToFile(datfilepath);
701 except
702 ret := false;
703 end;
704 finally
705 datstl.Free;
706 end;
707 Result := ret;
708 end;
709 //?????祉??絅眼??=================?????障??========================================
710 //?上???祉??????????????NGword.txt??????span>
711 procedure TAbon.EditNGwords();
712 begin
713 ShellExecute(0 ,nil,PChar(FNGwordpath),nil,nil,SW_SHOW);
714 end;
715 //???????≪???????ゅ??∽??/span>
716 function TAbon.CheckAbonPopupRes(line : String) :Boolean;
717 begin
718 if AbonPopupRes = true then begin
719 Result := FindNGwords(line);
720 end else begin
721 Result := false;
722 end;
723 end;
724 //茲??違??G???若???????鴻????茯??粋昭??==============================================
725 //List???<?ゃ????茯??粋昭??
726 function TAbon.LoadListFile(path :String; listStringList : TStringList) : Boolean;
727 begin
728 try
729 listStringList.LoadFromFile(path);
730 Result := true;
731 except
732 listStringList.Append('筝???NGword.txt');
733 listStringList.SaveToFile(path);
734 Result := false;
735 end;
736 end;
737 //List????ゆ???G???若?????<?ゃ????茯??粋昭??
738 function TAbon.GoForward() : Boolean;
739 begin
740 FNGwordFileIndex := FNGwordFileIndex + 1;
741 Result := ReadNGwordslist(FNGwordFileIndex);
742 end;
743 //List????ゅ????G???若?????<?ゃ????茯??粋昭??
744 function TAbon.GoBack() : Boolean;
745 begin
746 FNGwordFileIndex := FNGwordFileIndex -1;
747 Result := ReadNGwordslist(FNGwordFileIndex);
748 end;
749 //List???茵?????茯???
750 procedure TAbon.GoHome();
751 begin
752 FNGwordFileIndex := 0;
753 ReadNGwordslist(FNGwordFileIndex);
754 end;
755 //List??ine茵?????茯???
756 function TAbon.ReadNGwordslist(line : Integer) : Boolean;
757 var
758 liststl : TStringList;
759 linebuf : String;
760 begin
761 liststl := TStringList.Create;
762 try
763 if LoadListFile(Flistpath,liststl) = true then begin
764 if line < 0 then begin
765 line := liststl.Count - 1;
766 FNGwordFileIndex := liststl.Count - 1;
767 end else if line > liststl.Count - 1 then begin
768 line := 0;
769 FNGwordFileIndex := 0;
770 end;
771 linebuf := liststl.Strings[line];
772 FNGwordname := Copy(linebuf,1,AnsiPos('=',linebuf)-1);
773 Delete(linebuf,1,AnsiPos('=',linebuf));
774 SetNGwordpath(linebuf);
775 Result := true;
776 end else begin
777 Result := false;
778 end
779 finally
780 liststl.Free;
781 end;
782
783 end;
784 //茲??違??G???若???????鴻????茯??粋昭??=====?????障??================================
785 //???ャ???若????絎?茵??∽??/span>
786 procedure TAbon.IndividualAbon(var ThreadStrings : TStringList; SetResNumFile : String);
787 var
788 i : Integer;
789 begin
790 if FileExists(SetResNumFile) = true then begin
791 if LoadFromSetResNumFile(SetResNumFile) = true then begin
792 for i := 0 to High(FAbonRes) do begin
793 if (FAbonRes[i].Res <= ThreadStrings.Count) and (FAbonRes[i].Res > 0) then begin
794 if FAbonRes[i].option = 0 then begin
795 ThreadStrings.Strings[FAbonRes[i].Res-1] := '';
796 end else begin
797 ThreadStrings.Strings[FAbonRes[i].Res-1] := '???若????<>???若????<>???若????<>???若????<>';
798 end;
799 end;
800
801 end;
802 end;
803 end else begin
804 FIndividualFileName := SetResNumFile;
805 SetLength(FAbonRes,1);
806 FAbonRes[0].Res := 0;
807 FAbonRes[0].option := -1;
808 end;
809 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 //???ャ???若???????<?ゃ????粋昭?翠?∽??/span>
836 function TAbon.LoadFromSetResNumFile(SetResNumFile : String) : Boolean;
837 var
838 bufStringList : TStringList;
839 bufLine : String;
840 i : Integer;
841 begin
842 bufStringList := TStringList.Create;
843 try
844 try
845 bufStringList.LoadFromFile(SetResNumFile);
846 FIndividualFileName := SetResNumFile;
847 //腥肴?????/span>
848 for i := bufStringList.Count-1 downto 0 do begin
849 if bufStringList.Strings[i] = '' then begin
850 bufStringList.Delete(i);
851 end;
852 end;
853
854 //?<?≪??∈篆?
855 SetLength(FAbonRes,bufStringList.Count);
856 //篁e??/span>
857 for i :=0 to bufStringList.Count - 1 do begin
858 bufLine := Trim(bufStringList.Strings[i]);
859 FAbonRes[i].Res := StrToInt(Copy(bufLine,1,AnsiPos('-',bufLine)-1));
860 FAbonRes[i].option := StrToInt(Copy(bufLine,AnsiPos('-',bufLine)+1,1));
861 end;
862 except
863 Result := false;
864 Exit;
865 end;
866 finally
867 bufStringList.Free;
868 end;
869 Result := true;
870 end;
871 //???ャ???若???????<?ゃ????申??
872 procedure TAbon.AddIndividualAbon( ResNum : Integer ; option : Integer);
873 var
874 IndividualFile : TStringList;
875 linebuf : String;
876 i : Integer;
877 begin
878 IndividualFile := TStringList.Create;
879 if FAbonRes[0].Res <> 0 then begin
880 for i := 0 to High(FAbonRes) do begin
881 if FAbonRes[i].Res <> ResNum then begin
882 linebuf := IntToStr(FAbonRes[i].Res) + '-' + IntToStr(FabonRes[i].option);
883 IndividualFile.Append(linebuf);
884 end;
885 end;
886 end;
887 linebuf := IntToStr(ResNum) + '-' + IntToStr(option);
888 IndividualFile.Append(linebuf);
889 try
890 IndividualFile.SaveToFile(FIndividualFileName);
891 finally
892 IndividualFile.Free;
893 end;
894 end;
895 //???ャ???若???????<?ゃ??????????/span>
896 procedure TAbon.DeleteIndividualAbon( ResNum : Integer);
897 var
898 IndividualFile : TStringList;
899 linebuf : String;
900 i : Integer;
901 begin
902 IndividualFile := TStringList.Create;
903 if FAbonRes[0].Res <> 0 then begin
904 for i := 0 to High(FAbonRes) do begin
905 if FAbonRes[i].Res <> ResNum then begin
906 linebuf := IntToStr(FAbonRes[i].Res) + '-' + IntToStr(FabonRes[i].option);
907 IndividualFile.Append(linebuf);
908 end;
909 end;
910 end;
911 if IndividualFile.Count <> 0 then begin
912 try
913 IndividualFile.SaveToFile(FIndividualFileName);
914 finally
915 IndividualFile.Free;
916 end;
917 end else begin
918 if FileExists(FIndividualFileName) = true then begin
919 DeleteFile(FIndividualFileName);
920 end;
921 end;
922 end;
923 //???ャ???若?????????鴻???????違??菴???
924 function TAbon.GetAbonResCount() : Integer;
925 var
926 i : Integer;
927 begin
928 if FAbonRes[0].Res = 0 then begin
929 Result := 0
930 end else begin
931 i := High(FAbonRes);
932 Result := i+1;
933 end;
934 end;
935 //???ャ???若?????????鴻?????茵????????鴻????絖????ц???
936 function TAbon.GetAbonResString(Num : Integer) : String;
937 begin
938 if (Num <= High(FAbonRes)) and (Num >= 0) then begin
939 Result := IntToStr(FAbonRes[Num].Res);
940 end else begin
941 Result := '';
942 end;
943 end;
944 //???????≪???????ゅ???/span>
945 function TAbon.CheckIndividualAbonList(ResNum : Integer) : Boolean;
946 var
947 i : Integer;
948 begin
949 if FAbonRes[0].Res <> 0 then begin
950 for i := 0 to High(FAbonRes) do begin
951 if FAbonRes[i].Res = ResNum then begin
952 Result := true;
953 Exit;
954 end;
955 end;
956 end;
957 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;
1010 end.
1011

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