OSDN -- Develop and Download Open Source Software
  • R/O
  • HTTP
  • SSH
  • HTTPS
Fork

gikonavi: Commit


Commit MetaInfo

Revision7edfa0f09b28c926f42ddf9402cddcf6a8f2501d (tree)
Time2015-01-07 20:52:19
Authorzako <zako@user...>
Commiterzako

Log Message

NGワードで特定の正規表現を使用するとフリーズする不具合を修正

Change Summary

Incremental Difference

--- a/bmRegExp/Readme.txt
+++ b/bmRegExp/Readme.txt
@@ -1,11 +1,8 @@
11 正規表現文字列操作ライブラリについて
22
3-このフォルダのソースコードは添付していません。
4-以下のところからダウンロードする必要があります。
3+ギコナビでは下記ページで公開されている REXP017.LZH を修正して使用しています。
54
65 http://homepage1.nifty.com/bmonkey/delphi/delphi.html
76
87
9-ギコナビでは REXP017.LZH を使用しています。
10-
118 非常に便利なライブラリを公開していらっしゃる峯島雄治さんに感謝感激！
--- /dev/null
+++ b/bmRegExp/bmregexp.pas
@@ -0,0 +1,4142 @@
1+unit bmRegExp;
2+{******************************************************************************
3+タイトル ：正規表現を使った文字列探索/操作コンポーネント集ver0.17
4+ユニット名 ：bmRegExp.pas
5+バージョン ：version 0.17
6+日付 ：2001/09/15
7+動作確認環境 ： Windows 98 + Borland Delphi6 Japanese Personal edition
8+作者 ： 峯島 bmonkey 雄治 ggb01164@nifty.ne.jp
9+変更履歴 ： 0.17 バグ修正 2001/09/15
10+ ： ・MP3の魔術師さんに教えて頂いたメモリリークの修正を適用。
11+ ： ・おかぽんさんに教えて頂いたメモリリークの修正を適用。
12+ ： 詳細は同梱のchangelog.htmlを参照。
13+ ： 0.16 第二次 一般公開 1998/03/07
14+ ： version 0.15 -> version 0.16
15+ ： ・TGrepで英大文字/小文字が正しく検索できなかったバグを修正。
16+ ： ・漢字のキャラクタクラス指定([亜-熙]など)のバグを修正。
17+ ： ・Delphi3, C++Builder1に対応
18+ ： ・ユニットファイル名をRegExp.pasからbmRegExp.pasに変更
19+ ： ・コンパイラの厳しくなった型チェックに対応
20+ ： ・MBUtils.pasを使わないように変更。
21+ ： 0.15B バグ修正、Delphi3、C++Builder1対応
22+ ： 0.15 一般公開
23+主要クラス ： TGrep, TAWKStr
24+継承関係 ： TObject
25+
26+*******************************************************************************
27+使用方法 ：ヘルプファイルとサンプルプロジェクトを参照のこと
28+補足説明 ：
29+
30+定義型 ：
31+
32+******************************************************************************}
33+
34+interface
35+
36+uses
37+ SysUtils, Classes, Windows, Forms
38+{$IFDEF DEBUG}
39+ ,OutLine
40+{$ENDIF}
41+ ;
42+
43+type
44+{ -========================== 例外クラス =====================================-}
45+{TREParser が出す例外。
46+ ErrorPos によって、正規表現文字列の何文字目で例外が発生したかを示す。}
47+ ERegExpParser = class(Exception)
48+ public
49+ ErrorPos: Integer;
50+ constructor Create(const Msg: string; ErrorPosition: Word);
51+ end;
52+{-============================= ====================-}
53+{ ２バイト文字型}
54+ WChar_t = Word;
55+
56+{ ２バイト文字型へのポインタ型}
57+ PWChar_t = ^WChar_t;
58+
59+{ WChar_t型 ２つぶんの型}
60+ DoubleWChar_t = Integer;
61+
62+{ -====================== 文字列操作関数 =====================================-}
63+ {説明 ： １６進数を表す文字を受け取り、整数にして返す。
64+ 引数 ： WCh: WChar_t; 16進数を表す1バイト文字 [0-9a-fA-F]
65+
66+ 返り値： 正常時： 0 <= result <= 15
67+ 異常時： -1}
68+ function HexWCharToInt(WCh: WChar_t): Integer;
69+
70+ {説明 ： ８進数を表す文字を受け取り、整数にして返す。
71+ 引数 ： WCh: WChar_t; 8進数を表す1バイト文字 [0-7]
72+
73+ 返り値： 正常時： 0 <= result <= 7
74+ 異常時： -1}
75+ function OctWCharToInt(WCh: WChar_t): Integer;
76+
77+ {説明 ： 16進数表記の文字列をWord型の数値に変換する。
78+ 引数 ： Str: String 変換元の文字列
79+ Index: Integer 引数StrのIndex番目のバイト位置から変換を始める。
80+ 副作用： 処理したバイト数だけIndexがインクリメントされる。
81+ 返り値： 文字列が表すWord型の値}
82+ function HexStrToInt(const Str: String; var Index: Integer): Word;
83+
84+ {説明 ： ８進数表記の文字列をWord型の数値に変換する。
85+ 引数 ： Str: String 変換元の文字列
86+ Index: Integer 引数StrのIndex番目のバイト位置から変換を始める。
87+ 副作用： 処理したバイト数だけIndexがインクリメントされる。
88+ 返り値： 文字列が表すWord型の値}
89+ function OctStrToInt(const Str: String; var Index: Integer): Word;
90+
91+ {説明 ： 引数Strから１文字読み出す。
92+ 動作 ： 引数Str の中の引数Index番目のバイト位置から１文字得て、Indexを増やす。
93+ 引数 ： Str: String; ２バイト文字コードを含んだString
94+ Index: Integer; 文字を読み出す位置の先頭からのバイト数
95+ 返り値： 読み出した WChar_t型の値
96+ 副作用：
97+ 注意 ： Indexが文字列の長さよりすでに長い場合は常に WChType.Nullを返し、Indexを増やさない。
98+ つまり、Indexは最大でも Length(Str)+1 である。}
99+ function GetWChar(const Str: String;var Index: Integer): WChar_t;
100+
101+ {機能： GetWCharメソッドによって進んだ Indexを１文字分戻す(1〜２バイト)
102+ 注意： ヌル・キャラクタ(GetWCharの返り値 WChType.Null)を戻すことはできない。}
103+ procedure UnGetWChar(const Str: String; var Index: Integer);
104+
105+
106+ {機能： GetWCharのPChar型バージョン}
107+ function PCharGetWChar(var pText: PChar): WChar_t;
108+
109+ {機能： WChar_t型の値をString型へ変換する。}
110+ function WCharToStr(WCh: WChar_t): String;
111+
112+ {機能： '\' で 引用されたキャラクタを得る。 \n, \t \\ ...
113+ 注意： Indexは'\'の次の文字を指しているとする。}
114+ function GetQuotedWChar(const Str: String; var Index: Integer): WChar_t;
115+
116+
117+ {説明 ： FS:WChar_tを区切り文字として、バイト位置Indexから始まるトークンを１つ返す。
118+ 引数 ： Str: String
119+ Index: Integer 引数StrのIndex番目のバイト位置から変換を始める。
120+ 返り値： FSで区切られた、バイト位置Indexから始まるトークン}
121+ function WCharGetToken(const Str: String; var Index: Integer; FS: WChar_t): String;
122+
123+
124+ {説明 ： 引数Str中のメタキャラクタに'\'をつける。
125+ 引数 ： Str: String
126+ 返り値： メタキャラクタの前に'\'がついたStr}
127+ function QuoteMetaWChar(Str: String): String;
128+
129+const
130+ CONST_DOLLAR = $24; // '$'
131+ CONST_LPAR = $28; // '('
132+ CONST_RPAR = $29; // ')'
133+ CONST_STAR = $2A; // '*'
134+ CONST_PLUS = $2B; // '+'
135+ CONST_DOT = $2E; // '.'
136+ CONST_QMARK = $3F; // '?'
137+ CONST_VL = $7C; // '|'
138+
139+ CONST_LBRA = $5B; // '['
140+ CONST_RBRA = $5D; // ']'
141+ CONST_CARET = $5E; // '^'
142+ CONST_YEN = $5C; // '\'
143+ CONST_MINUS = $2D; // '-'
144+
145+ CONST_b = $62; // 'b'
146+ CONST_r = $72; // 'r'
147+ CONST_n = $6E; // 'n'
148+ CONST_t = $74; // 't'
149+ CONST_x = $78; // 'x'
150+
151+ CONST_BS = $08; // BackSpace
152+ CONST_CR = $0D; // Carriage Return
153+ CONST_LF = $0A; // Line Feed
154+ CONST_TAB = $09; // TAB
155+
156+ CONST_ANP = $26; // '&'
157+
158+ CONST_NULL = $0000;
159+
160+ METACHARS: Array[0..11] of WChar_t = (CONST_CARET,
161+ CONST_LPAR,
162+ CONST_VL,
163+ CONST_RPAR,
164+ CONST_PLUS,
165+ CONST_STAR,
166+ CONST_QMARK,
167+ CONST_DOT,
168+ CONST_LBRA,
169+ CONST_RBRA,
170+ CONST_DOLLAR,
171+ CONST_YEN);
172+
173+ CONST_EMPTY = $FFFF; {TNFA, TDFA状態表で「文字がない」ことを表すコードとして使う}
174+ CONST_LINEHEAD = $FFFD; {文頭メタキャラクタ'^'を表す文字コードとして使う。}
175+ CONST_LINETAIL = $FFFE; {文尾メタキャラクタ'$'を表す文字コードとして使う。}
176+
177+ REFuzzyWChars: array [0..144] of String =
178+ ('Ａ,ａ,A,a',
179+ 'Ｂ,ｂ,B,b',
180+ 'Ｃ,ｃ,C,c',
181+ 'Ｄ,ｄ,D,d',
182+ 'Ｅ,ｅ,E,e',
183+ 'Ｆ,ｆ,F,f',
184+ 'Ｇ,ｇ,G,g',
185+ 'Ｈ,ｈ,H,h',
186+ 'Ｉ,ｉ,I,i',
187+ 'Ｊ,ｊ,J,j',
188+ 'Ｋ,ｋ,K,k',
189+ 'Ｌ,ｌ,L,l',
190+ 'Ｍ,ｍ,M,m',
191+ 'Ｎ,ｎ,N,n',
192+ 'Ｏ,ｏ,O,o',
193+ 'Ｐ,ｐ,P,p',
194+ 'Ｑ,ｑ,Q,q',
195+ 'Ｒ,ｒ,R,r',
196+ 'Ｓ,ｓ,S,s',
197+ 'Ｔ,ｔ,T,t',
198+ 'Ｕ,ｕ,U,u',
199+ 'Ｖ,ｖ,V,v',
200+ 'Ｗ,ｗ,W,w',
201+ 'Ｘ,ｘ,X,x',
202+ 'Ｙ,ｙ,Y,y',
203+ 'Ｚ,ｚ,Z,z',
204+ '0,０,零',
205+ '1,１,一,?,?,壱',
206+ '2,２,二,?,?,弐',
207+ '3,３,三,?,?,参',
208+ '4,４,四,?,?',
209+ '5,５,五,?,?,伍',
210+ '6,６,六,?,?',
211+ '7,７,七,?,?',
212+ '8,８,八,?,?',
213+ '9,９,九,?,?',
214+ '"　"," "',
215+ '!,！',
216+ '"""",”',
217+ '#,＃',
218+ '$,＄',
219+ '%,％',
220+ '&,＆',
221+ ''',’',
222+ '(,（',
223+ '),）',
224+ '*,＊',
225+ '+,＋',
226+ 'ー,〜,ｰ,', { 長音記号は、''ヌルとも一致させる}
227+ '-,ー,−,〜,ｰ',
228+ '･,・',
229+ '/,／',
230+ ':,：',
231+ ';,；',
232+ '<,＜',
233+ '=,＝',
234+ '>,＞',
235+ '?,？',
236+ '@,＠',
237+ '[,［,〔',
238+ '\,￥',
239+ '],］,〕',
240+ '^,＾',
241+ '_,＿',
242+ '{,｛',
243+ '|,｜',
244+ '},｝',
245+ '~,￣',
246+ '",",､,、,，',
247+ '｡,.,。,．',
248+ '「,『,｢',
249+ '」,』,｣',
250+ 'ん,ン,ﾝ',
251+ 'が,ガ,ｶﾞ,か゛,カ゛',
252+ 'ぎ,ギ,ｷﾞ,き゛,キ゛',
253+ 'ぐ,グ,ｸﾞ,く゛,ク゛',
254+ 'げ,ゲ,ｹﾞ,け゛,ケ゛',
255+ 'ご,ゴ,ｺﾞ,こ゛,コ゛',
256+ 'ざ,ザ,ｻﾞ,さ゛,サ゛',
257+ 'じ,ジ,ｼﾞ,し゛,シ゛,ぢ,ヂ,ﾁﾞ,ち゛,チ゛',
258+ 'ず,ズ,ｽﾞ,ス゛,ス゛,づ,ヅ,ﾂﾞ,つ゛,ツ゛',
259+ 'ぜ,ゼ,ｾﾞ,せ゛,セ゛',
260+ 'ぞ,ゾ,ｿﾞ,そ゛,ソ゛',
261+ 'だ,ダ,ﾀﾞ,た゛,タ゛',
262+ 'で,デ,ﾃﾞ,て゛,テ゛',
263+ 'ど,ド,ﾄﾞ,と゛,ト゛',
264+ 'ば,バ,ﾊﾞ,は゛,ハ゛,ヴァ,う゛ぁ,ウ゛ァ,ｳﾞｧ',
265+ 'び,ビ,ﾋﾞ,ひ゛,ヒ゛,ヴィ,う゛ぃ,ウ゛ィ,ｳﾞｨ',
266+ 'ぶ,ブ,ﾌﾞ,ふ゛,フ゛,ヴ,ウ゛,う゛,ｳﾞ',
267+ 'べ,ベ,ﾍﾞ,へ゛,ヘ゛,ヴェ,う゛ぇ,ウ゛ェ,ｳﾞｪ',
268+ 'ぼ,ボ,ﾎﾞ,ほ゛,ホ゛,ヴォ,う゛ぉ,ウ゛ォ,ｳﾞｫ',
269+ 'ぱ,パ,ﾊﾟ,は゜,ハ゜',
270+ 'ぴ,ピ,ﾋﾟ,ひ゜,ヒ゜',
271+ 'ぷ,プ,ﾌﾟ,ふ゜,フ゜',
272+ 'ぺ,ペ,ﾍﾟ,へ゜,ヘ゜',
273+ 'ぽ,ポ,ﾎﾟ,ほ゜,ホ゜',
274+ 'あ,ア,ｱ,ぁ,ァ,ｧ',
275+ 'い,イ,ｲ,ぃ,ィ,ｨ',
276+ 'う,ウ,ｳ,ぅ,ゥ,ｩ',
277+ 'え,エ,ｴ,ぇ,ェ,ｪ',
278+ 'お,オ,ｵ,ぉ,ォ,ｫ',
279+ 'か,カ,ｶ',
280+ 'き,キ,ｷ',
281+ 'く,ク,ｸ',
282+ 'け,ケ,ｹ',
283+ 'こ,コ,ｺ',
284+ 'さ,サ,ｻ',
285+ 'し,シ,ｼ',
286+ 'す,ス,ｽ',
287+ 'せ,セ,ｾ',
288+ 'そ,ソ,ｿ',
289+ 'た,タ,ﾀ',
290+ 'ち,チ,ﾁ',
291+ 'つ,ツ,ﾂ,っ,ッ,ｯ',
292+ 'て,テ,ﾃ',
293+ 'と,ト,ﾄ',
294+ 'な,ナ,ﾅ',
295+ 'に,ニ,ﾆ',
296+ 'ぬ,ヌ,ﾇ',
297+ 'ね,ネ,ﾈ',
298+ 'の,ノ,ﾉ',
299+ 'は,ハ,ﾊ',
300+ 'ひ,ヒ,ﾋ',
301+ 'ふ,フ,ﾌ',
302+ 'へ,ヘ,ﾍ',
303+ 'ほ,ホ,ﾎ',
304+ 'ま,マ,ﾏ',
305+ 'み,ミ,ﾐ',
306+ 'む,ム,ﾑ',
307+ 'め,メ,ﾒ',
308+ 'も,モ,ﾓ',
309+ 'や,ヤ,ﾔ,ゃ,ャ,ｬ',
310+ 'ゆ,ユ,ﾕ,ゅ,ュ,ｭ',
311+ 'よ,ヨ,ﾖ,ょ,ョ,ｮ',
312+ 'ら,ラ,ﾗ',
313+ 'り,リ,ﾘ',
314+ 'る,ル,ﾙ',
315+ 'れ,レ,ﾚ',
316+ 'ろ,ロ,ﾛ',
317+ 'わ,ワ,ﾜ,うぁ,ウァ,ｳｧ',
318+ 'ヰ,ゐ,うぃ,ウィ,ｳｨ',
319+ 'ヱ,ゑ,うぇ,ウェ,ｳｪ',
320+ 'を,ヲ,ｦ,うぉ,ウォ,ｳｫ',
321+ 'ﾞ,゛',
322+ 'ﾟ,゜'); {濁点、半濁点はこの位置にないと ”が”→”ｶﾞ”に変換されない。}
323+
324+type
325+{ -============================= TREScanner Class ==================================-}
326+ { 文字の範囲を表す型。}
327+ RECharClass_t = record
328+ case Char of
329+ #0: (StartChar: WChar_t; EndChar: WChar_t);
330+ #1: (Chars: DoubleWChar_t);
331+ end;
332+
333+const
334+ CONST_EMPTYCharClass: RECharClass_t = ( StartChar: CONST_EMPTY;
335+ EndChar: CONST_EMPTY);
336+
337+type
338+
339+ { RECharClass_tへのポインタ型}
340+ REpCharClass_t = ^RECharClass_t;
341+
342+ {トークンの種類を表す型 }
343+ REToken_t = ( retk_Char, {通常の文字 }
344+ retk_CharClass, {'[]'で囲まれたキャラクタクラス正規表現の中で
345+ '-'を使って範囲指定された物 }
346+ retk_Union, { '|'}
347+ retk_LPar, { '('}
348+ retk_RPar, { ')'}
349+ retk_Star, { '*'}
350+ retk_Plus, { '+'}
351+ retk_QMark, { '?'}
352+ retk_LBra, { '['}
353+ retk_LBraNeg, { '[＾'}
354+ retk_RBra, { ']'}
355+ retk_Dot, { '.'}
356+ retk_LHead, { '^'}
357+ retk_LTail, { '$'}
358+ retk_End); { 文字列の終わり }
359+
360+ { REToken_tの集合集合型}
361+ RETokenSet_t = set of REToken_t;
362+
363+ RESymbol_t = record
364+ case REToken_t of
365+ retk_CharClass: (CharClass: RECharClass_t);
366+ retk_Char: (WChar: WChar_t);
367+ end;
368+
369+{● 文字列からトークンを切り出すクラス}
370+ TREScanner = class
371+ private
372+ FRegExpStr: String;
373+ FIndex: Integer;
374+ FToken: REToken_t;
375+ FSymbol: RESymbol_t;
376+ FInCharClass: Boolean;
377+ protected
378+ procedure SetRegExpStr(RegExpStr: String);
379+
380+ {次のトークンを得る。}
381+ function GetTokenStd: REToken_t; virtual;
382+ {キャラクタクラス正規表現 "[ ]" の中のトークンを得る。}
383+ function GetTokenCC: REToken_t; virtual;
384+ public
385+ constructor Create(Str: String);
386+
387+ function GetToken: REToken_t;
388+
389+ {現在のトークン}
390+ property Token: REToken_t read FToken;
391+
392+ { Tokenに対応する文字[列](Lexeme)
393+ Token <> retk_CharClass のとき 現在のトークンの文字値 WChar_t型
394+ Token = retk_CharClass のときはRECharClass_tレコード型
395+ ※FToken = retk_LBraNegの時はブラケット'['１文字分しかない。}
396+ property Symbol: RESymbol_t read FSymbol;
397+
398+ {処理対象の文字列}
399+ property RegExpStr: String read FRegExpStr write SetRegExpStr;
400+
401+ {インデックス
402+ InputStr文字列中で次のGetWCharメソッドで処理する文字のインデックス
403+ ※ Symbolの次の文字を指していることに注意}
404+ property Index: Integer read FIndex;
405+ end;
406+
407+{-============================= ====================-}
408+ {トークンの情報をひとまとめにしたもの}
409+ RETokenInfo_t = record
410+ Token: REToken_t;
411+ Symbol: RESymbol_t;
412+ FromIndex: Integer;
413+ ToIndex: Integer;
414+ end;
415+
416+ REpTokenInfo_t = ^RETokenInfo_t;
417+
418+ {TREPreProcessorクラス内部で使用}
419+ TREPreProcessorFindFunc = function(FromTokenIndex, ToTokenIndex: Integer): Integer of object;
420+
421+ TREPreProcessor = class
422+ private
423+ FScanner: TREScanner;
424+ FProcessedRegExpStr: String;
425+ FListOfSynonymDic: TList;
426+ FListOfFuzzyCharDic: TList;
427+ FTokenList: TList;
428+ FSynonymStr: String;
429+
430+ FUseFuzzyCharDic: Boolean;
431+ FUseSynonymDic: Boolean;
432+ protected
433+ procedure MakeTokenList;
434+ procedure DestroyTokenListItems;
435+
436+ function ReferToOneList(FromTokenIndex, ToTokenIndex: Integer; SynonymDic: TList): Integer;
437+ function FindSynonym(FromTokenIndex, ToTokenIndex: Integer): Integer;
438+ function FindFuzzyWChar(FromTokenIndex, ToTokenIndex: Integer): Integer;
439+
440+ procedure Process(FindFunc: TREPreProcessorFindFunc);
441+
442+ function GetTargetRegExpStr: String;
443+ procedure SetTargetRegExpStr(Str: String);
444+ public
445+ constructor Create(Str: String);
446+ destructor Destroy; override;
447+ procedure Run;
448+
449+ property TargetRegExpStr: String read GetTargetRegExpStr write SetTargetRegExpStr;
450+ property ProcessedRegExpStr: String read FProcessedRegExpStr;
451+
452+ property UseSynonymDic: Boolean read FUseSynonymDic write FUseSynonymDic;
453+ property ListOfSynonymDic: TList read FListOfSynonymDic;
454+ property UseFuzzyCharDic: Boolean read FUseFuzzyCharDic write FUseFuzzyCharDic;
455+ property ListOfFuzzyCharDic: TList read FListOfFuzzyCharDic;
456+ end;
457+
458+{-=========================== TREParseTree Class ===============================-}
459+{**************************************************************************
460+● 構文木を管理するクラス TREParseTree
461+
462+特徴： 中間節(Internal node)と葉(Leaf)を作るときは、それぞれMakeInternalNode
463+ メソッドとMakeLeafメソッドを使う。
464+ また、構文木とは別に、FNodeListとFLeafListから中間節と葉へリンクして
465+ おくことにより、途中でエラーが発生しても必ずメモリを開放する。
466+**************************************************************************}
467+ { TREParseTreeの節の種類を表す型}
468+ REOperation_t = (reop_Char, { 文字そのもの }
469+ reop_LHead, { 文頭 }
470+ reop_LTail, { 文尾 }
471+ reop_Concat, { XY }
472+ reop_Union, { X|Y}
473+ reop_Closure, { X* }
474+ reop_Empty); { 空 }
475+
476+ { RENode_tへのポインタ型}
477+ REpNode_t = ^RENode_t;
478+
479+ { TREParseTreeの子節へのポインタ型}
480+ REChildren_t = record
481+ pLeft: REpNode_t;
482+ pRight: REpNode_t;
483+ end;
484+
485+ { TREParseTreeの節}
486+ RENode_t = record
487+ Op: REOperation_t;
488+ case Char of
489+ #0: (CharClass: RECharClass_t);
490+ #1: (Children: REChildren_t);
491+ end;
492+
493+{● 構文木を管理するクラス}
494+ TREParseTree = class
495+ private
496+ FpHeadNode: REpNode_t;{構文木の頂点にある節}
497+ FNodeList: TList; {中間節のリスト。}
498+ FLeafList: TList; {葉のリスト。}
499+ public
500+ constructor Create;
501+ destructor Destroy; override;
502+
503+ {構文木の内部節を作成。
504+ op はノードが表す演算、leftは左の子、rightは右の子 }
505+ function MakeInternalNode(TheOp: REOperation_t; pLeft, pRight: REpNode_t): REpNode_t;
506+
507+ {構文木の葉を作成。
508+ aStartChar, aEndChar でキャラクタクラスを表す}
509+ function MakeLeaf(aStartChar, aEndChar: WChar_t): REpNode_t;
510+
511+ {任意の一文字を表す'.'メタキャラクタに対応する部分木を作る。
512+ ※CR LFを除く全てのキャラクタを表す葉をreop_Union操作を表す中間節で結んだもの}
513+ function MakeAnyCharsNode: REpNode_t; virtual;
514+
515+ {文頭メタキャラクタを表す葉を作成
516+ ※ 葉を返すが、MakeInternalNodeを使う。}
517+ function MakeLHeadNode(WChar: WChar_t): REpNode_t;
518+
519+ {文尾メタキャラクタを表す葉を作成
520+ ※ 葉を返すが、MakeInternalNodeを使う。}
521+ function MakeLTailNode(WChar: WChar_t): REpNode_t;
522+
523+ {引数が aStartChar <= aEndChar の関係を満たしているときに、MakeLeafを呼ぶ
524+ それ以外は、nil を返す。}
525+ function Check_and_MakeLeaf(aStartChar, aEndChar: WChar_t):REpNode_t;
526+
527+ {葉を内部節に変える。}
528+ procedure ChangeLeaftoNode(pLeaf, pLeft, pRight: REpNode_t);
529+
530+ {全ての葉が持つキャラクタクラスの範囲がそれぞれ重複しないように分割する。}
531+ procedure ForceCharClassUnique;
532+
533+ {すべての節（内部節、葉）を削除。}
534+ procedure DisposeTree;
535+
536+ {構文木の頂点にある節}
537+ property pHeadNode: REpNode_t read FpHeadNode write FpHeadNode;
538+
539+ {内部節のリスト}
540+ property NodeList: TList read FNodeList;
541+ {葉のリスト}
542+ property LeafList: TList read FLeafList;
543+ end;
544+
545+{-=========================== TREParser Class ===============================-}
546+{● 正規表現文字列を解析して構文木にするパーサー }
547+ TREParser = class
548+ private
549+ FParseTree: TREParseTree; {ユニットParseTre.pas で定義されている構文木クラス}
550+ FScanner: TREScanner; {トークン管理クラス}
551+
552+ protected
553+ { <regexp>をパースして、得られた構文木を返す。
554+ 選択 X|Y を解析する}
555+ function Regexp: REpNode_t;
556+
557+ { <term>をパースして、得られた構文木を返す。
558+ 連結ＸＹを解析する}
559+ function term: REpNode_t;
560+
561+ { <factor>をパースして、得られた構文木を返す。
562+ 繰り返しX*, X+を解析する}
563+ function factor: REpNode_t;
564+
565+ { <primary>をパースして、得られた構文木を返す。
566+ 文字そのものと、括弧で括られた正規表現 (X) を解析する}
567+ function primary: REpNode_t;
568+
569+ { <charclass> をパースして、得られた構文木を返す。
570+ [ abcd] で括られた正規表現を解析する}
571+ function CharacterClass(aParseTree: TREParseTree): REpNode_t;
572+
573+ { <negative charclass>をパースして、得られた構文木を返す。
574+ [^abcd] で括られた正規表現を解析する}
575+ function NegativeCharacterClass: REpNode_t;
576+
577+ public
578+ constructor Create(RegExpStr: String);
579+ destructor Destroy; override;
580+
581+ {正規表現をパースする。
582+ regexp, term, factor, primary, charclass の各メソッドを使い再帰下降法
583+ によって解析する。}
584+ procedure Run;
585+
586+ {構文木を管理するオブジェクト}
587+ property ParseTree: TREParseTree read FParseTree;
588+
589+ {入力文字列からトークンを切り出すオブジェクト}
590+ property Scanner: TREScanner read FScanner;
591+
592+{$IFDEF DEBUG}
593+ {アウトライン・コントロールに構文木の図を書き出すメソッド}
594+ procedure WriteParseTreeToOutLine(anOutLine: TOutLine);
595+{$ENDIF}
596+ end;
597+
598+{$IFDEF DEBUG}
599+ function DebugWCharToStr(WChar: WChar_t): String;
600+{$ENDIF}
601+
602+{ -============================== TRE_NFA Class ==================================-}
603+type
604+ RE_pNFANode_t = ^RE_NFANode_t;
605+
606+ { NFA状態表の節
607+ RE_NFANode_t は 1つのＮＦＡ状態が、キャラクタクラス(CharClass)内の文字によっ
608+ て遷移するＮＦＡ状態の状態番号(TransitTo)を格納する。
609+ １つのＮＦＡ状態へ入力されるキャラクタクラス毎にリンク・リストを形成する}
610+ RE_NFANode_t = record
611+ CharClass: RECharClass_t;{ 入力 : CharClass.StartChar 〜 CharClass.EndChar}
612+ TransitTo: integer; { 遷移先： FStateListのインデックス}
613+
614+ Next: RE_pNFANode_t; { リンクリストの次節}
615+ end;
616+
617+{● 構文木を解析してNFA状態表を作るクラス}
618+ TRE_NFA = class
619+ private
620+ FStateList: TList;
621+ FEntryState: Integer;
622+ FExitState: Integer;
623+ FParser: TREParser;
624+ FRegExpHasLHead: Boolean;
625+ FRegExpHasLTail: Boolean;
626+ FLHeadWChar: WChar_t;
627+ FLTailWChar: WChar_t;
628+ protected
629+ { ノードに番号を割り当てる}
630+ function NumberNode: Integer;
631+
632+ { NFA状態節 を１つ作成}
633+ function MakeNFANode: RE_pNFANode_t;
634+
635+ { FStateListに状態遷移を追加する。
636+ 状態 TransFrom に対して、ChrClassのときに状態 TransTo への遷移を追加する。}
637+ procedure AddTransition(TransFrom, TransTo: Integer; aCharClass: RECharClass_t);
638+
639+ { 構文木 pTree に対する StateListを生成する
640+ NFAの入り口をentry, 出口をway_outとする }
641+ procedure GenerateStateList(pTree: REpNode_t; entry, way_out: Integer);
642+
643+ { NFA状態表を破棄する}
644+ procedure DisposeStateList;
645+
646+ public
647+ constructor Create(Parser: TREParser; LHeadWChar, LTailWChar: WChar_t);
648+ destructor Destroy;override;
649+
650+ { 構文木 Treeに対応するNFAを生成する}
651+ procedure Run;
652+
653+ {NFA 状態のリスト}
654+ property StateList: TList read FStateList;
655+
656+ {NFAの初期状態のFStateListのインデックス}
657+ property EntryState: Integer read FEntryState;
658+ {NFAの終了状態のFStateListのインデックス}
659+ property ExitState: Integer read FExitState;
660+
661+ {正規表現が、文頭メタキャラクタを含むか}
662+ property RegExpHasLHead: Boolean read FRegExpHasLHead;
663+ {正規表現が、文尾メタキャラクタを含むか}
664+ property RegExpHasLTail: Boolean read FRegExpHasLTail;
665+
666+ {文頭を表すメタキャラクタ '^'に与えるユニークなキャラクタコード}
667+ property LHeadWChar: WChar_t read FLHeadWChar write FLHeadWChar;
668+ {文尾を表すメタキャラクタ '$'に与えるユニークなキャラクタコード}
669+ property LTailWChar: WChar_t read FLTailWChar write FLTailWChar;
670+
671+{$IFDEF DEBUG}
672+ {TStringsオブジェクトに、NFA の内容を書き込む}
673+ procedure WriteNFAtoStrings(Strings: TStrings);
674+{$ENDIF}
675+ end;
676+
677+{ -========================== TRE_NFAStateSet Class =============================-}
678+{● NFAの状態集合を表すオブジェクト
679+ 内部ではビットベクタで状態集合を実現している。}
680+ TRE_NFAStateSet = class
681+ private
682+ FpArray: PByteArray;
683+ FCapacity: Integer;
684+ public
685+ {コンストラクタには、最大状態数を指定する。}
686+ constructor Create(StateMax: Integer);
687+ destructor Destroy; override;
688+
689+ {オブジェクトの集合が、StateIndexを含むか？}
690+ function Has(StateIndex: Integer): Boolean;
691+ {オブジェクトの集合が、AStateSetと同じ集合状態か？}
692+ function Equals(AStateSet: TRE_NFAStateSet): Boolean;
693+ {オブジェクトの集合にStateIndexを含める。}
694+ procedure Include(StateIndex: Integer);
695+ {オブジェクトが持つバイト配列へのポインタ}
696+ property pArray: PByteArray read FpArray;
697+ {オブジェクトが持つバイト配列の要素数}
698+ property Capacity: Integer read FCapacity;
699+ end;
700+
701+{ -============================= TRE_DFA Class ==================================-}
702+{● TRE_DFA NFA状態表からDFA状態表を作るクラス
703+ コンストラクタ Create に、正規表現を表すＮＦＡ(非決定性有限オートマトン
704+ Non-deterministic Finite Automaton)の状態表を持つTRE_NFAを受け取り、
705+ 対応するＤＦＡ(決定性有限オートマトンDeterministic Finite Automaton)
706+ の状態リストオブジェクトを構築するTRE_DFAクラス。}
707+
708+ RE_pDFATransNode_t = ^RE_DFATransNode_t;
709+
710+ {TRE_DFAのメソッドCompute_Reachable_N_state(DState: PD_state_t): RE_pDFATransNode_t;
711+ がこの型の値を返す。
712+ キャラクタクラス(CharClass)で遷移可能なＮＦＡ状態集合(ToNFAStateSet)}
713+ RE_DFATransNode_t = record
714+ CharClass: RECharClass_t;{Char;}
715+ ToNFAStateSet: TRE_NFAStateSet;
716+
717+ next: RE_pDFATransNode_t;{リンクリストを形成}
718+ end;
719+
720+ RE_pDFAStateSub_t = ^RE_DFAStateSub_t;
721+ RE_pDFAState_t = ^RE_DFAState_t;
722+
723+ { RE_DFAState_tによって使用される
724+ キャラクタクラス(CharClass)によってDFA状態(TransitTo) へ遷移する。}
725+ RE_DFAStateSub_t = record
726+ CharClass: RECharClass_t;
727+ TransitTo: RE_pDFAState_t; {CharClass範囲内の文字で DFA 状態 TransitToへ}
728+
729+ next: RE_pDFAStateSub_t; {リンクリストの次のデータ}
730+ end;
731+
732+ { RE_DFAState_tはＤＦＡ状態を表す型}
733+ RE_DFAState_t = record
734+ StateSet: TRE_NFAStateSet; {このDFA状態を表すNFA状態集合}
735+ Visited: wordbool; { 処理済みなら１}
736+ Accepted: wordbool;{ StateSetフィールドがNFAの終了状態を含むなら１}
737+ Next: RE_pDFAStateSub_t; { キャラクタクラス毎の遷移先のリンクリスト}
738+ end;
739+
740+{ ● NFA状態表からDFA状態表を作るクラス}
741+ TRE_DFA = class
742+ private
743+ FStateList: TList;
744+ FpInitialState: RE_pDFAState_t;
745+ FNFA: TRE_NFA;
746+
747+ FRegExpIsSimple: Boolean;
748+ FSimpleRegExpStr: String;
749+ FRegExpHasLHead: Boolean;
750+ FRegExpHasLTail: Boolean;
751+ protected
752+ { NFA状態集合 StateSet に対して ε-closure操作を実行する。
753+ ε遷移で遷移可能な全てのＮＦＡ状態を追加する}
754+ procedure Collect_Empty_Transition(StateSet: TRE_NFAStateSet);
755+
756+ { NFA状態集合 aStateSet をＤＦＡに登録して、ＤＦＡ状態へのポインタを返す。
757+ aStateSetが終了状態を含んでいれば、acceptedフラグをセットする。
758+ すでにaStateSetがＤＦＡに登録されていたら何もしない}
759+ function Register_DFA_State(var aStateSet: TRE_NFAStateSet): RE_pDFAState_t;
760+
761+ { 処理済みの印がついていないＤＦＡ状態を探す。
762+ 見つからなければnilを返す。}
763+ function Fetch_Unvisited_D_state: RE_pDFAState_t;
764+
765+ { DFA状態pDFAStateから遷移可能なNFA状態を探して、リストにして返す}
766+ function Compute_Reachable_N_state(pDFAState: RE_pDFAState_t): RE_pDFATransNode_t;
767+
768+ { Compute_Reachable_N_stateメソッドか作る RE_DFATransNode_t型のリンクリストを
769+ 廃棄する}
770+ procedure Destroy_DFA_TransList(pDFA_TransNode: RE_pDFATransNode_t);
771+
772+ { NFAを等価なＤＦＡへと変換する}
773+ procedure Convert_NFA_to_DFA;
774+
775+ { StateListの各リンクリストをソートする}
776+ procedure StateListSort;
777+
778+ procedure CheckIfRegExpIsSimple;
779+ procedure DestroyStateList;
780+ public
781+ constructor Create(NFA: TRE_NFA);
782+ destructor Destroy; override;
783+
784+ procedure Run;
785+
786+ property StateList: TList read FStateList;
787+
788+ property pInitialState: RE_pDFAState_t read FpInitialState;
789+
790+ {正規表現が単純な文字列か？}
791+ property RegExpIsSimple: Boolean read FRegExpIsSimple;
792+ {正規表現と等価な単純な文字列}
793+ property SimpleRegExpStr: String read FSimpleRegExpStr;
794+
795+ {正規表現が、文頭メタキャラクタを含むか}
796+ property RegExpHasLHead: Boolean read FRegExpHasLHead;
797+ {正規表現が、文尾メタキャラクタを含むか}
798+ property RegExpHasLTail: Boolean read FRegExpHasLTail;
799+ {$IFDEF DEBUG}
800+ {TStringsオブジェクトに、DFA の内容を書き込む}
801+ procedure WriteDFAtoStrings(Strings: TStrings);
802+{$ENDIF}
803+ end;
804+
805+{ -=================== TRegularExpression Class ==============================-}
806+ {TStringList に格納できる項目数の範囲型}
807+ RE_IndexRange_t = 1..Classes.MaxListSize;
808+
809+{● 正規表現文字列からＤＦＡ状態表を作るクラス}
810+ TRegularExpression = class(TComponent)
811+ private
812+ protected
813+ FLineHeadWChar: WChar_t;
814+ FLineTailWChar: WChar_t;
815+ {プリプロセッサを通る前の正規表現}
816+ FRegExp: String;
817+ {正規表現の文字列リスト。ObjectsプロパティにTＤＦＡオブジェクトを持つ}
818+ FRegExpList: TStringList;
819+ {FRegExpListに格納する項目数の最大値。 デフォルト 30}
820+ FRegExpListMax: RE_IndexRange_t;
821+ {現在指定されている正規表現 RegExpの正規表現文字列リストRegExpList中での
822+ インデックス
823+ ※ FRegExpList[FCurrentIndex] = RegExp}
824+ FCurrentIndex: Integer;
825+ {同意語処理プリプロセッサ}
826+ FPreProcessor: TREPreProcessor;
827+
828+ { 内部使用のための手続き・関数}
829+ {***** 正規表現文字列→構文木構造→NFA→DFA の変換を行う *****}
830+ procedure Translate(RegExpStr: String); virtual;
831+
832+ {正規表現リスト(RegExpList: TStringList)とObjectsプロパティに結び付けられた
833+ TRE_DFAオブジェクトを破棄}
834+ procedure DisposeRegExpList;
835+
836+ {プロパティ・アクセス・メソッド}
837+ procedure SetRegExp(Str: String); virtual;
838+ function GetProcessedRegExp: String;
839+ function GetListOfFuzzyCharDic: TList;
840+ function GetListOfSynonymDic: TList;
841+ function GetRegExpIsSimple: Boolean;
842+ function GetSimpleRegExp: String;
843+ function GetHasLHead: Boolean;
844+ function GetHasLTail: Boolean;
845+ function GetUseFuzzyCharDic: Boolean;
846+ procedure SetUseFuzzyCharDic(Val: Boolean);
847+ function GetUseSynonymDic: Boolean;
848+ procedure SetUseSynonymDic(Val: Boolean);
849+ function GetLineHeadWChar: WChar_t; virtual;
850+ function GetLineTailWChar: WChar_t; virtual;
851+ {DFAオブジェクト関連メソッド}
852+ {現在指定されている正規表現に対応するＤＦＡ状態表の初期状態へのポインタを返す}
853+ function GetpInitialDFAState: RE_pDFAState_t;
854+ {現在指定されている正規表現に対応するTRE_DFAオブジェクトを返す}
855+ function GetCurrentDFA: TRE_DFA;
856+ {状態 DFAstateから文字ｃによって遷移して、遷移後の状態を返す。
857+ 文字ｃによって遷移出来なければnilを返す}
858+ function NextDFAState(DFAState: RE_pDFAState_t; c: WChar_t): RE_pDFAState_t;
859+ {DFA状態表の中で文頭メタキャラクタを表すキャラクタコード}
860+ property LineHeadWChar: WChar_t read GetLineHeadWChar;
861+ {DFA状態表の中で文尾メタキャラクタを表すキャラクタコード}
862+ property LineTailWChar: WChar_t read GetLineTailWChar;
863+
864+ {正規表現関連プロパティ}
865+ {現在指定されている正規表現}
866+ property RegExp: String read FRegExp write SetRegExp;
867+
868+ {現在指定されている正規表現に同意語処理を施したもの}
869+ property ProcessedRegExp: String read GetProcessedRegExp;
870+
871+ {正規表現が単純な文字列か？}
872+ property RegExpIsSimple: Boolean read GetRegExpIsSimple;
873+ {正規表現と等価な単純な文字列(※RegExpIsSimple=Falseの時はヌル文字列)}
874+ property SimpleRegExp: String read GetSimpleRegExp;
875+
876+ {正規表現が、文頭メタキャラクタを含むか}
877+ property HasLHead: Boolean read GetHasLHead;
878+ {正規表現が、文尾メタキャラクタを含むか}
879+ property HasLTail: Boolean read GetHasLTail;
880+
881+ {辞書関連プロパティ}
882+ {文字同一視辞書を使う／使わない指定}
883+ property UseFuzzyCharDic: Boolean read GetUseFuzzyCharDic write SetUseFuzzyCharDic;
884+ {文字の同一視辞書のリスト}
885+ property ListOfFuzzyCharDic: TList read GetListOfFuzzyCharDic;
886+
887+ {同意語辞書を使う／使わない指定}
888+ property UseSynonymDic: Boolean read GetUseSynonymDic write SetUseSynonymDic;
889+ {同意語辞書のリスト}
890+ property ListOfSynonymDic: TList read GetListOfSynonymDic;
891+ public
892+ constructor Create(AOwner: TComponent); override;
893+ destructor Destroy; override;
894+ end;
895+
896+{ -========================== TAWKStr Class ==================================-}
897+ TMatchCORE_LineSeparator = (mcls_CRLF, mcls_LF);
898+
899+ TMatchCORE = class(TRegularExpression)
900+ private
901+ FLineSeparator: TMatchCORE_LineSeparator;
902+ protected
903+ function IsLineEnd(WChar: WChar_t): Boolean;
904+ property LineSeparator: TMatchCORE_LineSeparator
905+ read FLineSeparator write FLineSeparator;
906+ protected
907+
908+ {説明 ： マッチ
909+ (正規表現が行頭／行末メタキャラクタを含まないとき用)
910+ 動作 ：
911+ 引数 ： pText: PChar ヌルキャラクタで終わる検索対象文字列へのポインタ
912+ 副作用： pStart:PChar マッチした部分の先頭文字へのポインタ
913+ pEnd :PChar マッチした部分の次の文字へのポインタ
914+ 注意 ： マッチした部分のバイト数は、pEnd - pStartで得られる。}
915+ procedure MatchStd(pText: PChar; var pStart, pEnd: PChar);
916+
917+
918+ {説明 ： マッチ(正規表現が行頭／行末メタキャラクタを含むとき用)
919+ 動作 ：
920+ 引数 ： pText: PChar ヌルキャラクタで終わる検索対象文字列へのポインタ
921+ 副作用： pStart:PChar マッチした部分の先頭文字へのポインタ
922+ pEnd :PChar マッチした部分の次の文字へのポインタ
923+ 注意 ： マッチした部分のバイト数は、pEnd - pStartで得られる。}
924+ procedure MatchEX(pText: PChar; var pStart, pEnd: PChar);
925+
926+ {説明 ： マッチ(内部処理用。正規表現が行頭／行末メタキャラクタを含むとき用)
927+ 動作 ： MatchEx_Headメソッドとの違いは、引数pTextが行の途中をポイントして
928+ いるものとして、行頭メタキャラクタにマッチしないこと。
929+ 引数 ： pText: PChar ヌルキャラクタで終わる検索対象文字列へのポインタ
930+ (行の中を指しているものとして扱う。)
931+ 副作用： pStart:PChar マッチした部分の先頭文字へのポインタ
932+ pEnd :PChar マッチした部分の次の文字へのポインタ
933+ 注意 ： マッチした部分のバイト数は、pEnd - pStartで得られる。}
934+ procedure MatchEX_Inside(pText: PChar; var pStart, pEnd: PChar);
935+
936+{----------------マッチ 下請け -------------}
937+{MatchHead, MatchInsideは、引数 pTextが指す文字を先頭としてマッチするかを検査する}
938+
939+ {説明 ： pTextは、ある文字列の行頭をポイントしているものと見なす。
940+ したがって、pTextが指す文字は行頭メタキャラクタにマッチする。
941+ 行末メタキャラクタを考慮する。
942+ 引数 ： pText: PChar 検索対象文字列(行の最初の文字を指す)
943+ pDFAState 初期値として使うDFA状態表の１状態
944+ 返り値： マッチした部分文字列の次の文字。
945+ マッチした部分文字列のバイト長は、result - pText
946+ 注意 ： }
947+ function MatchHead(pText: PChar; pDFAState: RE_pDFAState_t): PChar;
948+
949+ {説明 ： pTextは、ある文字列の中(行頭ではない)をポイントしているものと見なす。
950+ したがって、pTextが指す文字は行頭メタキャラクタにマッチしない。
951+ 行末メタキャラクタを考慮する。
952+ 引数 ： pText: PChar 検索対象文字列(行中の文字を指す)
953+ pDFAState 初期値として使うDFA状態表の１状態
954+ 返り値： マッチした部分文字列の次の文字。
955+ マッチした部分文字列のバイト長は、result - pText
956+ 注意 ： }
957+ function MatchInside(pText: PChar; pDFAState: RE_pDFAState_t): PChar;
958+ public
959+ constructor Create(AOwner: TComponent); override;
960+ end;
961+
962+{ -========================== TAWKStr Class ==================================-}
963+ TAWKStrMatchProc = procedure(pText: PChar; var pStart, pEnd: PChar) of object;
964+
965+{● AWK言語の文字列操作関数群をDelphiで実現するクラス TAWKStr}
966+ TAWKStr = class(TMatchCORE)
967+ private
968+ FMatchProc: TAWKStrMatchProc;
969+ protected
970+ procedure SetRegExp(Str: String); override;
971+ {Sub, GSubメソッドで使用。 '&'をマッチした文字列に置換える}
972+ function Substitute_MatchStr_For_ANDChar(Text: String; MatchStr: String): String;
973+ public
974+ constructor Create(AOwner: TComponent); override;
975+ function ProcessEscSeq(Text: String): String;
976+
977+ {文字の同一視辞書のリスト}
978+ property ListOfFuzzyCharDic;
979+ {同意語辞書のリスト}
980+ property ListOfSynonymDic;
981+
982+ {正規表現が、文頭メタキャラクタを含むか}
983+ property HasLHead;
984+ {正規表現が、文尾メタキャラクタを含むか}
985+ property HasLTail;
986+
987+ property ProcessedRegExp;
988+
989+ {DFA状態表の中で文頭メタキャラクタを表すキャラクタコード}
990+ property LineHeadWChar;
991+ {DFA状態表の中で文尾メタキャラクタを表すキャラクタコード}
992+ property LineTailWChar;
993+
994+ function Match(Text: String; var RStart, RLength: Integer): Integer;
995+
996+ function Sub(SubText: String; var Text: String): Boolean;
997+
998+ function GSub(SubText: String; var Text: String): Integer;
999+
1000+ function Split(Text: String; StrList: TStrings): Integer;
1001+ published
1002+ property RegExp;
1003+ {行の区切り文字指定}
1004+ property LineSeparator;
1005+
1006+ {文字の同一視辞書を使うか}
1007+ property UseFuzzyCharDic;
1008+ {同意語辞書を使うか}
1009+ property UseSynonymDic;
1010+
1011+ end;
1012+
1013+{ -========================== 例外クラス =====================================-}
1014+ EEndOfFile = class(EInOutError);
1015+
1016+ EFileNotFound = class(EInOutError);
1017+
1018+ EGrepCancel = class(Exception);
1019+
1020+{ -=========================== TTxtFile Class ================================-}
1021+ {TTextFileクラスのGetThisLineが返すファイル中の１行の情報を表す型}
1022+ RE_LineInfo_t = record
1023+ Line: String;
1024+ LineNo: Integer; {行番号}
1025+ end;
1026+
1027+{● TTxtFile テキストファイル・アクセス・クラス}
1028+ TTxtFile = Class
1029+ private
1030+ protected
1031+ public
1032+ FBuffSize: Integer; {バッファのサイズ}
1033+ FTailMargin: Integer;
1034+ FpBuff: PChar; {読み込みバッファへのポインタ}
1035+
1036+ FFileName: String; {処理対象ファイル名 （フルパス表記）}
1037+ FF: File; {FFileName に関連付けられる型なしファイル変数}
1038+ FFileOpened: Boolean;
1039+
1040+ {バッファ中の文字位置を表す重要なポインタ３種類}
1041+ FpBase: PChar; {文中で検索対象となる部分文字列の先頭を指す}
1042+ FpLineBegin: PChar; {FpBaseが指す文の先頭文字へのポインタ}
1043+ FpForward: PChar; {検索中の文字へのポインタ}
1044+
1045+ FLineNo: Integer; {現在の行番号}
1046+ FReadCount: Integer;{BlockRead で何バイト読み込んだか。}
1047+ FBrokenLine: String;{バッファの境界で分断された文の前半部分}
1048+
1049+ FpCancelRequest: ^Boolean;
1050+ {IncPBaseメソッドでFpBaseがヌル・キャラクタを指したときの処理}
1051+ procedure IncPBaseNullChar(Ch: Char);
1052+ {GetCharメソッドでFpForwardがヌル・キャラクタを指したときの処理}
1053+ procedure GetCharNullChar(Ch: Char);
1054+
1055+ constructor Create(aFileName: String; var CancelRequest: Boolean);
1056+ destructor Destroy; override;
1057+ procedure BuffRead(pBuff: PChar);
1058+ function IncPBase: Char; {FpBaseが次のバイトを指すようにする}
1059+ function AdvanceBase: WChar_t;
1060+ function GetChar: Char;
1061+ function GetWChar: WChar_t;
1062+ function GetThisLine: RE_LineInfo_t;{FpBaseが指している文字を含む文を得る}
1063+ end;
1064+
1065+{ -=========================== TGrep Class ==================================-}
1066+
1067+ TGrepOnMatch = procedure (Sender: TObject; LineInfo: RE_LineInfo_t) of Object;
1068+
1069+ TGrepGrepProc = procedure (FileName: String) of Object;
1070+
1071+{● ファイル正規表現検索クラス TGrep }
1072+ TGrep = class(TRegularExpression)
1073+ private
1074+ FOnMatch: TGrepOnMatch;
1075+// FDummyIgnoreCase: Boolean;
1076+ FCancel: Boolean;
1077+ FGrepProc: TGrepGrepProc;
1078+ protected
1079+ procedure SetRegExp(Str: String); override;
1080+ function GetLineHeadWChar: WChar_t; override;
1081+ function GetLineTailWChar: WChar_t; override;
1082+ public
1083+ constructor Create(AOwner: TComponent); override;
1084+
1085+ procedure GrepByRegExp(FileName: String);
1086+ procedure GrepByStr(FileName: String);
1087+
1088+ {機能 指定されたテキスト・ファイル中で正規表現(RegExpプロパティ)にマッチ
1089+ する行を探し、見つけるたびにOnMatch イベントハンドラを呼び出します。
1090+
1091+ (RegExpプロパティに設定されている正規表現を検査して、普通の文字列ならば
1092+ GrepByStrメソッド、メタキャラクタを含むときはGrepByRegExpメソッドを
1093+ 呼び出します。)
1094+ ※ OnMatch イベントハンドラが指定されていないときは、何もしません。
1095+
1096+ 引数 FileNmae 検索対象のテキストファイル名(フルパス指定)
1097+ CancelRequest 検索を途中で止めたいときにTrueにする。
1098+ ※ Grepメソッドは内部で、Application.ProcessMessagesを呼び出す
1099+ ので、そのときに、CancelRequestをTrueに設定することができます。}
1100+
1101+ {正規表現が単純な文字列か？}
1102+ property RegExpIsSimple;
1103+ {正規表現と等価な単純な文字列(※RegExpIsSimple=Falseの時はヌル文字列)}
1104+ property SimpleRegExp;
1105+
1106+ {正規表現が、文頭メタキャラクタを含むか}
1107+ property HasLHead;
1108+ {正規表現が、文尾メタキャラクタを含むか}
1109+ property HasLTail;
1110+
1111+ {RegExpプロパティの正規表現に同意語処理を施したもの}
1112+ property ProcessedRegExp;
1113+ {文字の同一視辞書のリスト}
1114+ property ListOfFuzzyCharDic;
1115+ {同意語辞書のリスト}
1116+ property ListOfSynonymDic;
1117+
1118+ property Grep: TGrepGrepProc read FGrepProc;
1119+ published
1120+ {正規表現文字列}
1121+ property RegExp;
1122+ {文字の同一視辞書を使うか}
1123+ property UseFuzzyCharDic;
1124+ {同意語辞書を使うか}
1125+ property UseSynonymDic;
1126+
1127+ property OnMatch: TGrepOnMatch read FOnMatch write FOnMatch;
1128+
1129+ property Cancel: Boolean read FCancel write FCancel;
1130+ end;
1131+
1132+
1133+
1134+var
1135+ RE_FuzzyCharDic: TList;
1136+
1137+procedure Register;
1138+
1139+implementation
1140+{************************ Implementation ************************************}
1141+constructor ERegExpParser.Create(const Msg: string; ErrorPosition: Word);
1142+begin
1143+ inherited Create(Msg);
1144+ ErrorPos := ErrorPosition;
1145+end;
1146+{ -====================== 文字列操作関数 =====================================-}
1147+{説明 ： １６進数を表す文字を受け取り、整数にして返す。
1148+ 引数 ： WCh: WChar_t; 16進数を表す1バイト文字 [0-9a-fA-F]
1149+
1150+ 返り値： 正常時： 0 <= result <= 15
1151+ 異常時： -1}
1152+function HexWCharToInt(WCh: WChar_t): Integer;
1153+begin
1154+ case WCh of
1155+ Ord('0')..Ord('9'): result := WCh - Ord('0');
1156+ Ord('A')..Ord('F'): result := WCh - Ord('A')+10;
1157+ Ord('a')..Ord('f'): result := WCh - Ord('a')+10;
1158+ else result := -1;
1159+ end;
1160+end;
1161+
1162+{説明 ： ８進数を表す文字を受け取り、整数にして返す。
1163+ 引数 ： WCh: WChar_t; 8進数を表す1バイト文字 [0-7]
1164+
1165+ 返り値： 正常時： 0 <= result <= 7
1166+ 異常時： -1}
1167+function OctWCharToInt(WCh: WChar_t): Integer;
1168+begin
1169+ case WCh of
1170+ Ord('0')..Ord('7'): result := WCh - Ord('0');
1171+ else result := -1;
1172+ end;
1173+end;
1174+
1175+{機能： Str から １文字 得る
1176+ 解説： Str中でIndexが指す位置から1文字(２バイト文字含む) 得てから、Indexが
1177+ 次の文字を指すように進める
1178+ 注意： Indexが文字列の長さよりすでに長い場合は常に 0を返し、Indexを増やさない。
1179+ つまり、Indexは最大でも Length(Str)+1 である。}
1180+function GetWChar(const Str: String; var Index: Integer): WChar_t;
1181+begin
1182+ if (Index >= 1) and (Index <= Length(Str)) then begin
1183+ if IsDBCSLeadByte(Byte(Str[Index])) then begin
1184+ {Strの最後の文字が２バイト文字コードの１バイトのときは例外生成}
1185+ if Index = Length(Str) then
1186+ raise ERegExpParser.Create('不正な２バイト文字コードです。', Index);
1187+ WordRec(result).Hi := Byte(Str[Index]);
1188+ WordRec(result).Lo := Byte(Str[Index+1]);
1189+ Inc(Index, 2);
1190+ end else begin
1191+ result := Byte(Str[Index]);
1192+ Inc(Index);
1193+ end;
1194+ end else begin
1195+ result := CONST_NULL;
1196+ end;
1197+end;
1198+
1199+//1997/09/25 FIX: MBUtils.pasがなくても動作するように変更
1200+function IsTrailByteInStr(pText: PAnsiChar;
1201+ ptr: PAnsiChar
1202+ ): Boolean;
1203+var
1204+ p: PAnsiChar;
1205+begin
1206+ Result := false;
1207+ if pText = ptr then Exit;
1208+ p := ptr - 1;
1209+ while (p <> pText) do
1210+ begin
1211+ if not IsDBCSLeadByte(Ord(p^)) then Break;
1212+ Dec(p);
1213+ end;
1214+ if ((ptr - p) mod 2) = 0 then Result := true;
1215+end;
1216+
1217+procedure UnGetWChar(const Str: String; var Index: Integer);
1218+begin
1219+ if Index <= 1 then
1220+ Exit
1221+ else if (Index > 2) and IsTrailByteInStr(PAnsiChar(Str), PAnsiChar(Str)+Index-2) then
1222+ Dec(Index, 2)
1223+ else
1224+ Dec(Index);
1225+end;
1226+
1227+function PCharGetWChar(var pText: PChar): WChar_t;
1228+begin
1229+ if Byte(pText^) <> CONST_NULL then begin
1230+ if IsDBCSLeadByte(Byte(pText^)) then begin
1231+ WordRec(result).Hi := Byte(pText^);
1232+ WordRec(result).Lo := Byte((pText+1)^);
1233+ Inc(pText, 2);
1234+ end else begin
1235+ result := Byte(pText^);
1236+ Inc(pText);
1237+ end;
1238+ end else begin
1239+ result := CONST_NULL;
1240+ end;
1241+end;
1242+
1243+{機能： WChar_t型の値をString型へ変換する。}
1244+function WCharToStr(WCh: WChar_t): String;
1245+begin
1246+ if IsDBCSLeadByte(Hi(WCh)) then
1247+ result := Chr(Hi(WCh))+Chr(Lo(WCh))
1248+ else
1249+ result := Chr(Lo(WCh));
1250+end;
1251+
1252+{機能： '\' で 引用されたキャラクタを得る。 \n, \t \\ ...
1253+ 注意： Indexは'\'の次の文字を指しているとする。}
1254+function GetQuotedWChar(const Str: String; var Index: Integer): WChar_t;
1255+var
1256+ WCh: WChar_t;
1257+begin
1258+ WCh := GetWChar(Str, Index);
1259+ if WCh = 0 then
1260+ raise ERegExpParser.Create('"\"の次には文字が必要です。', Index);
1261+
1262+ if WCh = CONST_b then {'b'}
1263+ result := CONST_BS {back space}
1264+ else if WCh = CONST_r then {'r'}
1265+ result := CONST_CR {Carriage Return}
1266+ else if WCh = CONST_n then {'n'}
1267+ result := CONST_LF {Line Feed}
1268+ else if WCh = CONST_t then {'t'}
1269+ result := CONST_TAB {tab}
1270+ else if WCh = CONST_x then {'x'}
1271+ result := HexStrToInt(Str, Index)
1272+ else if OctWCharToInt(WCh) >= 0 then begin
1273+ UnGetWChar(Str, Index); {WChを戻す}
1274+ result := OctStrToInt(Str, Index);
1275+ end else
1276+ result := WCh;
1277+end;
1278+
1279+{説明 ： 16進数表記の文字列をWord型の数値に変換する。
1280+引数 ： Str: String 変換元の文字列
1281+ Index: Integer 引数StrのIndex番目のバイト位置から変換を始める。
1282+返り値： 文字列が表すWord型の値}
1283+function HexStrToInt(const Str: String; var Index: Integer): Word;
1284+var
1285+ Val, i: Integer;
1286+ WCh: WChar_t;
1287+begin
1288+ result := 0;
1289+ i := 1;
1290+ WCh := GetWChar(Str, Index);
1291+ Val := HexWCharToInt(WCh);
1292+ while (WCh <> CONST_NULL) and (Val >= 0) and (i < 5) do begin
1293+ result := result * 16 + Val;
1294+ WCh := GetWChar(Str, Index);
1295+ Val := HexWCharToInt(WCh);
1296+ Inc(i);
1297+ end;
1298+ if i = 1 then
1299+ raise ERegExpParser.Create('不正な１６進数コード表記です。', Index);
1300+ if WCh <> CONST_NULL then
1301+ UnGetWChar(Str, Index);
1302+end;
1303+
1304+{説明 ： ８進数表記の文字列をWord型の数値に変換する。
1305+引数 ： Str: String 変換元の文字列
1306+ Index: Integer 引数StrのIndex番目のバイト位置から変換を始める。
1307+返り値： 文字列が表すWord型の値}
1308+function OctStrToInt(const Str: String; var Index: Integer): Word;
1309+var
1310+ Val, i: Integer;
1311+ WCh: WChar_t;
1312+begin
1313+ result := 0;
1314+ i := 1;
1315+ WCh := GetWChar(Str, Index);
1316+ Val := OctWCharToInt(WCh);
1317+ while (WCh <> CONST_NULL) and (Val >= 0) and (i < 7) do begin
1318+ if (result * 8 + Val) > $FFFF then
1319+ raise ERegExpParser.Create('不正な８進数コード表記です。', Index);
1320+ result := result * 8 + Val;
1321+ WCh := GetWChar(Str, Index);
1322+ Val := OctWCharToInt(WCh);
1323+ Inc(i);
1324+ end;
1325+ if i = 1 then
1326+ raise ERegExpParser.Create('不正な８進数コード表記です。', Index);
1327+ if WCh <> CONST_NULL then
1328+ UnGetWChar(Str, Index);
1329+end;
1330+
1331+{説明 ： FS:WChar_tを区切り文字として、バイト位置Indexから始まるトークンを１つ返す。
1332+引数 ： Str: String
1333+ Index: Integer 引数StrのIndex番目のバイト位置から変換を始める。
1334+返り値： FSで区切られた、バイト位置Indexから始まるトークン}
1335+function WCharGetToken(const Str: String; var Index: Integer; FS: WChar_t): String;
1336+var
1337+ WCh: WChar_t;
1338+begin
1339+ result := '';
1340+ WCh := GetWChar(Str, Index);
1341+ while WCh <> 0 do begin
1342+ if WCh = FS then
1343+ break
1344+ else begin
1345+ result := result + WCharToStr(WCh);
1346+ WCh := GetWChar(Str, Index);
1347+ end;
1348+ end;
1349+end;
1350+
1351+{説明 ： 引数Str中のメタキャラクタに'\'をつける。
1352+引数 ： Str: String
1353+返り値： メタキャラクタの前に'\'がついたStr}
1354+function QuoteMetaWChar(Str: String): String;
1355+var
1356+ i, j: Integer;
1357+ WChar: WChar_t;
1358+begin
1359+ result := '';
1360+ i := 1;
1361+ WChar := GetWChar(Str, i);
1362+ while WChar <> 0 do begin
1363+ j := 0;
1364+ while j <= High(METACHARS) do begin
1365+ if METACHARS[j] = WChar then
1366+ break
1367+ else
1368+ Inc(j);
1369+ end;
1370+ if j <= High(METACHARS) then
1371+ result := result + '\' + WCharToStr(WChar)
1372+ else
1373+ result := result + WCharToStr(WChar);
1374+ WChar := GetWChar(Str, i);
1375+ end;
1376+
1377+end;
1378+
1379+{ -============================ TREScanner Class =================================-}
1380+constructor TREScanner.Create(Str: String);
1381+begin
1382+ inherited Create;
1383+ Self.SetRegExpStr(Str);
1384+end;
1385+
1386+procedure TREScanner.SetRegExpStr(RegExpStr: String);
1387+begin
1388+ FRegExpStr := RegExpStr;
1389+ FIndex := 1;
1390+end;
1391+
1392+{機能： トークンを得る
1393+ 解説： GetWCharおよびUnGetWCharメソッドを使ってトークンを得る。
1394+ 注意： 返り値は、列挙型 REToken_tのうちretk_CharClass以外のどれか}
1395+function TREScanner.GetTokenStd: REToken_t;
1396+var
1397+ WChar: WChar_t;
1398+begin
1399+ WChar := GetWChar(FRegExpStr, FIndex);
1400+ FSymbol.WChar := WChar;
1401+
1402+ { 文字(列)をトークンに変換する }
1403+ if WChar = CONST_NULL then
1404+ FToken := retk_End
1405+ else if WChar = CONST_DOLLAR then
1406+ FToken := retk_LTail
1407+ else if WChar = CONST_LPAR then
1408+ FToken := retk_LPar
1409+ else if WChar = CONST_RPAR then
1410+ FToken := retk_RPar
1411+ else if WChar = CONST_STAR then
1412+ FToken := retk_Star
1413+ else if WChar = CONST_PLUS then
1414+ FToken := retk_Plus
1415+ else if WChar = CONST_DOT then
1416+ FToken := retk_Dot
1417+ else if WChar = CONST_QMARK then
1418+ FToken := retk_QMark
1419+ else if WChar = CONST_VL then
1420+ FToken := retk_Union
1421+ else if WChar = CONST_RBRA then
1422+ FToken := retk_RBra
1423+ else if WChar = CONST_LBRA then begin
1424+ WChar := GetWChar(FRegExpStr, FIndex);
1425+ if WChar = CONST_NULL then
1426+ raise ERegExpParser.Create('右ブラケット"]"が必要です', FIndex);
1427+ if WChar = CONST_CARET then
1428+ FToken := retk_LBraNeg {補キャラクタクラス}
1429+ else begin
1430+ UnGetWChar(FRegExpStr, FIndex);
1431+ FToken := retk_LBra;
1432+ end;
1433+ end
1434+ else if WChar = CONST_YEN then begin
1435+ FToken := retk_Char;
1436+ FSymbol.WChar := GetQuotedWChar(FRegExpStr, FIndex);
1437+ end
1438+ else if WChar = CONST_CARET then begin
1439+ FToken := retk_LHead;
1440+ end else
1441+ FToken := retk_Char;
1442+
1443+ result := FToken;
1444+end;
1445+
1446+{機能： '[]'で囲まれたキャラクタクラス正規表現の中のトークンを得る。
1447+ 解説： GetWCharおよびUnGetWCharメソッドを使ってトークンを得る。
1448+ 注意： 返り値は、列挙型 REToken_tのうち
1449+ retk_Char, retk_CharClass, retk_RBraのどれか。
1450+ ヌル・キャラクタを見つけたときは例外を生成する。}
1451+function TREScanner.GetTokenCC: REToken_t;
1452+var
1453+ WChar, WChar2, WChar3: WChar_t;
1454+begin
1455+ WChar := GetWChar(FRegExpStr, FIndex);
1456+ FSymbol.WChar := WChar;
1457+
1458+ { 文字(列)をトークンに変換する }
1459+ if WChar = CONST_NULL then
1460+ raise ERegExpParser.Create('右ブラケット"]"が必要です', FIndex);
1461+ if WChar = CONST_RBRA then
1462+ FToken := retk_RBra
1463+ else begin
1464+ if WChar = CONST_YEN then
1465+ {エスケープシーケンスを処理}
1466+ WChar := GetQuotedWChar(FRegExpStr, FIndex);
1467+
1468+ {キャラクタ範囲を表す'-'に関する処理をする}
1469+ FToken := retk_Char;
1470+ WChar2 := GetWChar(FRegExpStr, FIndex);
1471+ if WChar2 = CONST_MINUS then begin
1472+ {2番目の文字が'-'だったとき}
1473+ WChar3 := GetWChar(FRegExpStr, FIndex);
1474+ if WChar3 = CONST_NULL then
1475+ {3番目の文字がヌルキャラクタのとき}
1476+ raise ERegExpParser.Create('右ブラケット"]"が必要です', FIndex);
1477+
1478+ if WChar3 = CONST_RBRA then begin
1479+ {3番目の文字が ']'のとき}
1480+ UnGetWChar(FRegExpStr, FIndex); { WChar3を戻す }
1481+ UnGetWChar(FRegExpStr, FIndex); { WChar2を戻す }
1482+ FSymbol.WChar := WChar;
1483+ end else begin
1484+ if WChar3 = CONST_YEN then
1485+ WChar3 := GetQuotedWChar(FRegExpStr, FIndex);
1486+ FToken := retk_CharClass;
1487+ if WChar > WChar3 then
1488+ raise ERegExpParser.Create('不正なキャラクタ範囲です', FIndex);
1489+ FSymbol.CharClass.StartChar := WChar;
1490+ FSymbol.CharClass.EndChar := WChar3;
1491+ end
1492+ end else begin
1493+ {2番目の文字が'-'ではないとき}
1494+ if WChar2 = CONST_NULL then
1495+ {2番目の文字がヌルキャラクタのとき}
1496+ raise ERegExpParser.Create('右ブラケット"]"が必要です', FIndex);
1497+ UnGetWChar(FRegExpStr, FIndex);{WChar2を戻す}
1498+ FSymbol.WChar := WChar;
1499+ end;
1500+ end;
1501+ result := FToken;
1502+end;
1503+
1504+function TREScanner.GetToken: REToken_t;
1505+begin
1506+ if FInCharClass then begin
1507+ result := GetTokenCC;
1508+ if result = retk_RBra then
1509+ FInCharClass := False;
1510+ end else begin
1511+ result := GetTokenStd;
1512+ if (result = retk_LBra) or (result = retk_LBraNeg) then
1513+ FInCharClass := True;
1514+ end;
1515+end;
1516+
1517+constructor TREPreProcessor.Create(Str: String);
1518+begin
1519+ inherited Create;
1520+ FScanner := TREScanner.Create(Str);
1521+ FTokenList := TList.Create;
1522+ FListOfSynonymDic := TList.Create;
1523+ FListOfFuzzyCharDic := TList.Create;
1524+end;
1525+
1526+destructor TREPreProcessor.Destroy;
1527+begin
1528+ FScanner.Free;
1529+ DestroyTokenListItems;
1530+ FTokenList.Free;
1531+ FListOfSynonymDic.Free;
1532+ FListOfFuzzyCharDic.Free;
1533+ inherited Destroy;
1534+end;
1535+
1536+{説明 ： FTokenList: TList を、アイテムデータ (RETokenInfo_t型レコード)と共に廃棄する。
1537+注意 ： MakeTokenListと対で使用する。}
1538+procedure TREPreProcessor.DestroyTokenListItems;
1539+var
1540+ i: Integer;
1541+begin
1542+ if FTokenList = nil then
1543+ exit;
1544+
1545+ i := 0;
1546+ while i < FTokenList.Count do begin
1547+ Dispose(REpTokenInfo_t(FTokenList.Items[i]));
1548+ FTokenList.Items[i] := nil;
1549+ Inc(i);
1550+ end;
1551+ FTokenList.Clear;
1552+end;
1553+
1554+{説明 ： FTokenList: TListに RETokenInfo_t型のレコードを構築する。
1555+動作 ： 最後尾のRETokenInfo_t型レコードは、常にToken = retk_Endである。
1556+注意 ： DestroyTokenListメソッドと対で使用する。}
1557+procedure TREPreProcessor.MakeTokenList;
1558+var
1559+ pTokenInfo: REpTokenInfo_t;
1560+ prevIndex: Integer;
1561+begin
1562+ prevIndex := FScanner.Index;
1563+ DestroyTokenListItems;
1564+ while FScanner.GetToken <> retk_End do begin
1565+ New(pTokenInfo);
1566+ try
1567+ FTokenList.Add(pTokenInfo);
1568+ except
1569+ on Exception do begin
1570+ Dispose(pTokenInfo);
1571+ raise;
1572+ end;
1573+ end;
1574+ with pTokenInfo^ do begin
1575+ Token := FScanner.Token;
1576+ Symbol := FScanner.Symbol;
1577+ FromIndex := prevIndex;
1578+ ToIndex := FScanner.Index;
1579+ end;
1580+ prevIndex := FScanner.Index;
1581+ end;
1582+
1583+ {最後尾 retk_End}
1584+ New(pTokenInfo);
1585+ try
1586+ FTokenList.Add(pTokenInfo);
1587+ except
1588+ on Exception do begin
1589+ Dispose(pTokenInfo);
1590+ raise;
1591+ end;
1592+ end;
1593+ with pTokenInfo^ do begin
1594+ Token := retk_End;
1595+ Symbol.WChar := CONST_NULL;
1596+ FromIndex := 0;
1597+ ToIndex := 0;
1598+ end;
1599+end;
1600+
1601+function TREPreProcessor.GetTargetRegExpStr: String;
1602+begin
1603+ result := FScanner.RegExpStr;
1604+end;
1605+
1606+procedure TREPreProcessor.SetTargetRegExpStr(Str: String);
1607+begin
1608+ FScanner.RegExpStr := Str;
1609+end;
1610+
1611+{説明 ： 正規表現文字列に同意語を組み込む。}
1612+procedure TREPreProcessor.Run;
1613+begin
1614+ FProcessedRegExpStr := FScanner.RegExpStr;
1615+ if FUseSynonymDic then begin
1616+ Self.Process(FindSynonym);
1617+ FScanner.RegExpStr := FProcessedRegExpStr;
1618+ end;
1619+
1620+ if FUseFuzzyCharDic then
1621+ Self.Process(FindFuzzyWChar);
1622+end;
1623+
1624+{説明 ： 同意語埋め込み処理 Runメソッドの下請け}
1625+procedure TREPreProcessor.Process(FindFunc: TREPreProcessorFindFunc);
1626+var
1627+ j, k: Integer;
1628+ TkIndex: Integer;
1629+ Info: RETokenInfo_t;
1630+ InCC: Boolean;
1631+begin
1632+ FProcessedRegExpStr := '';
1633+ MakeTokenList;
1634+ InCC := False;
1635+ TkIndex := 0;
1636+ {すべてのトークンを検査する}
1637+ while TkIndex < FTokenList.Count do begin
1638+ Info := REpTokenInfo_t(FTokenList[TkIndex])^;
1639+ {キャラクタクラス ('[]'でくくられた部分)に入る}
1640+ if Info.Token = retk_LBra then
1641+ InCC := True;
1642+
1643+ {キャラクタクラスから出た}
1644+ if Info.Token = retk_RBra then
1645+ InCC := False;
1646+
1647+ {トークンがキャラクタ以外か、キャラクタクラス '[ ]'の中の場合}
1648+ if (Info.Token <> retk_Char) or InCC then begin
1649+ FProcessedRegExpStr := FProcessedRegExpStr +
1650+ Copy(FScanner.RegExpStr, Info.FromIndex, Info.ToIndex-Info.FromIndex);
1651+ Inc(TkIndex); {何もせずにFProcessedRegExpStrへ追加}
1652+ {トークンがキャラクタの場合}
1653+ end else begin
1654+ j := TkIndex;
1655+ {jがキャラクタ以外を指すまでインクリメント}
1656+ while REpTokenInfo_t(FTokenList[j])^.Token = retk_Char do
1657+ Inc(j);
1658+
1659+ {キャラクタの連続を１つづつ検査}
1660+ while TkIndex < j do begin
1661+ k := FindFunc(TkIndex, j);
1662+ if k <> -1 then begin
1663+ {マッチした部分を追加}
1664+ FProcessedRegExpStr := FProcessedRegExpStr + FSynonymStr;
1665+ TkIndex := k; {次のトークンからマッチする部分を引き続きさがす。}
1666+ end else begin
1667+ {マッチしなければ、一文字分追加して、インデックスを進める}
1668+ Info := REpTokenInfo_t(FTokenList[TkIndex])^;
1669+ FProcessedRegExpStr := FProcessedRegExpStr +
1670+ Copy(FScanner.RegExpStr, Info.FromIndex, Info.ToIndex-Info.FromIndex);;
1671+ Inc(TkIndex);
1672+ end;
1673+ end;
1674+ TkIndex := j;
1675+ end;
1676+ end;
1677+end;
1678+
1679+{説明 ： 同意語辞書 SynonymDic: TListを使って、同意語を探す。
1680+返り値： トークンリスト内の同意語の次のインデックス
1681+ 見つからなければ -1}
1682+function TREPreProcessor.ReferToOneList(FromTokenIndex, ToTokenIndex: Integer; SynonymDic: TList): Integer;
1683+var
1684+ StrList: TStrings;
1685+ i, j, k, m: Integer;
1686+
1687+ {StrとFTokenListを比較}
1688+ function Match(Str: String): Integer;
1689+ var
1690+ StrIndex, TkIndex: Integer;
1691+ WChar: WChar_t;
1692+ begin
1693+ if Str = '' then begin
1694+ result := -1;
1695+ exit;
1696+ end;
1697+
1698+ TkIndex := FromTokenIndex;
1699+ StrIndex := 1;
1700+ WChar := GetWChar(Str, StrIndex);
1701+ while (WChar <> CONST_NULL) and (TkIndex < ToTokenIndex) do begin
1702+ if WChar <> REpTokenInfo_t(FTokenList[TkIndex])^.Symbol.WChar then begin
1703+ result := -1;
1704+ exit;
1705+ end else begin
1706+ Inc(TkIndex);
1707+ WChar := GetWChar(Str, StrIndex);
1708+ end;
1709+ end;
1710+ if WChar = CONST_NULL then
1711+ result := TkIndex
1712+ else
1713+ result := -1;
1714+ end;
1715+begin
1716+ result := -1;
1717+ i := 0;
1718+ while i < SynonymDic.Count do begin
1719+ StrList := TStrings(SynonymDic[i]);
1720+ j := 0;
1721+ while j < StrList.Count do begin
1722+ k := Match(StrList[j]);
1723+ if k <> -1 then begin
1724+ {マッチした}
1725+ FSynonymStr := '(' + QuoteMetaWChar(StrList[0]);
1726+ m := 1;
1727+ while m < StrList.Count do begin
1728+ FSynonymStr := FSynonymStr + '|' + QuoteMetaWChar(StrList[m]);
1729+ Inc(m);
1730+ end;
1731+ FSynonymStr := FSynonymStr + ')';
1732+ result := k;
1733+ exit;
1734+ end;
1735+ Inc(j);
1736+ end;
1737+ Inc(i);
1738+ end;
1739+end;
1740+
1741+{説明 ：
1742+返り値： トークンリスト内の同意語の次のインデックス
1743+ 見つからなければ -1
1744+注意 ： RunメソッドがメソッドポインタをProcessメソッドに渡し、
1745+ Processメソッドが呼び出す。}
1746+function TREPreProcessor.FindSynonym(FromTokenIndex, ToTokenIndex: Integer): Integer;
1747+var
1748+ i: Integer;
1749+begin
1750+ result := -1;
1751+ i := 0;
1752+ while i < FListOfSynonymDic.Count do begin
1753+ result := ReferToOneList(FromTokenIndex, ToTokenIndex, FListOfSynonymDic[i]);
1754+ if result <> -1 then
1755+ exit;
1756+ Inc(i);
1757+ end;
1758+end;
1759+
1760+{説明 ：
1761+返り値： トークンリスト内の同意語の次のインデックス
1762+ 見つからなければ -1
1763+注意 ： RunメソッドがメソッドポインタをProcessメソッドに渡し、
1764+ Processメソッドが呼び出す。}
1765+function TREPreProcessor.FindFuzzyWChar(FromTokenIndex, ToTokenIndex: Integer): Integer;
1766+var
1767+ i: Integer;
1768+begin
1769+ result := -1;
1770+ i := 0;
1771+ while i < FListOfFuzzyCharDic.Count do begin
1772+ result := ReferToOneList(FromTokenIndex, ToTokenIndex, FListOfFuzzyCharDic[i]);
1773+ if result <> -1 then
1774+ exit;
1775+ Inc(i);
1776+ end;
1777+end;
1778+
1779+constructor TREParseTree.Create;
1780+begin
1781+ inherited Create;
1782+ FNodeList := TList.Create;
1783+ FLeafList := TList.Create;
1784+end;
1785+
1786+destructor TREParseTree.Destroy;
1787+begin
1788+ DisposeTree;
1789+ FNodeList.Free;
1790+ FLeafList.Free;
1791+ inherited Destroy;
1792+end;
1793+
1794+{構文木のノードを作成する。
1795+ op はノードが表す演算、leftは左の子、rightは右の子 }
1796+function TREParseTree.MakeInternalNode(TheOp: REOperation_t; pLeft,
1797+ pRight: REpNode_t): REpNode_t;
1798+begin
1799+ New(result);
1800+ with result^ do begin
1801+ op := TheOp;
1802+ Children.pLeft := pLeft;
1803+ Children.pRight := pRight;
1804+ end;
1805+ try
1806+ FNodeList.Add(result);
1807+ except
1808+ {TListでメモリ不足の時は,新しい構文木の節も開放してしまう}
1809+ on EOutOfMemory do begin
1810+ Dispose(result);
1811+ raise;
1812+ end;
1813+ end;
1814+end;
1815+
1816+{構文木の葉を作る
1817+ TheC はこの葉が表す文字}
1818+function TREParseTree.MakeLeaf(aStartChar, aEndChar: WChar_t): REpNode_t; {char}
1819+var
1820+ i: Integer;
1821+begin
1822+ {既に同じキャラクタクラスを持つ葉が存在すれば、それを返す。}
1823+ for i := 0 to FLeafList.Count-1 do begin
1824+ if (REpNode_t(FLeafList[i])^.CharClass.StartChar = aStartChar) and
1825+ (REpNode_t(FLeafList[i])^.CharClass.EndChar = aEndChar) then begin
1826+ result := FLeafList[i];
1827+ exit;
1828+ end;
1829+ end;
1830+
1831+ New(result);
1832+ with result^ do begin
1833+ op := reop_char;
1834+ CharClass.StartChar := aStartChar;
1835+ CharClass.EndChar := aEndChar;
1836+ end;
1837+ try
1838+ FLeafList.Add(result);
1839+ except
1840+ {TListでメモリ不足の時は,新しい構文木の節も開放してしまう}
1841+ on EOutOfMemory do begin
1842+ Dispose(result);
1843+ raise;
1844+ end;
1845+ end;
1846+end;
1847+
1848+{文頭メタキャラクタを表す節。 ※子を持たないが、MakeInternalNodeを使う}
1849+function TREParseTree.MakeLHeadNode(WChar: WChar_t): REpNode_t;
1850+begin
1851+ result := MakeInternalNode(reop_LHead, nil, nil);
1852+ with result^ do begin
1853+ CharClass.StartChar := WChar;
1854+ CharClass.EndChar := WChar;
1855+ end;
1856+end;
1857+
1858+{文尾メタキャラクタを表す節。 ※子を持たないが、MakeInternalNodeを使う}
1859+function TREParseTree.MakeLTailNode(WChar: WChar_t): REpNode_t;
1860+begin
1861+ result := MakeInternalNode(reop_LTail, nil, nil);
1862+ with result^ do begin
1863+ CharClass.StartChar := WChar;
1864+ CharClass.EndChar := WChar;
1865+ end;
1866+end;
1867+
1868+{任意の一文字を表す'.'メタキャラクタに対応する部分木を作る。
1869+ ※CR LFを除く全てのキャラクタを表す葉をreop_Union操作を表す中間節で結んだもの}
1870+function TREParseTree.MakeAnyCharsNode: REpNode_t;
1871+begin
1872+ result := MakeInternalNode(reop_Union, MakeLeaf($1, $09), MakeLeaf($0B, $0C));
1873+ result := MakeInternalNode(reop_Union, result, MakeLeaf($0E, $FCFC));
1874+end;
1875+
1876+{引数が aStartChar <= aEndChar の関係を満たしているときに、MakeLeafを呼ぶ
1877+ それ以外は、nil を返す。}
1878+function TREParseTree.Check_and_MakeLeaf(aStartChar, aEndChar: WChar_t):REpNode_t;
1879+begin
1880+ if aStartChar <= aEndChar then begin
1881+ result := MakeLeaf(aStartChar, aEndChar);
1882+ end else
1883+ result := nil;
1884+end;
1885+
1886+{葉を内部節に変える。}
1887+procedure TREParseTree.ChangeLeaftoNode(pLeaf, pLeft, pRight: REpNode_t);
1888+begin
1889+ if (pLeft = nil) or (pRight = nil) then
1890+ raise Exception.Create('TREParseTree : 致命的エラー');{ debug }
1891+ with pLeaf^ do begin
1892+ op := reop_Union;
1893+ Children.pLeft := pLeft;
1894+ Children.pRight := pRight;
1895+ end;
1896+ FLeafList.Remove(pLeaf);
1897+ try
1898+ FNodeList.Add(pLeaf);
1899+ except
1900+ on EOutOfMemory do begin
1901+ FreeMem(pLeaf, SizeOf(RENode_t));
1902+ raise;
1903+ end;
1904+ end;
1905+end;
1906+
1907+{機能： 個々の葉が持つキャラクタ範囲が１つも重複しないようにする。
1908+ 解説： 葉は、CharClassフィールドを持ち、CharClassフィールドはStartCharとEndChar
1909+ をフィールドに持つレコードである。
1910+ 個々の葉が持つキャラクタの範囲が重複しないか調べて、重複する場合には、
1911+ その葉を分割し、reop_Unionを持つ内部節で等価な部分木に直す。}
1912+procedure TREParseTree.ForceCharClassUnique;
1913+var
1914+ i, j: Integer;
1915+ Changed: Boolean;
1916+
1917+ {機能： 重複するキャラクタ範囲をもつ葉の分割
1918+ 解説： ２つの葉pCCLeaf1とpCCLeaf2のキャラクタ範囲を調べて、重複するときは
1919+ 分割するして等価な部分木に変換する。}
1920+ function SplitCharClass(pCCLeaf1, pCCLeaf2: REpNode_t): Boolean;
1921+ var
1922+ pNode1, pNode2, pNode3: REpNode_t;
1923+ S1, S2, SmallE, BigE: WChar_t;
1924+ begin
1925+ result := False;
1926+ {前処理： pCCLeaf1 のStartChar <= pCCLeaf2 のStartChar を保証する}
1927+ if pCCLeaf1^.CharClass.StartChar > pCCLeaf2^.CharClass.StartChar then begin
1928+ pNode1 := pCCLeaf1;
1929+ pCCLeaf1 := pCCLeaf2;
1930+ pCCLeaf2 := pNode1;
1931+ end;
1932+
1933+ {キャラクタクラスの範囲が重複しない 又は 同一ならば Exit
1934+ ※ MakeLeafメソッドの構造からいって最初は重複する事はないが、分割を繰り返す
1935+ と重複する可能性がある。}
1936+ if (pCCLeaf1^.CharClass.EndChar < pCCLeaf2^.CharClass.StartChar) or
1937+ (pCCLeaf1^.CharClass.Chars = pCCLeaf2^.CharClass.Chars) then
1938+ exit;
1939+
1940+ {(pCCLeaf1 のStartChar) S1 <= S2 (pCCLeaf2 のStartChar)}
1941+ S1 := pCCLeaf1^.CharClass.StartChar;
1942+ S2 := pCCLeaf2^.CharClass.StartChar;
1943+
1944+ {SmallE は、pCCLeaf1, pCCLeaf2 の EndChar の小さい方
1945+ SmallE <= E2}
1946+ if pCCLeaf1^.CharClass.EndChar > pCCLeaf2^.CharClass.EndChar then begin
1947+ SmallE := pCCLeaf2^.CharClass.EndChar;
1948+ BigE := pCCLeaf1^.CharClass.EndChar;
1949+ end else begin
1950+ SmallE := pCCLeaf1^.CharClass.EndChar;
1951+ BigE := pCCLeaf2^.CharClass.EndChar;
1952+ end;
1953+
1954+ pNode1 := Check_and_MakeLeaf(S1, S2-1);
1955+ pNode2 := Check_and_MakeLeaf(S2, SmallE);
1956+ pNode3 := Check_and_MakeLeaf(SmallE+1, BigE);
1957+ {if (pNode1 = nil) and (pNode2 = nil) and (pNode3 = nil) then
1958+ raise ERegExpParser.Create('致命的なエラー', 0); }
1959+ if pNode1 = nil then begin {S1 = S2 のとき}
1960+ if pCCLeaf1^.CharClass.EndChar = BigE then
1961+ ChangeLeaftoNode(pCCLeaf1, pNode2, pNode3)
1962+ else
1963+ ChangeLeaftoNode(pCCLeaf2, pNode2, pNode3);
1964+ end else if pNode3 = nil then begin {SmallE = BigE の時}
1965+ ChangeLeaftoNode(pCCLeaf1, pNode1, pNode2);
1966+ end else begin
1967+ if pCCLeaf1^.CharClass.EndChar = BigE then begin{pCCLeaf1にpCCLeaf2が含まれる}
1968+ ChangeLeaftoNode(pCCLeaf1, MakeInternalNode(reop_Union, pNode1, pNode2),
1969+ pNode3)
1970+ end else begin {pCCLeaf1 と pCCLeaf2 の１部分が重なっている}
1971+ ChangeLeaftoNode(pCCLeaf1, pNode1, pNode2);
1972+ ChangeLeaftoNode(pCCLeaf2, pNode2, pNode3);
1973+ end;
1974+ end;
1975+ result := True;
1976+ end;
1977+begin {procedure TREParser.ForceCharClassUnique}
1978+ i := 0;
1979+ while i < LeafList.Count do begin
1980+ j := i + 1;
1981+ Changed := False;
1982+ while j < LeafList.Count do begin
1983+ Changed := SplitCharClass(LeafList[j], LeafList[i]);
1984+ if not Changed then
1985+ Inc(j)
1986+ else
1987+ break;
1988+ end;
1989+ if not Changed then
1990+ Inc(i);
1991+ end;
1992+end; {procedure TREParser.ForceCharClassUnique}
1993+
1994+procedure TREParseTree.DisposeTree;
1995+var
1996+ i: Integer;
1997+begin
1998+ if FNodeList <> nil then begin
1999+ for i := 0 to FNodeList.Count - 1 do begin
2000+ if FNodeList[i] <> nil then
2001+ Dispose(REpNode_t(FNodeList.Items[i]));
2002+ end;
2003+ FNodeList.Clear;
2004+ end;
2005+
2006+ if FLeafList <> nil then begin
2007+ for i := 0 to FLeafList.Count -1 do begin
2008+ if FLeafList[i] <> nil then
2009+ Dispose(REpNode_t(FLeafList[i]));
2010+ end;
2011+ FLeafList.Clear;
2012+ end;
2013+ FpHeadNode := nil;
2014+end;
2015+
2016+{-=========================== TREParser Class ===============================-}
2017+constructor TREParser.Create(RegExpStr: String);
2018+begin
2019+ inherited Create;
2020+ FScanner := TREScanner.Create(RegExpStr);
2021+ FParseTree := TREParseTree.Create;
2022+ {準備完了。 Runメソッドを呼べば構文解析をする。}
2023+end;
2024+
2025+destructor TREParser.Destroy;
2026+begin
2027+ FScanner.Free;
2028+ FParseTree.Free;
2029+ inherited Destroy;
2030+end;
2031+
2032+{**************************************************************************
2033+ 正規表現をパースするメソッド群
2034+ **************************************************************************}
2035+procedure TREParser.Run;
2036+begin
2037+ FParseTree.DisposeTree; {すでにある構文木を廃棄して初期化}
2038+
2039+ FScanner.GetToken; {最初のトークンを読み込む}
2040+
2041+ {正規表現をパースする}
2042+ FParseTree.pHeadNode := regexp;
2043+
2044+ {次のトークンがretk_End でなければエラー}
2045+ if FScanner.Token <> retk_End then begin
2046+ raise ERegExpParser.Create('正規表現に余分な文字があります',
2047+ FScanner.Index);
2048+ end;
2049+
2050+ FParseTree.ForceCharClassUnique;{キャラクタクラスを分割してユニークにする}
2051+end;
2052+
2053+{ <regexp>をパースして、得られた構文木を返す。
2054+ 選択 X|Y を解析する }
2055+function TREParser.regexp: REpNode_t;
2056+begin
2057+ result := term;
2058+ while FScanner.Token = retk_Union do begin
2059+ FScanner.GetToken;
2060+ result := FParseTree.MakeInternalNode(reop_union, result, term);
2061+ end;
2062+end;
2063+
2064+{ <term>をパースして、得られた構文木を返す
2065+ 連結ＸＹを解析する}
2066+function TREParser.Term: REpNode_t;
2067+begin
2068+ if (FScanner.Token = retk_Union) or
2069+ (FScanner.Token = retk_RPar) or
2070+ (FScanner.Token = retk_End) then
2071+ result := FParseTree.MakeInternalNode(reop_Empty, nil, nil)
2072+ else begin
2073+ result := factor;
2074+ while (FScanner.Token <> retk_Union) and
2075+ (FScanner.Token <> retk_RPar) and
2076+ (FScanner.Token <> retk_End) do begin
2077+ result := FParseTree.MakeInternalNode(reop_concat, result, factor);
2078+ end;
2079+ end;
2080+end;
2081+
2082+{ <factor>をパースして、得られた構文木を返す
2083+ 繰り返しX*, X+, X?を解析する}
2084+function TREParser.Factor: REpNode_t;
2085+begin
2086+ result := primary;
2087+ if FScanner.Token = retk_Star then begin
2088+ result := FParseTree.MakeInternalNode(reop_closure, result, nil);
2089+ FScanner.GetToken;
2090+ end else if FScanner.Token = retk_Plus then begin
2091+ result := FParseTree.MakeInternalNode(reop_concat, result,
2092+ FParseTree.MakeInternalNode(reop_closure, result, nil));
2093+ FScanner.GetToken;
2094+ end else if FScanner.Token = retk_QMark then begin
2095+ result := FParseTree.MakeInternalNode(reop_Union, result,
2096+ FParseTree.MakeInternalNode(reop_Empty, nil, nil));
2097+ FScanner.GetToken;
2098+ end;
2099+end;
2100+
2101+{ <primary>をパースして、得られた構文木を返す。
2102+ 文字そのもの、(X)を解析する}
2103+function TREParser.Primary: REpNode_t;
2104+begin
2105+ case FScanner.Token of
2106+ retk_Char: begin
2107+ result := FParseTree.MakeLeaf(FScanner.Symbol.WChar, FScanner.Symbol.WChar);
2108+ FScanner.GetToken;
2109+ end;
2110+ retk_LHead: begin
2111+ result := FParseTree.MakeLHeadNode(FScanner.Symbol.WChar);
2112+ FScanner.GetToken;
2113+ end;
2114+ retk_LTail: begin
2115+ result := FParseTree.MakeLTailNode(FScanner.Symbol.WChar);
2116+ FScanner.GetToken;
2117+ end;
2118+ retk_Dot: begin
2119+ result := FParseTree.MakeAnyCharsNode;
2120+ FScanner.GetToken;
2121+ end;
2122+ retk_LPar: begin
2123+ FScanner.GetToken;
2124+ result := regexp;
2125+ if FScanner.Token <> retk_RPar then
2126+ raise ERegExpParser.Create('右(閉じ)括弧が必要です', FScanner.Index);
2127+ FScanner.GetToken;
2128+ end;
2129+ retk_LBra, retk_LBraNeg: begin
2130+ if FScanner.Token = retk_LBra then
2131+ result := CharacterClass(FParseTree)
2132+ else
2133+ result := NegativeCharacterClass;
2134+ if FScanner.Token <> retk_RBra then
2135+ raise ERegExpParser.Create('右ブラケット"]"が必要です', FScanner.Index);
2136+ FScanner.GetToken;
2137+ end;
2138+ else
2139+ raise ERegExpParser.Create('普通の文字、または左括弧"("が必要です', FScanner.Index);
2140+ end;
2141+end;
2142+
2143+{ <charclass> をパースして、得られた構文木を返す。
2144+ [] で括られた正規表現を解析する}
2145+function TREParser.CharacterClass(aParseTree: TREParseTree): REpNode_t;
2146+ {Tokenに対応した葉を作る}
2147+ function WCharToLeaf: REpNode_t;
2148+ begin
2149+ result := nil;
2150+ case FScanner.Token of
2151+ retk_Char:
2152+ result := aParseTree.MakeLeaf(FScanner.Symbol.WChar, FScanner.Symbol.WChar);
2153+
2154+ retk_CharClass:
2155+ result := aParseTree.MakeLeaf(FScanner.Symbol.CharClass.StartChar,
2156+ FScanner.Symbol.CharClass.EndChar);
2157+ end;
2158+ end;
2159+begin {function TREParser.CharacterClass}
2160+ FScanner.GetToken; {GetScannerCCは、retk_RBra, retk_Char, retk_CharClassしか返さない}
2161+ if FScanner.Token = retk_RBra then
2162+ raise ERegExpParser.Create('不正なキャラクタクラス指定です。', FScanner.Index);
2163+
2164+ result := WCharToLeaf;
2165+ FScanner.GetToken;
2166+ while FScanner.Token <> retk_RBra do begin
2167+ result := aParseTree.MakeInternalNode(reop_Union, result, WCharToLeaf);
2168+ FScanner.GetToken;
2169+ end;
2170+
2171+end;{function TREParser.CharacterClass}
2172+
2173+
2174+{ <negative charclass>をパースして、得られた構文木を返す。
2175+ [^ ] で括られた正規表現を解析する}
2176+function TREParser.NegativeCharacterClass: REpNode_t;
2177+var
2178+ aParseTree, aNeg_ParseTree: TREParseTree;
2179+ i: Integer;
2180+ aCharClass: RECharClass_t;
2181+ procedure RemoveCC(pLeaf: REpNode_t);
2182+ var
2183+ i: Integer;
2184+ pANode, pNode1, pNode2: REpNode_t;
2185+ begin
2186+ i := 0;
2187+ while i < aNeg_ParseTree.LeafList.Count do begin
2188+ pANode := aNeg_ParseTree.LeafList[i];
2189+ if (pLeaf^.CharClass.EndChar < pANode^.CharClass.StartChar) or
2190+ (pLeaf^.CharClass.StartChar > pANode^.CharClass.EndChar) then
2191+ Inc(i)
2192+ else begin
2193+ pNode1 := aNeg_ParseTree.Check_and_MakeLeaf(pANode^.CharClass.StartChar,
2194+ pLeaf^.CharClass.StartChar-1);
2195+ pNode2 := aNeg_ParseTree.Check_and_MakeLeaf(pLeaf^.CharClass.EndChar+1,
2196+ pANode^.CharClass.EndChar);
2197+ if (pNode1 <> nil) or (pNode2 <> nil) then begin
2198+ Dispose(REpNode_t(aNeg_ParseTree.LeafList[i]));
2199+ aNeg_ParseTree.LeafList.Delete(i);
2200+//======== 2015/01/07 mod zako ========
2201+ end else begin
2202+ Inc(i);
2203+//======== 2015/01/07 mod zako ========
2204+ end;
2205+ end;
2206+ end;
2207+ end;
2208+begin
2209+{ [^abc] = . - [abc] という動作をする。}
2210+
2211+ aParseTree := TREParseTree.Create;
2212+ try
2213+ aNeg_ParseTree := TREParseTree.Create;
2214+ try
2215+ {aParseTreeに'[]'で囲まれたキャラクタクラス正規表現の中に対応する節を作る。}
2216+ aParseTree.pHeadNode := CharacterClass(aParseTree);
2217+ {aParseTreeの葉が持つキャラクタクラスの範囲が重複しないように整形}
2218+ aParseTree.ForceCharClassUnique;
2219+
2220+ {任意の一文字を表す木をaNeg_ParseTreeに作成}
2221+ aNeg_ParseTree.MakeAnyCharsNode;
2222+
2223+ for i := 0 to aParseTree.LeafList.Count-1 do begin
2224+ {aNeg_ParseTreeの葉からaParseTreeの葉と同じ物を削除}
2225+ RemoveCC(aParseTree.LeafList[i]);
2226+ end;
2227+
2228+ {aNeg_ParseTreeの葉をFParseTreeにコピー}
2229+ result := nil;
2230+ if aNeg_ParseTree.LeafList.Count > 0 then begin
2231+ aCharClass := REpNode_t(aNeg_ParseTree.LeafList[0])^.CharClass;
2232+ result := FParseTree.MakeLeaf(aCharClass.StartChar, aCharClass.EndChar);
2233+ for i := 1 to aNeg_ParseTree.LeafList.Count-1 do begin
2234+ aCharClass := REpNode_t(aNeg_ParseTree.LeafList[i])^.CharClass;
2235+ result := FParseTree.MakeInternalNode(reop_Union, result,
2236+ FParseTree.MakeLeaf(aCharClass.StartChar, aCharClass.EndChar));
2237+ end;
2238+ end;
2239+ finally
2240+ aNeg_ParseTree.Free;
2241+ end;
2242+ finally
2243+ aParseTree.Free;
2244+ end;
2245+end;
2246+
2247+{$IFDEF DEBUG}
2248+function DebugWCharToStr(WChar: WChar_t): String;
2249+begin
2250+ if WChar > $FF then
2251+ result := ' ' + Chr(Hi(WChar))+Chr(Lo(WChar))+'($' + IntToHex(WChar, 4) + ')'
2252+ else
2253+ result := ' ' + Chr(Lo(WChar))+' ($00' + IntToHex(WChar, 2) + ')';
2254+
2255+end;
2256+
2257+{ デバッグ用メッソッド。構文木をVCL のTOutLineコンポーネントに書き込む}
2258+{ 構文木が大きすぎると、TOutLineコンポーネントが”死ぬ”ので注意}
2259+procedure TREParser.WriteParseTreeToOutLine(anOutLine: TOutLine);
2260+ procedure SetOutLineRecursive(pTree: REpNode_t; ParentIndex: Integer);
2261+ var
2262+ aStr: String;
2263+ NextParentIndex: Integer;
2264+ begin
2265+ if pTree = nil then
2266+ exit;
2267+
2268+ case pTree^.op of
2269+ reop_Char: begin{ 文字そのもの }
2270+ if pTree^.CharClass.StartChar <> pTree^.CharClass.EndChar then
2271+ aStr := DebugWCharToStr(pTree^.CharClass.StartChar)
2272+ + ' 〜 '+ DebugWCharToStr(pTree^.CharClass.EndChar)
2273+ else
2274+ aStr := DebugWCharToStr(pTree^.CharClass.StartChar);
2275+ end;
2276+ reop_LHead:
2277+ aStr := '文頭 '+DebugWCharToStr(pTree^.CharClass.StartChar);
2278+ reop_LTail:
2279+ aStr := '文尾 '+DebugWCharToStr(pTree^.CharClass.StartChar);
2280+ reop_Concat:{ XY }
2281+ aStr := '連結 ';
2282+ reop_Union:{ X|Y}
2283+ aStr := '選択 "|"';
2284+ reop_Closure:{ X* }
2285+ aStr := '閉包 "*"';
2286+ reop_Empty:{ 空 }
2287+ aStr := '空';
2288+ end;
2289+
2290+ NextParentIndex := anOutLine.AddChild(ParentIndex, aStr);
2291+
2292+ if pTree^.op in [reop_Concat, reop_Union, reop_Closure] then begin
2293+ SetOutLineRecursive(pTree^.Children.pLeft, NextParentIndex);
2294+ SetOutLineRecursive(pTree^.Children.pRight, NextParentIndex);
2295+ end;
2296+ end;
2297+begin
2298+ anOutLine.Clear;
2299+ SetOutLineRecursive(FParseTree.pHeadNode, 0);
2300+end;
2301+
2302+{$ENDIF}
2303+
2304+{ -============================== TRE_NFA Class ==================================-}
2305+constructor TRE_NFA.Create(Parser: TREParser; LHeadWChar, LTailWChar: WChar_t);
2306+begin
2307+ inherited Create;
2308+ FStateList := TList.Create;
2309+ FParser := Parser;
2310+ FLHeadWChar := LHeadWChar;
2311+ FLTailWChar := LTailWChar;
2312+end;
2313+
2314+destructor TRE_NFA.Destroy;
2315+begin
2316+ DisposeStateList;
2317+ inherited Destroy;
2318+end;
2319+
2320+{ NFA状態表を破棄する}
2321+procedure TRE_NFA.DisposeStateList;
2322+var
2323+ i: Integer;
2324+ pNFANode, pNext: RE_pNFANode_t;
2325+begin
2326+ if FStateList <> nil then begin
2327+ for i := 0 to FStateList.Count-1 do begin
2328+ pNFANode := FStateList.Items[i];
2329+ while pNFANode <> nil do begin
2330+ pNext := pNFANode^.Next;
2331+ Dispose(pNFANode);
2332+ pNFANode := pNext;
2333+ end;
2334+ end;
2335+ FStateList.Free;
2336+ FStateList := nil;
2337+ end;
2338+end;
2339+
2340+{ 構文木 Treeに対応するNFAを生成する}
2341+procedure TRE_NFA.Run;
2342+begin
2343+ { NFA の初期状態のノードを割り当てる。}
2344+ FEntryState := NumberNode;
2345+
2346+ { NFA の終了状態のノードを割り当てる }
2347+ FExitState := NumberNode;
2348+
2349+ { NFA を生成する }
2350+ GenerateStateList(FParser.ParseTree.pHeadNode, FEntryState, FExitState);
2351+end;
2352+
2353+{ ノードに番号を割り当てる}
2354+function TRE_NFA.NumberNode: Integer;
2355+begin
2356+ with FStateList do begin
2357+ result := Add(nil);
2358+ end;
2359+end;
2360+
2361+{ NFA状態節 を１つ作成}
2362+function TRE_NFA.MakeNFANode: RE_pNFANode_t;
2363+begin
2364+ New(result);
2365+end;
2366+
2367+{ FStateListに状態遷移を追加する。
2368+ 状態 TransFrom に対して aCharClass内の文字で状態 TransTo への遷移を追加する。}
2369+procedure TRE_NFA.AddTransition(TransFrom, TransTo: Integer;
2370+ aCharClass: RECharClass_t); {Char}
2371+var
2372+ pNFANode: RE_pNFANode_t;
2373+begin
2374+ pNFANode := MakeNFANode;
2375+
2376+ with pNFANode^ do begin
2377+ CharClass := aCharClass;
2378+ TransitTo := TransTo;
2379+ Next := RE_pNFANode_t(FStateList.Items[TransFrom]);
2380+ end;
2381+ FStateList.Items[TransFrom] := pNFANode;
2382+end;
2383+
2384+{ 構文木 pTree に対する StateListを生成する
2385+ NFAの入り口をentry, 出口をway_outとする }
2386+procedure TRE_NFA.GenerateStateList(pTree: REpNode_t; entry, way_out: Integer);
2387+var
2388+ aState1, aState2: Integer;
2389+ aCharClass: RECharClass_t;
2390+begin
2391+ case pTree^.op of
2392+ reop_Char:
2393+ AddTransition(entry, way_out, pTree^.CharClass);
2394+ reop_LHead: begin {'^'}
2395+ {文頭メタキャラクタ'^' は TransFrom = FEntryStateのとき以外は、
2396+ 通常のキャラクタとして扱う。}
2397+ if Entry <> FEntryState then begin
2398+ AddTransition(entry, way_out, pTree^.CharClass);
2399+ end else begin
2400+ FRegExpHasLHead := True;
2401+ with aCharClass do begin
2402+ StartChar := FLHeadWChar;
2403+ EndChar := FLHeadWChar;
2404+ end;
2405+ AddTransition(entry, way_out, aCharClass);
2406+ end;
2407+ end;
2408+ reop_LTail: begin
2409+ {行末メタキャラクタ '$'は、TransTo = FExitStateのとき以外は、
2410+ 通常のキャラクタとして扱う。}
2411+ if way_out <> FExitState then begin
2412+ AddTransition(entry, way_out, pTree^.CharClass);
2413+ end else begin
2414+ FRegExpHasLTail := True;
2415+ with aCharClass do begin
2416+ StartChar := FLTailWChar;
2417+ EndChar := FLTailWChar;
2418+ end;
2419+ AddTransition(entry, way_out, aCharClass);
2420+ end;
2421+ end;
2422+ reop_Union: begin {'|'}
2423+ GenerateStateList(pTree^.Children.pLeft, entry, way_out);
2424+ GenerateStateList(pTree^.Children.pRight, entry, way_out);
2425+ end;
2426+ reop_Closure: begin {'*'}
2427+ aState1 := NumberNode;
2428+ aState2 := NumberNode;
2429+ { 状態 entry → ε遷移 → 状態 aState1}
2430+ AddTransition(entry, aState1, CONST_EMPTYCharClass);
2431+ { 状態 aState1 → (pTree^.Children.pLeft)以下の遷移 → 状態 aState2}
2432+ GenerateStateList(pTree^.Children.pLeft, aState1, aState2);
2433+ { 状態 aState2 → ε遷移 → 状態 aState1}
2434+ AddTransition(aState2, aState1, CONST_EMPTYCharClass);
2435+ { 状態 aState1 → ε遷移 → 状態 way_out}
2436+ AddTransition(aState1, way_out, CONST_EMPTYCharClass);
2437+ end;
2438+ reop_Concat: begin {'AB'}
2439+ aState1 := NumberNode;
2440+ { 状態 entry → (pTree^.Children.pLeft)遷移 → 状態 aState1}
2441+ GenerateStateList(pTree^.Children.pLeft, entry, aState1);
2442+ { 状態 aState1 → (pTree^.Children.pRight)遷移 → 状態 way_out}
2443+ GenerateStateList(pTree^.Children.pRight, aState1, way_out);
2444+ end;
2445+ reop_Empty:
2446+ AddTransition(entry, way_out, CONST_EMPTYCharClass);
2447+ else begin
2448+ raise Exception.Create('This cannot happen in TRE_NFA.GenerateStateList');
2449+ end;
2450+ end;
2451+end;
2452+
2453+{$IFDEF DEBUG}
2454+{TStringsオブジェクトに、NFA の内容を書き込む}
2455+procedure TRE_NFA.WriteNFAtoStrings(Strings: TStrings);
2456+var
2457+ i: Integer;
2458+ pNFANode: RE_pNFANode_t;
2459+ Str: String;
2460+begin
2461+ Strings.clear;
2462+ Strings.BeginUpDate;
2463+ for i := 0 to FStateList.Count-1 do begin
2464+ pNFANode := FStateList.items[i];
2465+ if i = EntryState then
2466+ Str := Format('開始 %2d : ', [i])
2467+ else if i = ExitState then
2468+ Str := Format('終了 %2d : ', [i])
2469+ else
2470+ Str := Format('状態 %2d : ', [i]);
2471+ while pNFANode <> nil do begin
2472+ if pNFANode^.CharClass.StartChar = CONST_EMPTY then
2473+ Str := Str + Format('ε遷移で 状態 %2d へ :',[pNFANode^.TransitTo])
2474+ else if pNFANode^.CharClass.StartChar <> pNFANode^.CharClass.EndChar then
2475+ Str := Str + Format('文字%s から%s で 状態 %2d へ :',
2476+ [DebugWCharToStr(pNFANode^.CharClass.StartChar),
2477+ DebugWCharToStr(pNFANode^.CharClass.EndChar), pNFANode^.TransitTo])
2478+ else if pNFANode^.CharClass.StartChar = FLHeadWChar then begin
2479+ Str := Str + Format('文頭コード%s で 状態 %2d へ :',
2480+ [DebugWCharToStr(pNFANode^.CharClass.StartChar), pNFANode^.TransitTo]);
2481+ end else if pNFANode^.CharClass.StartChar = FLTailWChar then begin
2482+ Str := Str + Format('文尾コード%s で 状態 %2d へ :',
2483+ [DebugWCharToStr(pNFANode^.CharClass.StartChar), pNFANode^.TransitTo]);
2484+ end else
2485+ Str := Str + Format('文字%s で 状態 %2d へ :',
2486+ [DebugWCharToStr(pNFANode^.CharClass.StartChar), pNFANode^.TransitTo]);
2487+
2488+ pNFANode := pNFANode^.Next;
2489+ end;
2490+ Strings.Add(Str);
2491+ end;
2492+ Strings.EndUpDate;
2493+end;
2494+{$ENDIF}
2495+
2496+{ -========================== TRE_NFAStateSet Class =============================-}
2497+constructor TRE_NFAStateSet.Create(StateMax: Integer);
2498+var
2499+ i: Integer;
2500+begin
2501+ inherited Create;
2502+ FCapacity := StateMax div 8 + 1;
2503+ GetMem(FpArray, FCapacity);
2504+ for i := 0 to FCapacity-1 do
2505+ FpArray^[i] := 0;
2506+end;
2507+
2508+destructor TRE_NFAStateSet.Destroy;
2509+begin
2510+ FreeMem(FpArray, FCapacity);
2511+ inherited Destroy;
2512+end;
2513+
2514+function TRE_NFAStateSet.Has(StateIndex: Integer): Boolean;
2515+begin
2516+ result := (FpArray^[StateIndex div 8] and (1 shl (StateIndex mod 8))) <> 0;
2517+end;
2518+
2519+procedure TRE_NFAStateSet.Include(StateIndex: Integer);
2520+begin
2521+ FpArray^[StateIndex div 8] := FpArray^[StateIndex div 8] or
2522+ (1 shl (StateIndex mod 8));
2523+end;
2524+
2525+function TRE_NFAStateSet.Equals(AStateSet: TRE_NFAStateSet): Boolean;
2526+var
2527+ i: Integer;
2528+begin
2529+ result := False;
2530+ for i := 0 to FCapacity - 1 do begin
2531+ if FpArray^[i] <> AStateSet.pArray^[i] then
2532+ exit;
2533+ end;
2534+ result := True;
2535+end;
2536+
2537+{ -============================= TRE_DFA Class ==================================-}
2538+constructor TRE_DFA.Create(NFA: TRE_NFA);
2539+begin
2540+ inherited Create;
2541+ FNFA := NFA;
2542+ FStateList := TList.Create;
2543+end;
2544+
2545+destructor TRE_DFA.Destroy;
2546+begin
2547+ DestroyStateList;
2548+
2549+ inherited Destroy;
2550+end;
2551+
2552+{DFA状態のリストを破棄}
2553+procedure TRE_DFA.DestroyStateList;
2554+var
2555+ i: Integer;
2556+ pDFA_State: RE_pDFAState_t;
2557+ pDFA_StateSub, pNextSub: RE_pDFAStateSub_t;
2558+begin
2559+ if FStateList <> nil then begin
2560+ for i := 0 to FStateList.Count-1 do begin
2561+ pDFA_State := FStateList.Items[i];
2562+ if pDFA_State <> nil then begin
2563+ pDFA_StateSub := pDFA_State^.next;
2564+ while pDFA_StateSub <> nil do begin
2565+ pNextSub := pDFA_StateSub^.next;
2566+ Dispose(pDFA_StateSub);
2567+ pDFA_StateSub := pNextSub;
2568+ end;
2569+ pDFA_State^.StateSet.Free;
2570+ Dispose(pDFA_State);
2571+ end;
2572+ end;
2573+ FStateList.Free;
2574+ FStateList := nil;
2575+ end;
2576+end;
2577+
2578+procedure TRE_DFA.Run;
2579+begin
2580+ FRegExpHasLHead := FNFA.RegExpHasLHead;
2581+ FRegExpHasLTail := FNFA.RegExpHasLTail;
2582+ Convert_NFA_to_DFA; {NFA状態表からDFA状態表を作る}
2583+ StateListSort; {DFA状態表の節を入力キー順に整列する。※検索の高速化のため}
2584+ CheckIfRegExpIsSimple;{正規表現が単純な文字列かチェック}
2585+end;
2586+
2587+{ NFAを等価なＤＦＡへと変換する}
2588+procedure TRE_DFA.Convert_NFA_to_DFA;
2589+var
2590+ Initial_StateSet: TRE_NFAStateSet;
2591+ t: RE_pDFAState_t;
2592+ pDFA_TransNode, pTransNodeHead: RE_pDFATransNode_t;
2593+ pDFA_StateSub: RE_pDFAStateSub_t;
2594+begin
2595+{DFAの初期状態を登録する}
2596+ Initial_StateSet := TRE_NFAStateSet.Create(FNFA.StateList.Count);
2597+ Initial_StateSet.Include(FNFA.EntryState);
2598+ {ＮＦＡ初期状態の集合を求める（ε遷移も含む）}
2599+ Collect_Empty_Transition(Initial_StateSet);
2600+ FpInitialState := Register_DFA_State(Initial_StateSet);
2601+
2602+ {未処理のＤＦＡ状態があれば、それを取り出して処理する
2603+ 注目しているＤＦＡ状態をｔとする}
2604+ t := Fetch_Unvisited_D_state;
2605+ while t <> nil do begin
2606+
2607+ {処理済みの印を付ける}
2608+ t^.visited := True;
2609+
2610+ {状態ｔから遷移可能なDFA状態をすべてDFAに登録する。}
2611+ pTransNodeHead := Compute_Reachable_N_state(t);
2612+ try
2613+ pDFA_TransNode := pTransNodeHead;
2614+ while pDFA_TransNode <> nil do begin
2615+ { NFA状態集合のε-closureを求める}
2616+ Collect_Empty_Transition(pDFA_TransNode^.ToNFAStateSet);
2617+
2618+ { 遷移情報をDFA状態に加える}
2619+ New(pDFA_StateSub);
2620+ with pDFA_StateSub^ do begin
2621+ next := nil;
2622+ CharClass := pDFA_TransNode^.CharClass;
2623+ next := t^.next;
2624+ end;
2625+ t^.next := pDFA_StateSub;
2626+
2627+ {現在のDFA状態からの遷移先の新しいDFA状態を登録}
2628+ pDFA_StateSub^.TransitTo :=
2629+ Register_DFA_State(pDFA_TransNode^.ToNFAStateSet);
2630+ {Register_DFA_StateメソッドによりToNFAStateSetオブジェクトはDFA_Stateに所有される}
2631+ {pDFA_TransNode^.ToNFAStateSet := nil;}
2632+
2633+ pDFA_TransNode := pDFA_TransNode^.next;
2634+ end;
2635+ t := Fetch_Unvisited_D_state;
2636+ finally
2637+ Destroy_DFA_TransList(pTransNodeHead);
2638+ end;
2639+ end;
2640+end;
2641+
2642+{ NFA状態集合 StateSet に対して ε-closure操作を実行する。
2643+ ε遷移で遷移可能な全てのＮＦＡ状態を追加する}
2644+procedure TRE_DFA.Collect_Empty_Transition(StateSet: TRE_NFAStateSet);
2645+var
2646+ i: Integer;
2647+ { NFA状態集合 StateSetにＮＦＡ状態 ｓを追加する。
2648+ 同時にＮＦＡ状態ｓからε遷移で移動できるＮＦＡ状態も追加する}
2649+ procedure Mark_Empty_Transition(StateSet: TRE_NFAStateSet; s: Integer);
2650+ var
2651+ pNFANode: RE_pNFANode_t;
2652+ begin
2653+ StateSet.Include(s);
2654+ pNFANode := FNFA.StateList[s];
2655+ while pNFANode <> nil do begin
2656+ if (pNFANode^.CharClass.StartChar = CONST_EMPTY) and
2657+ (not StateSet.Has(pNFANode^.TransitTo)) then
2658+ Mark_Empty_Transition(StateSet, pNFANode^.TransitTo);
2659+ pNFANode := pNFANode^.next;
2660+ end;
2661+ end;
2662+begin
2663+ for i := 0 to FNFA.StateList.Count-1 do begin
2664+ if StateSet.Has(i) then
2665+ Mark_Empty_Transition(StateSet, i);
2666+ end;
2667+end;
2668+
2669+{ NFA状態集合 aStateSet をＤＦＡに登録して、ＤＦＡ状態へのポインタを返す。
2670+ aStateSetが終了状態を含んでいれば、acceptedフラグをセットする。
2671+ すでにaStateSetがＤＦＡに登録されていたら何もしない}
2672+function TRE_DFA.Register_DFA_State(var aStateSet: TRE_NFAStateSet): RE_pDFAState_t;
2673+var
2674+ i: Integer;
2675+begin
2676+ { NFA状態 aStateSet がすでにＤＦＡに登録されていたら、何もしないでリターンする}
2677+ for i := 0 to FStateList.Count-1 do begin
2678+ if RE_pDFAState_t(FStateList[i])^.StateSet.Equals(aStateSet) then begin
2679+ result := RE_pDFAState_t(FStateList[i]);
2680+ exit;
2681+ end;
2682+ end;
2683+
2684+ {DFAに必要な情報をセットする}
2685+ New(result);
2686+ with result^ do begin
2687+ StateSet := aStateSet;
2688+ visited := False;
2689+ if aStateSet.Has(FNFA.ExitState) then
2690+ accepted := True
2691+ else
2692+ accepted := False;
2693+ next := nil;
2694+ end;
2695+ aStateSet := nil;
2696+ FStateList.add(result);
2697+end;
2698+
2699+{ 処理済みの印がついていないＤＦＡ状態を探す。
2700+ 見つからなければnilを返す。}
2701+function TRE_DFA.Fetch_Unvisited_D_state: RE_pDFAState_t;
2702+var
2703+ i: Integer;
2704+begin
2705+
2706+ for i := 0 to FStateList.Count-1 do begin
2707+ if not RE_pDFAState_t(FStateList[i])^.visited then begin
2708+ result := FStateList[i];
2709+ exit;
2710+ end;
2711+ end;
2712+ result := nil;
2713+end;
2714+
2715+{Compute_Reachable_N_state が作る RE_DFATransNode_t型のリンクリストを破棄する}
2716+procedure TRE_DFA.Destroy_DFA_TransList(pDFA_TransNode: RE_pDFATransNode_t);
2717+var
2718+ pNext: RE_pDFATransNode_t;
2719+begin
2720+ if pDFA_TransNode <> nil then begin
2721+ while pDFA_TransNode <> nil do begin
2722+ pNext := pDFA_TransNode^.next;
2723+ if pDFA_TransNode^.ToNFAStateSet <> nil then
2724+ pDFA_TransNode^.ToNFAStateSet.Free;
2725+ Dispose(pDFA_TransNode);
2726+
2727+ pDFA_TransNode := pNext;
2728+ end;
2729+ end;
2730+end;
2731+
2732+{ DFA状態pDFAStateから遷移可能なNFA状態を探して、リンクリストにして返す}
2733+function TRE_DFA.Compute_Reachable_N_state(pDFAState: RE_pDFAState_t): RE_pDFATransNode_t;
2734+var
2735+ i: Integer;
2736+ pNFANode: RE_pNFANode_t;
2737+ a, b: RE_pDFATransNode_t;
2738+label
2739+ added;
2740+begin
2741+ result := nil;
2742+try
2743+ {すべてのＮＦＡ状態を順に調べる}
2744+ for i := 0 to FNFA.StateList.Count-1 do begin
2745+
2746+ { NFA状態iがDFA状態 pDFAStateに含まれていれば、以下の処理を行う}
2747+ if pDFAState^.StateSet.Has(i) then begin
2748+
2749+ { NFA状態 i から遷移可能なＮＦＡ状態をすべて調べてリストにする}
2750+ pNFANode := RE_pNFANode_t(FNFA.StateList[i]);
2751+ while pNFANode <> nil do begin
2752+ if pNFANode^.CharClass.StartChar <> CONST_EMPTY then begin {ε遷移は無視}
2753+ a := result;
2754+ while a <> nil do begin
2755+ if a^.CharClass.Chars = pNFANode^.CharClass.Chars then begin
2756+ a^.ToNFAStateSet.Include(pNFANode^.TransitTo);
2757+ goto added;
2758+ end;
2759+ a := a^.next;
2760+ end;
2761+ {キャラクタ pNFANode^.CharClass.cによる遷移が登録されていなければ追加}
2762+ New(b);
2763+ with b^ do begin
2764+ CharClass := pNFANode^.CharClass;
2765+ ToNFAStateSet := TRE_NFAStateSet.Create(FNFA.StateList.Count);
2766+ ToNFAStateSet.Include(pNFANode^.TransitTo);
2767+ next := result;
2768+ end;
2769+ result := b;
2770+ added:
2771+ ;
2772+ end;
2773+ pNFANode := pNFANode^.next;
2774+ end;
2775+ end;
2776+ end;
2777+except
2778+ on EOutOfMemory do begin
2779+ Destroy_DFA_TransList(result); {構築中のリスト廃棄}
2780+ raise;
2781+ end;
2782+end;
2783+end;
2784+
2785+{状態リストのリンクリストを整列する(マージ・ソートを使用)}
2786+procedure TRE_DFA.StateListSort;
2787+var
2788+ i: Integer;
2789+ {マージ・ソート処理を再帰的に行う}
2790+ function DoSort(pCell: RE_pDFAStateSub_t): RE_pDFAStateSub_t;
2791+ var
2792+ pMidCell, pACell: RE_pDFAStateSub_t;
2793+
2794+ {2つのリストをソートしながら併合する}
2795+ function MergeList(pCell1, pCell2: RE_pDFAStateSub_t): RE_pDFAStateSub_t;
2796+ var
2797+ Dummy: RE_DFAStateSub_t;
2798+ begin
2799+ Result := @Dummy;
2800+ {どちらかのリストが、空になるまで反復}
2801+ while (pCell1 <> nil) and (pCell2 <> nil) do begin
2802+ {pCell1 と pCell2 を比較して小さい方をResultに追加していく}
2803+ if pCell1^.CharClass.StartChar > pCell2^.CharClass.StartChar then begin
2804+ {pCell2の方が小さい}
2805+ Result^.Next := pCell2;
2806+ Result := pCell2;
2807+ pCell2 := pCell2^.Next;
2808+ end else begin
2809+ {pCell1の方が小さい}
2810+ Result^.Next := pCell1;
2811+ Result := pCell1;
2812+ pCell1 := pCell1^.Next;
2813+ end;
2814+ end;
2815+ {余ったリストをそのままresult に追加}
2816+ if pCell1 = nil then
2817+ Result^.Next := pCell2
2818+ else
2819+ Result^.Next := pCell1;
2820+
2821+ result := Dummy.Next;
2822+ end;
2823+
2824+ {DoSort本体}
2825+ begin
2826+ if (pCell = nil) or (pCell^.Next = nil) then begin
2827+ result := pCell;
2828+ exit; {要素が１つ、または、無いときは、すぐに exit}
2829+ end;
2830+
2831+ {ACell が３番目のセルを指すようにする。無ければ、nil を持たせる}
2832+ {リストが２〜３個のセルを持つときにも、分割を行うようにする。}
2833+ pACell := pCell^.Next^.Next;
2834+ pMidCell := pCell;
2835+ {MidCell が、リストの真ん中あたりのセルを指すようにする。}
2836+ while pACell <> nil do begin
2837+ pMidCell := pMidCell^.Next;
2838+ pACell := pACell^.Next;
2839+ if pACell <> nil then
2840+ pACell := pACell^.Next;
2841+ end;
2842+
2843+ {MidCell の後ろでリストを２分割する}
2844+ pACell := pMidCell^.Next;
2845+ pMidCell^.Next := nil;
2846+
2847+ result := MergeList(DoSort(pCell), DoSort(pACell));
2848+ end;
2849+begin {Sort 本体}
2850+ for i := 0 to FStateList.Count-1 do begin
2851+ RE_pDFAState_t(FStateList[i])^.next :=
2852+ DoSort(RE_pDFAState_t(FStateList[i])^.next);
2853+ end;
2854+end;
2855+
2856+{機能： 現在の正規表現が、普通の文字列か？
2857+ 普通の文字列だったら、FRegExpIsSimple = True; FSimpleRegExpStrに文字列に設定
2858+ それ以外の場合は、 FRegExpIsSimple = False;FSimpleRegExpStr = ''}
2859+procedure TRE_DFA.CheckIfRegExpIsSimple;
2860+var
2861+ pDFAState: RE_pDFAState_t;
2862+ pSub: RE_pDFAStateSub_t;
2863+ WChar: WChar_t;
2864+begin
2865+ FRegExpIsSimple := False;
2866+ FSimpleRegExpStr := '';
2867+
2868+ pDFAState := FpInitialState;
2869+
2870+ while pDFAState <> nil do begin
2871+ pSub := pDFAState^.next;
2872+ if pSub = nil then
2873+ break;
2874+ if (pSub^.next <> nil) or
2875+ {複数のキャラクタを受け入れる}
2876+ (pSub^.CharClass.StartChar <> pSub^.CharClass.EndChar) or
2877+ {キャラクタ範囲を持つ}
2878+ (pDFAState^.Accepted and (pSub^.TransitTo <> nil))
2879+ {受理後もキャラクタを受け入れる}then begin
2880+
2881+ FSimpleRegExpStr := '';
2882+ exit;
2883+ end else begin
2884+ WChar := pSub^.CharClass.StartChar;
2885+ FSimpleRegExpStr := FSimpleRegExpStr + WCharToStr(WChar);
2886+ end;
2887+ pDFAState := pSub^.TransitTo;
2888+ end;
2889+ FRegExpIsSimple := True;
2890+end;
2891+
2892+
2893+{$IFDEF DEBUG}
2894+{TStringsオブジェクトに、DFA の内容を書き込む}
2895+procedure TRE_DFA.WriteDFAtoStrings(Strings: TStrings);
2896+var
2897+ i: Integer;
2898+ pDFA_State: RE_pDFAState_t;
2899+ pDFA_StateSub: RE_pDFAStateSub_t;
2900+ Str: String;
2901+begin
2902+ Strings.clear;
2903+ Strings.BeginUpDate;
2904+ for i := 0 to FStateList.Count-1 do begin
2905+ pDFA_State := FStateList.items[i];
2906+ if pDFA_State = FpInitialState then
2907+ Str := Format('開始 %2d : ', [i])
2908+ else if pDFA_State^.Accepted then
2909+ Str := Format('終了 %2d : ', [i])
2910+ else
2911+ Str := Format('状態 %2d : ', [i]);
2912+ pDFA_StateSub := pDFA_State^.next;
2913+ while pDFA_StateSub <> nil do begin
2914+ if pDFA_StateSub^.CharClass.StartChar <> pDFA_StateSub^.CharClass.EndChar then
2915+ Str := Str + Format('文字 %s から 文字%s で 状態 %2d へ :',
2916+ [DebugWCharToStr(pDFA_StateSub^.CharClass.StartChar),
2917+ DebugWCharToStr(pDFA_StateSub^.CharClass.EndChar),
2918+ FStateList.IndexOf(pDFA_StateSub^.TransitTo)])
2919+
2920+ else if pDFA_StateSub^.CharClass.StartChar = FNFA.LHeadWChar then begin
2921+ Str := Str + Format('文頭コード %s で 状態 %2d へ :',
2922+ [DebugWCharToStr(pDFA_StateSub^.CharClass.StartChar),
2923+ FStateList.IndexOf(pDFA_StateSub^.TransitTo)]);
2924+ end else if pDFA_StateSub^.CharClass.StartChar = FNFA.LTailWChar then begin
2925+ Str := Str + Format('文尾コード %s で 状態 %2d へ :',
2926+ [DebugWCharToStr(pDFA_StateSub^.CharClass.StartChar),
2927+ FStateList.IndexOf(pDFA_StateSub^.TransitTo)]);
2928+ end else
2929+ Str := Str + Format('文字 %s で 状態 %2d へ :',
2930+ [DebugWCharToStr(pDFA_StateSub^.CharClass.StartChar),
2931+ FStateList.IndexOf(pDFA_StateSub^.TransitTo)]);
2932+
2933+ pDFA_StateSub := pDFA_StateSub^.Next;
2934+ end;
2935+ Strings.Add(Str);
2936+ end;
2937+ Strings.EndUpDate;
2938+end;
2939+{$ENDIF}
2940+
2941+{ -=================== TRegularExpression Class ==============================-}
2942+constructor TRegularExpression.Create(AOwner: TComponent);
2943+begin
2944+ inherited Create(AOwner);
2945+ FRegExpList := TStringList.Create;
2946+ FRegExpListMax := 30; {RegExpListの項目数設定 30}
2947+ {FCurrentIndex = 0 はヌルの正規表現で常に使えるようにする。}
2948+ FCurrentIndex := FRegExpList.Add('');
2949+ FPreProcessor := TREPreProcessor.Create('');
2950+ Translate(FRegExpList[FCurrentIndex]);
2951+end;
2952+
2953+destructor TRegularExpression.Destroy;
2954+begin
2955+ FPreProcessor.Free;
2956+ DisposeRegExpList;
2957+ inherited Destroy;
2958+end;
2959+
2960+{正規表現リスト(FRegExpList: TStringList)とObjectsプロパティに結び付けられた
2961+ TRE_DFAオブジェクトを破棄}
2962+procedure TRegularExpression.DisposeRegExpList;
2963+var
2964+ i: Integer;
2965+begin
2966+ if FRegExpList <> nil then begin
2967+ with FRegExpList do begin
2968+ for i := 0 to Count-1 do begin
2969+ TRE_DFA(Objects[i]).Free;
2970+ end;
2971+ end;
2972+ FRegExpList.Free;
2973+ FRegExpList := nil;
2974+ end;
2975+end;
2976+
2977+{ ---------------------- プロパティ アクセス メソッド -----------------}
2978+{RegExpプロパティのwriteメソッド}
2979+procedure TRegularExpression.SetRegExp(Str: String);
2980+var
2981+ OrigRegExp: String;
2982+ function FindRegExpInList(RegExpStr: String): Integer;
2983+ var
2984+ i: Integer;
2985+ begin
2986+ result := -1;
2987+ i := 0;
2988+ while i < FRegExpList.Count do begin
2989+ if RegExpStr = FRegExpList[i] then begin
2990+ result := i;
2991+ exit;
2992+ end;
2993+ Inc(i);
2994+ end;
2995+ end;
2996+begin
2997+ OrigRegExp := Str;{プリプロセッサを通る前の正規表現を退避}
2998+ with FPreProcessor do begin
2999+ TargetRegExpStr := Str;
3000+ Run;
3001+ Str := ProcessedRegExpStr;
3002+ end;
3003+
3004+ try
3005+ FCurrentIndex := FindRegExpInList(Str);
3006+ {FRegExpList内にキャッシュされていないときは、コンパイル}
3007+ if FCurrentIndex = -1 then begin
3008+ if FRegExpList.Count = FRegExpListMax then begin
3009+ TRE_DFA(FRegExpList.Objects[FRegExpList.Count-1]).Free;
3010+ FRegExpList.Delete(FRegExpList.Count-1);
3011+ end;
3012+ FRegExpList.Insert(1, Str);
3013+ FCurrentIndex := 1;
3014+ Translate(FRegExpList[1]);
3015+ end;
3016+ FRegExp := OrigRegExp;
3017+ except
3018+ {例外が発生したときは、常にヌル正規表現を設定する。}
3019+ on Exception do begin
3020+ FCurrentIndex := 0;
3021+ FRegExp := '';
3022+ raise;
3023+ end;
3024+ end;
3025+end;
3026+
3027+{RegExpプロパティのreadメソッド}
3028+function TRegularExpression.GetProcessedRegExp: String;
3029+begin
3030+ result := FRegExpList[FCurrentIndex];
3031+end;
3032+
3033+{ListOfFuzzyCharDicプロパティ readメソッド}
3034+function TRegularExpression.GetListOfFuzzyCharDic: TList;
3035+begin
3036+ result := FPreProcessor.ListOfFuzzyCharDic;
3037+end;
3038+
3039+{GetListOfSynonymDicプロパティ readメソッド}
3040+function TRegularExpression.GetListOfSynonymDic: TList;
3041+begin
3042+ result := FPreProcessor.ListOfSynonymDic;
3043+end;
3044+
3045+{RegExpIsSimpleプロパティ readメソッド}
3046+function TRegularExpression.GetRegExpIsSimple: Boolean;
3047+begin
3048+ result := GetCurrentDFA.RegExpIsSimple;
3049+end;
3050+
3051+{SimpleRegExpプロパティ readメソッド}
3052+function TRegularExpression.GetSimpleRegExp: String;
3053+begin
3054+ result := GetCurrentDFA.SimpleRegExpStr;
3055+end;
3056+
3057+{HasLHeadプロパティ readメソッド}
3058+function TRegularExpression.GetHasLHead: Boolean;
3059+begin
3060+ result := GetCurrentDFA.RegExpHasLHead;
3061+end;
3062+
3063+{HasLTailプロパティ writeメソッド}
3064+function TRegularExpression.GetHasLTail: Boolean;
3065+begin
3066+ result := GetCurrentDFA.RegExpHasLTail;
3067+end;
3068+
3069+{現在の正規表現に対応するTRE_DFA型オブジェクトを得る}
3070+function TRegularExpression.GetCurrentDFA: TRE_DFA;
3071+begin
3072+ result := TRE_DFA(FRegExpList.Objects[FCurrentIndex]);
3073+end;
3074+
3075+{DFA状態表の初期状態を表すノードへのポインタを得ることができる。}
3076+function TRegularExpression.GetpInitialDFAState: RE_pDFAState_t;
3077+begin
3078+ result := TRE_DFA(FRegExpList.Objects[FCurrentIndex]).pInitialState;
3079+end;
3080+
3081+function TRegularExpression.GetUseFuzzyCharDic: Boolean;
3082+begin
3083+ result := FPreProcessor.UseFuzzyCharDic;
3084+end;
3085+
3086+procedure TRegularExpression.SetUseFuzzyCharDic(Val: Boolean);
3087+begin
3088+ FPreProcessor.UseFuzzyCharDic := Val;
3089+ Self.RegExp := FRegExp; {新しい設定で再コンパイル}
3090+end;
3091+
3092+function TRegularExpression.GetUseSynonymDic: Boolean;
3093+begin
3094+ result := FPreProcessor.UseSynonymDic;
3095+end;
3096+
3097+procedure TRegularExpression.SetUseSynonymDic(Val: Boolean);
3098+begin
3099+ FPreProcessor.UseSynonymDic := Val;
3100+ Self.RegExp := FRegExp; {新しい設定で再コンパイル}
3101+end;
3102+
3103+function TRegularExpression.GetLineHeadWChar: WChar_t;
3104+begin
3105+ result := CONST_LINEHEAD;
3106+end;
3107+
3108+function TRegularExpression.GetLineTailWChar: WChar_t;
3109+begin
3110+ result := CONST_LINETAIL;
3111+end;
3112+
3113+{***** 正規表現文字列→構文木構造→NFA→DFA の変換を行う *****}
3114+procedure TRegularExpression.Translate(RegExpStr: String);
3115+var
3116+ DFA: TRE_DFA;
3117+ Parser: TREParser;
3118+ NFA: TRE_NFA;
3119+begin
3120+ DFA := nil;
3121+ try
3122+ Parser := TREParser.Create(RegExpStr);
3123+ try
3124+ Parser.Run;
3125+ NFA := TRE_NFA.Create(Parser, GetLineHeadWChar, GetLineTailWChar);
3126+ try
3127+ Self.FLineHeadWChar := NFA.LHeadWChar;
3128+ Self.FLineTailWChar := NFA.LTailWChar;
3129+ NFA.Run;
3130+ DFA := TRE_DFA.Create(NFA);
3131+ FRegExpList.Objects[FCurrentIndex] := DFA;
3132+ TRE_DFA(FRegExpList.Objects[FCurrentIndex]).Run;
3133+ finally
3134+ NFA.Free;
3135+ end;
3136+ finally
3137+ Parser.Free;
3138+ end;
3139+ except
3140+ On Exception do begin
3141+ DFA.Free;
3142+ FRegExpList.Delete(FCurrentIndex);
3143+ FCurrentIndex := 0;
3144+ raise;
3145+ end;
3146+ end;
3147+end;
3148+
3149+{状態 DFAstateから文字ｃによって遷移して、遷移後の状態を返す。
3150+ 文字ｃによって遷移出来なければnilを返す}
3151+function TRegularExpression.NextDFAState(DFAState: RE_pDFAState_t; c: WChar_t): RE_pDFAState_t;
3152+var
3153+ pSub: RE_pDFAStateSub_t;
3154+begin
3155+ {１つのDFAStateが持つ pSubのリンクではキャラクタクラスが昇順にならんでいること
3156+ を前提としている。}
3157+ result := nil;
3158+ pSub := DFAState^.next;
3159+ while pSub <> nil do begin
3160+ if c < pSub^.CharClass.StartChar then
3161+ exit
3162+ else if c <= pSub^.CharClass.EndChar then begin
3163+ result := pSub^.TransitTo;
3164+ exit;
3165+ end;
3166+ pSub := pSub^.next;
3167+ end;
3168+end;
3169+
3170+constructor TMatchCORE.Create(AOwner: TComponent);
3171+begin
3172+ inherited Create(AOwner);
3173+ FLineSeparator := mcls_CRLF;
3174+end;
3175+
3176+procedure TMatchCORE.MatchStd(pText: PChar; var pStart, pEnd: PChar);
3177+var
3178+ pDFAState: RE_pDFAState_t;
3179+ pp: PChar;
3180+begin
3181+ pStart := nil;
3182+ pEnd := nil;
3183+
3184+ {pTextがヌル文字列で、正規表現がヌル文字列に一致するとき}
3185+ if (Byte(pText^) = CONST_NULL) and GetCurrentDFA.pInitialState.Accepted then begin
3186+ pStart := pText;
3187+ pEnd := pText;
3188+ exit;
3189+ end;
3190+
3191+ {注目点を１文字づつずらしながらマッチする最左部分を見つける}
3192+ while Byte(pText^) <> CONST_NULL do begin
3193+ {DFAの初期状態を設定}
3194+ pDFAState := Self.GetCurrentDFA.pInitialState;
3195+ pp := pText;
3196+ {DFA状態表に文字を入力していってマッチする最長部分を見つける}
3197+ repeat
3198+ if pDFAState^.accepted then begin
3199+ {終了状態であれば場所を記録しておく。
3200+ 結果としてマッチした最左最長部分が記録される}
3201+ pStart := pText;
3202+ pEnd := pp;
3203+ end;
3204+ {次の状態に遷移}
3205+ pDFAState := NextDFAState(pDFAState, PCharGetWChar(pp));
3206+ until pDFAState = nil;
3207+
3208+ {マッチしたときはExit}
3209+ if pStart <> nil then
3210+ exit;
3211+
3212+ {注目位置を１文字分進める。}
3213+ if IsDBCSLeadByte(Byte(pText^)) then
3214+ Inc(pText, 2)
3215+ else
3216+ Inc(pText);
3217+ end;
3218+ {マッチしない。}
3219+end;
3220+
3221+procedure TMatchCORE.MatchEX(pText: PChar; var pStart, pEnd: PChar);
3222+begin
3223+ pStart := pText;
3224+ pEnd := MatchHead(pText, GetCurrentDFA.pInitialState);
3225+ if pEnd = nil then
3226+ MatchEX_Inside(pText, pStart, pEnd);
3227+end;
3228+
3229+procedure TMatchCORE.MatchEX_Inside(pText: PChar; var pStart, pEnd: PChar);
3230+var
3231+ DFA: TRE_DFA;
3232+ pInitialDFAState: RE_pDFAState_t;
3233+begin
3234+ pStart := nil;
3235+ pEnd := nil;
3236+
3237+ DFA := GetCurrentDFA;
3238+ pInitialDFAState := DFA.pInitialState;
3239+ while Byte(pText^) <> CONST_NULL do begin
3240+ pEnd := MatchInSide(pText, pInitialDFAState);
3241+ if pEnd <> nil then begin
3242+ pStart := pText;
3243+ exit;
3244+ end else if (Byte(pText^) = CONST_LF) and
3245+ DFA.RegExpHasLHead then begin
3246+ pEnd := MatchHead(pText+1, pInitialDFAState);
3247+ if pEnd <> nil then begin
3248+ pStart := pText+1;
3249+ exit;
3250+ end;
3251+ end;
3252+ {注目位置を１文字分進める。}
3253+ if IsDBCSLeadByte(Byte(pText^)) then
3254+ Inc(pText, 2)
3255+ else
3256+ Inc(pText);
3257+ end;
3258+
3259+ if DFA.RegExpHasLTail and (NextDFAState(pInitialDFAState, LineTailWChar) <> nil) then begin
3260+ {正規表現が文尾メタキャラクタのみのとき(RegExp = '$')の特殊処理}
3261+ pStart := pText;
3262+ pEnd := pText;
3263+ end;
3264+ end;
3265+
3266+function TMatchCORE.MatchHead(pText: PChar; pDFAState: RE_pDFAState_t): PChar;
3267+var
3268+ pEnd: PChar;
3269+begin
3270+{正規表現が行頭メタキャラクタを含んでいる}
3271+ if GetCurrentDFA.RegExpHasLHead then begin
3272+ result := MatchInSide(pText, NextDFAState(pDFAState, LineHeadWChar));
3273+ if result <> nil then begin
3274+ {マッチした。この時点で、result <> nil 確定}
3275+ pEnd := result;
3276+ {さらに、RegExp = '(^Love|Love me tender)'で、Text = 'Love me tender. Love me sweet'
3277+ の場合に最左最長でマッチするのは、'Love me tender'でなければならないので、その為の
3278+ マッチ検査を行う。}
3279+ result := MatchInside(pText, pDFAState);
3280+ if (result = nil) or (pEnd > result) then
3281+ result := pEnd;
3282+ end;
3283+ end else begin
3284+{正規表現が行頭メタキャラクタを含んでいない}
3285+ result := MatchInside(pText, pDFAState);
3286+ end;
3287+end;
3288+
3289+function TMatchCORE.MatchInside(pText: PChar; pDFAState: RE_pDFAState_t): PChar;
3290+var
3291+ pEnd: PChar;
3292+ WChar: WChar_t;
3293+ pPrevDFAState: RE_pDFAState_t;
3294+begin
3295+ result := nil;
3296+ pEnd := pText;
3297+
3298+ if pDFAState = nil then
3299+ exit;
3300+ repeat
3301+ if pDFAState^.accepted then begin
3302+ {終了状態であれば場所を記録しておく。
3303+ 結果としてマッチした最左最長部分が記録される}
3304+ result := pEnd;
3305+ end;
3306+ pPrevDFAState := pDFAState;
3307+ {DFAを状態遷移させる}
3308+ WChar := PCharGetWChar(pEnd);
3309+ pDFAState := NextDFAState(pDFAState, WChar);
3310+ until pDFAState = nil;
3311+
3312+ if (IsLineEnd(WChar) or (WChar = CONST_NULL)) and
3313+ (NextDFAState(pPrevDFAState, LineTailWChar) <> nil) then begin
3314+ {行末メタキャラクタを入力して、nil以外が帰ってくるときは必ず、マッチする}
3315+ result := pEnd;
3316+ if WChar <> CONST_NULL then
3317+ Dec(result); {CR($0d)の分 Decrement}
3318+ end;
3319+end;
3320+
3321+function TMatchCORE.IsLineEnd(WChar: WChar_t): Boolean;
3322+begin
3323+ result := False;
3324+ case FLineSeparator of
3325+ mcls_CRLF: result := (WChar = CONST_CR);
3326+ mcls_LF: result := (WChar = CONST_LF);
3327+ end;
3328+end;
3329+
3330+{ -========================== TAWKStr Class ==================================- }
3331+constructor TAWKStr.Create(AOwner: TComponent);
3332+begin
3333+ inherited Create(AOwner);
3334+
3335+ ListOfFuzzyCharDic.Add(RE_FuzzyCharDic); {キャラクタ同一視辞書を追加}
3336+end;
3337+
3338+procedure TAWKStr.SetRegExp(Str: String);
3339+begin
3340+ inherited SetRegExp(Str);
3341+ if not (HasLHead or HasLTail) then begin
3342+ FMatchProc := MatchStd;
3343+ end else begin
3344+ FMatchProc := MatchEx;
3345+ end;
3346+end;
3347+
3348+{文字列中の'\' で 引用されたキャラクタを処理する。 \n, \t \\ ...}
3349+function TAWKStr.ProcessEscSeq(Text: String): String;
3350+var
3351+ WChar: WChar_t;
3352+ Index: Integer;
3353+begin
3354+ result := '';
3355+ Index := 1;
3356+ while Index <= Length(Text) do begin
3357+ WChar := GetWChar(Text, Index);
3358+ if WChar = Ord('\') then
3359+ result := result + WCharToStr(GetQuotedWChar(Text, Index))
3360+ else
3361+ result := result + WCharToStr(WChar);
3362+ end;
3363+end;
3364+
3365+{Sub, GSubメソッドで使用。 '&'をマッチした文字列に置換える}
3366+function TAWKStr.Substitute_MatchStr_For_ANDChar(Text: String; MatchStr: String): String;
3367+var
3368+ i: Integer;
3369+ aStr: String;
3370+ WCh, WCh2: WChar_t;
3371+begin
3372+ i := 1;
3373+ aStr := '';
3374+{'\&'を'\\&'にしてから}
3375+ while i <= Length(Text) do begin
3376+ WCh := GetWChar(Text, i);
3377+ if WCh = CONST_YEN then begin
3378+ aStr := aStr + WCharToStr(WCh);
3379+
3380+ WCh := GetWChar(Text, i);
3381+ if WCh = CONST_ANP then begin
3382+ aStr := Concat(aStr, WCharToStr(CONST_YEN));
3383+ end;
3384+ end;
3385+ aStr := aStr + WCharToStr(WCh);
3386+ end;
3387+
3388+{エスケープ・シーケンスを処理}
3389+ Text := ProcessEscSeq(aStr);
3390+
3391+{'&' を MatchStrで置換え、'\&'を'&'に置換え}
3392+ result := '';
3393+ i := 1;
3394+ while i <= Length(Text) do begin
3395+ WCh := GetWChar(Text, i);
3396+ if WCh = CONST_ANP then
3397+ result := Concat(result, MatchStr)
3398+ else if WCh = CONST_YEN then begin
3399+ WCh2 := GetWChar(Text, i);
3400+ if WCh2 = CONST_ANP then begin
3401+ result := result + WCharToStr(WCh2);
3402+ end else begin
3403+ if WCh2 <> CONST_NULL then
3404+ UnGetWChar(Text, i);
3405+ result := result + WCharToStr(WCh);
3406+ end;
3407+ end else begin
3408+ result := result + WCharToStr(WCh);
3409+ end;
3410+ end;
3411+end;
3412+
3413+function TAWKStr.Match(Text: String; var RStart, RLength: Integer): Integer;
3414+var
3415+ pStart, pEnd: PChar;
3416+begin
3417+ FMatchProc(PChar(Text), pStart, pEnd);
3418+ if pStart = nil then begin
3419+ RStart := 0;
3420+ RLength := 0;
3421+ result := 0;
3422+ end else begin
3423+ RStart := pStart - PChar(Text)+1; {RStartは１ベース}
3424+ RLength := pEnd - pStart;
3425+ result := RStart;
3426+ end;
3427+end;
3428+
3429+{AWK Like function Sub_Raw}
3430+function TAWKStr.Sub(SubText: String; var Text: String): Boolean;
3431+var
3432+ pStart, pEnd: PChar;
3433+ MatchStr: String;
3434+begin
3435+ FMatchProc(PChar(Text), pStart, pEnd);
3436+ if pStart <> nil then begin
3437+{マッチした}
3438+ MatchStr := Copy(Text, pStart-PChar(Text)+1, pEnd-pStart); {マッチした部分}
3439+ Delete(Text, pStart-PChar(Text)+1, pEnd-pStart);
3440+ {SubTextのなかの&キャラクタをマッチした部分(MatchStr)で置換える。}
3441+ SubText := Substitute_MatchStr_For_ANDChar(SubText, MatchStr);
3442+ Insert(SubText, Text, pStart-PChar(Text)+1);
3443+ result := True;
3444+ end else begin
3445+{マッチしない}
3446+ result := False;
3447+ end;
3448+end;
3449+
3450+{AWK Like GSubRaw }
3451+function TAWKStr.GSub(SubText: String; var Text: String): Integer;
3452+var
3453+ pStart, pEnd: PChar;
3454+ ResultText, aText: String;
3455+ MatchStr: String;
3456+ WChar: WChar_t;
3457+begin
3458+ ResultText := ''; {結果の文字列を入れる変数}
3459+ aText := Text; {検索対象として使う}
3460+ result := 0;
3461+ FMatchProc(PChar(aText), pStart, pEnd);
3462+ if pStart = nil then
3463+ exit {何もマッチしない}
3464+ else if aText = '' then begin
3465+ result := 1; {マッチしたが Text=''}
3466+ Text := Substitute_MatchStr_For_ANDChar(SubText, '');
3467+ exit;
3468+ end;
3469+
3470+ {マッチして Text <> ''}
3471+ while True do begin
3472+ ResultText := Concat(ResultText, Copy(aText, 1, pStart-PChar(aText)));{前半部分}
3473+ MatchStr := Copy(aText, pStart-PChar(aText)+1, pEnd-pStart); {マッチした部分文字列}
3474+ MatchStr := Substitute_MatchStr_For_ANDChar(SubText, MatchStr);
3475+ ResultText := Concat(ResultText, MatchStr);{+ 置換文字列}
3476+
3477+ if pStart = pEnd then begin {空文字列にマッチしたときの特殊処理}
3478+ if isDBCSLeadByte(Byte(pStart^)) or
3479+ ((LineSeparator = mcls_CRLF) and (Byte(pStart^) = CONST_CR)) then begin
3480+ ResultText := Concat(ResultText, Copy(aText, pStart-PChar(aText)+1, 2));
3481+ Inc(pEnd, 2);
3482+ end else begin
3483+ ResultText := Concat(ResultText, Copy(aText, pStart-PChar(aText)+1, 1));
3484+ if Byte(pEnd^) <> CONST_NULL then
3485+ Inc(pEnd, 1);
3486+ end;
3487+ end;
3488+ Inc(result);
3489+
3490+ WChar := Byte((pEnd-1)^);
3491+ {Chr($0a)を調べる為だけなので、２バイト文字の考慮不要。 aText = ''はありえない}
3492+ aText := String(pEnd);
3493+ {マッチした部分文字列の後の部分をaTextに設定}
3494+ if aText = '' then
3495+ break;
3496+ if WChar = CONST_LF then begin
3497+ FMatchProc(PChar(aText), pStart, pEnd);
3498+ if pStart = nil then
3499+ break;
3500+ end else begin
3501+ MatchEX_Inside(PChar(aText), pStart, pEnd);
3502+ if pStart = nil then
3503+ break;
3504+ end;
3505+ end;
3506+ Text := Concat(ResultText, aText);
3507+end;
3508+
3509+function TAWKStr.Split(Text: String; StrList: TStrings): Integer;
3510+var
3511+ pStart, pEnd: PChar;
3512+ Str: String;
3513+begin
3514+ StrList.Clear;{結果文字列リストの内容クリア}
3515+ Str := '';
3516+ while Text <> '' do begin
3517+ FMatchProc(PChar(Text), pStart, pEnd);
3518+ if pStart = nil then begin
3519+ {マッチしなかったとき}
3520+ StrList.Add(Concat(Str, Text));
3521+ Str := '';
3522+ break;
3523+ end else if (pStart = PChar(Text)) and (pStart = pEnd) then begin
3524+ {先頭のヌル文字列にマッチしたときの特殊処理}
3525+ if IsDBCSLeadByte(Byte(Text[1])) then begin
3526+ Str := Concat(Str, Copy(Text, 1, 2));
3527+ Text := Copy(Text, 3, Length(Text));
3528+ end else begin
3529+ Str := Concat(Str, Text[1]);
3530+ Text := Copy(Text, 2, Length(Text));
3531+ end;
3532+ end else begin;
3533+ {マッチした}
3534+ StrList.Add(Concat(Str, Copy(Text, 1, pStart-PChar(Text))));
3535+ Str := '';
3536+ Text := String(pEnd);
3537+ if Text = '' then begin
3538+ {最後尾にマッチしたときの特殊処理}
3539+ StrList.Add('');
3540+ break;
3541+ end;
3542+ end;
3543+ end;
3544+ if Str <> '' then
3545+ StrList.Add(Str);
3546+ result := StrList.Count;
3547+end;
3548+
3549+{ -=========================== TTxtFile Class ================================-}
3550+constructor TTxtFile.Create(aFileName: String; var CancelRequest: Boolean);
3551+begin
3552+ inherited Create;
3553+ FpCancelRequest := @CancelRequest; {CancelRequestがTrueで途中終了する}
3554+
3555+ FBuffSize := 1024*100; {バッファのサイズ}
3556+ FTailMargin := 100;
3557+
3558+ FFileName := aFileName;
3559+ System.FileMode := 0; {ファイルアクセスモード を読み出し専用に設定}
3560+ AssignFile(FF, FFileName);
3561+ try
3562+ Reset(FF, 1);
3563+ except
3564+ on E: EInOutError do begin
3565+ raise EFileNotFound.Create(E.Message);
3566+ end;
3567+ end;
3568+ FFileOpened := True; { ファイルオープンのフラグ。Destroyで使用する}
3569+ FpBuff := AllocMem(FBuffSize+FTailMargin);
3570+ FpBuff^ := Chr($0a); { ファイル先頭行の行頭にＬＦ Chr($0a)を付加}
3571+ BuffRead(FpBuff+1);
3572+ Inc(FReadCount); { 先頭のＬＦ($0a)のぶんを加算}
3573+ FpBase := FpBuff;
3574+ FpLineBegin := FpBuff;
3575+ FpForward := FpBuff;
3576+ FLineNo := 0;
3577+end;
3578+
3579+destructor TTxtFile.Destroy;
3580+begin
3581+ if FFileOpened then
3582+ CloseFile(FF);
3583+
3584+ if FpBuff <> nil then begin
3585+ FreeMem(FpBuff, FBuffSize+FTailMargin);
3586+ end;
3587+
3588+ inherited Destroy;
3589+end;
3590+
3591+procedure TTxtFile.BuffRead(pBuff: PChar);
3592+begin
3593+ BlockRead(FF, pBuff^, FBuffSize, FReadCount);
3594+ if FReadCount = 0 then begin
3595+ {FpLineBegin := FpBase;}
3596+ raise EEndOfFile.Create('End Of File');
3597+ end;
3598+
3599+ {読み込んだデータの最後にヌル・キャラクタを書き込む}
3600+ if not Eof(FF) then begin
3601+ (pBuff+FReadCount)^ := Chr(0);
3602+ end else begin
3603+ if (pBuff+FReadCount-1)^ <> Chr($0a) then begin
3604+ (pBuff+FReadCount)^ := Chr($0a);
3605+ (pBuff+FREadCount+1)^ := Chr(0);
3606+ (pBuff+FReadCount+2)^ := Chr(0);
3607+ Inc(FReadCount);
3608+ end else begin
3609+ (pBuff+FReadCount)^ := Chr(0);
3610+ (pBuff+FreadCount+1)^ := Char(0);
3611+ end;
3612+ end;
3613+
3614+ Application.ProcessMessages;
3615+ if FpCancelRequest^ then
3616+ raise EGrepCancel.Create('CancelRequest');
3617+end;
3618+
3619+procedure TTxtFile.IncPBaseNullChar(Ch: Char);
3620+var
3621+ Distance: Integer;
3622+begin
3623+ if FpBase = (PChar(FBrokenLine)+Length(FBrokenLine)) then begin
3624+ {FBrokenLine(String型) の中でChr(0)に達したとき。}
3625+ FpBase := FpBuff;
3626+ end else begin
3627+ {FpBuff(PChar) バッファの中でChr(0)に達したとき。}
3628+ if FpBase < FpBuff+FReadCount then begin
3629+ {ファイル中の不正なヌルキャラクタ Chr(0)は、Space($20)に補正}
3630+ FpBase^ := Chr($20);
3631+ end else begin
3632+ {バッファの終わりに来た}
3633+ if Eof(FF) then begin
3634+ {ファイルの終わりに来た}
3635+ if Ch = Chr(0) then
3636+ Dec(FpBase);
3637+ raise EEndOfFile.Create('End Of File');
3638+ end else begin
3639+ {ファイルをまだ読める}
3640+ if (FpLineBegin >= PChar(FBrokenLine)) and
3641+ (FpLineBegin < (PChar(FBrokenLine)+Length(FBrokenLine))) then begin
3642+ {FpLineBeginがFBrokenLineの中を指している。}
3643+ Distance := FpLineBegin-PChar(FBrokenLine);
3644+ FBrokenLine := Concat(FBrokenLine, String(FpBuff));
3645+ FpLineBegin := PChar(FBrokenLine)+Distance;
3646+ BuffRead(FpBuff);
3647+ FpBase := FpBuff;
3648+ end else begin
3649+ {FpLineBeginがバッファ中を指しているのでそこからFBrokenLineを取る}
3650+ FBrokenLine := String(FpLineBegin);
3651+ BuffRead(FpBuff);
3652+ FpBase := FpBuff;
3653+ FpLineBegin := PChar(FBrokenLine);
3654+ end;
3655+ end;
3656+ end;
3657+ end;
3658+end;
3659+
3660+{機能： FpBaseをインクリメントして、次の１バイトを指すようにする。}
3661+function TTxtFile.IncPBase: Char;
3662+var
3663+ ApBase: PChar;
3664+begin
3665+ result := FpBase^;
3666+ Inc(FpBase);
3667+ if FpBase^ = Chr(0) then
3668+ {ヌル・キャラクタの処理}
3669+ IncPBaseNullChar(result);
3670+ if result = Chr($0a) then begin
3671+ {改行処理}
3672+ if (FpBase < PChar(FBrokenLine)) or (FpBase > (PChar(FBrokenLine) +
3673+ Length(FBrokenLine))) then begin
3674+ {FpBaseがバッファを指しているとき}
3675+ FBrokenLine := '';
3676+ FpLineBegin := FpBase;
3677+ Inc(FLineNo);
3678+ end else begin
3679+ {FpBaseがFBrokenLine中を指しているとき}
3680+ FpLineBegin := FpBase;
3681+ Inc(FLineNo);
3682+ end;
3683+ end;
3684+ if FpBase^ = Chr($0d) then begin
3685+ ApBase := FpBase;
3686+ Inc(FpBase);
3687+ if FpBase^ = Chr(0) then
3688+ {ヌル・キャラクタの処理}
3689+ IncPBaseNullChar(result);
3690+ if FpBase^ <> Chr($0a) then begin
3691+ { CR($0d)の次がLF($0a)でないときは、$0dを$0aに置換する。}
3692+ if FpBase = FpBuff then
3693+ FpBase := PChar(FBrokenLine)+Length(FBrokenLine)-1
3694+ else
3695+ FpBase := ApBase;
3696+ FpBase^ := Chr($0a);
3697+ end
3698+ end;
3699+ FpForward := FpBase;
3700+end;
3701+
3702+function TTxtFile.AdvanceBase: WChar_t;
3703+var
3704+ ApBase: PChar;
3705+ Ch: Char;
3706+begin
3707+ {↓高速化のためIncPBase埋め込み}
3708+ Ch := FpBase^;
3709+ Inc(FpBase);
3710+ if FpBase^ = Chr(0) then
3711+ {ヌル・キャラクタの処理}
3712+ IncPBaseNullChar(Ch);
3713+ if Ch = Chr($0a) then begin
3714+ {改行処理}
3715+ if (FpBase < PChar(FBrokenLine)) or (FpBase > (PChar(FBrokenLine) +
3716+ Length(FBrokenLine))) then begin
3717+ {FpBaseがバッファを指しているとき}
3718+ FBrokenLine := '';
3719+ FpLineBegin := FpBase;
3720+ Inc(FLineNo);
3721+ end else begin
3722+ {FpBaseがFBrokenLine中を指しているとき}
3723+ FpLineBegin := FpBase;
3724+ Inc(FLineNo);
3725+ end;
3726+ end;
3727+ if FpBase^ = Chr($0d) then begin
3728+ ApBase := FpBase;
3729+ Inc(FpBase);
3730+ if FpBase^ = Chr(0) then
3731+ {ヌル・キャラクタの処理}
3732+ IncPBaseNullChar(ApBase^);
3733+ if FpBase^ <> Chr($0a) then begin
3734+ { CR($0d)の次がLF($0a)でないときは、$0dを$0aに置換する。}
3735+ if FpBase = FpBuff then
3736+ FpBase := PChar(FBrokenLine)+Length(FBrokenLine)-1
3737+ else
3738+ FpBase := ApBase;
3739+ FpBase^ := Chr($0a);
3740+ end
3741+ end;
3742+ {↑高速化のためIncPBase埋め込み}
3743+ result := Byte(Ch);
3744+ case result of
3745+ $81..$9F, $E0..$FC: begin
3746+ {↓高速化のためIncPBase埋め込み}
3747+ Ch := FpBase^;
3748+ Inc(FpBase);
3749+ if FpBase^ = Chr(0) then
3750+ {ヌル・キャラクタの処理}
3751+ IncPBaseNullChar(Ch);
3752+ if Ch = Chr($0a) then begin
3753+ {改行処理}
3754+ if (FpBase < PChar(FBrokenLine)) or (FpBase > (PChar(FBrokenLine) +
3755+ Length(FBrokenLine))) then begin
3756+ {FpBaseがバッファを指しているとき}
3757+ FBrokenLine := '';
3758+ FpLineBegin := FpBase;
3759+ Inc(FLineNo);
3760+ end else begin
3761+ {FpBaseがFBrokenLine中を指しているとき}
3762+ FpLineBegin := FpBase;
3763+ Inc(FLineNo);
3764+ end;
3765+ end;
3766+ if FpBase^ = Chr($0d) then begin
3767+ ApBase := FpBase;
3768+ Inc(FpBase);
3769+ if FpBase^ = Chr(0) then
3770+ {ヌル・キャラクタの処理}
3771+ IncPBaseNullChar(ApBase^);
3772+ if FpBase^ <> Chr($0a) then begin
3773+ { CR($0d)の次がLF($0a)でないときは、$0dを$0aに置換する。}
3774+ if FpBase = FpBuff then
3775+ FpBase := PChar(FBrokenLine)+Length(FBrokenLine)-1
3776+ else
3777+ FpBase := ApBase;
3778+ FpBase^ := Chr($0a);
3779+ end
3780+ end;
3781+ {↑高速化のためIncPBase埋め込み}
3782+ result := (result shl 8) or Byte(Ch);
3783+ end;
3784+ end;
3785+ FpForward := FpBase;
3786+end;
3787+
3788+procedure TTxtFile.GetCharNullChar(Ch: Char);
3789+var
3790+ Distance, Distance2: Integer;
3791+begin
3792+ if FpForward = (PChar(FBrokenLine)+Length(FBrokenLine)) then begin
3793+ {FBrokenLine(String型) の中でChr(0)に達したとき。}
3794+ FpForward := FpBuff;
3795+ end else begin
3796+ {FpBuff バッファの中でChr(0)に達したとき。}
3797+ if FpForward < FpBuff+FReadCount then begin
3798+ {ファイル中の不正なヌルキャラクタ Chr(0) は Space($20)にする。}
3799+ FpForward^ := Chr($20);
3800+ end else begin
3801+ {バッファの終わりに来た}
3802+ if Eof(FF) then begin
3803+ {すでにファイルの終わりに達しているとき}
3804+ if Ch = Chr(0) then
3805+ Dec(FpForward); {ずnっとresut = Chr(0)を返すようにする}
3806+ exit;
3807+ end else begin
3808+ {まだファイルを読めるとき}
3809+ if (FpLineBegin >= PChar(FBrokenLine)) and
3810+ (FpLineBegin < PChar(FBrokenLine)+Length(FBrokenLine)) then begin
3811+ {FpLineBeginがFBrokenLine中を指しているとき}
3812+ Distance := FpLineBegin-PChar(FBrokenLine);
3813+ if (FpBase >= PChar(FBrokenLine)) and
3814+ (FpBase < PChar(FBrokenLine)+Length(FBrokenLine)) then
3815+ {FpBaseもFBrokenLine中を指しているとき}
3816+ Distance2 := FpBase-PChar(FBrokenLine)
3817+ else
3818+ {FpBaseはバッファ中を指しているとき}
3819+ Distance2 := Length(FBrokenLine)+FpBase-FpBuff;
3820+ FBrokenLine := Concat(FBrokenLine, String(FpBuff));
3821+ FpLineBegin := PChar(FBrokenLine)+Distance;
3822+ FpBase := PChar(FBrokenLine)+Distance2;
3823+ BuffRead(FpBuff);
3824+ FpForward := FpBuff;
3825+ end else begin
3826+ {FpLineBeginがバッファ中を指しているとき}
3827+ FBrokenLine := String(FpLineBegin);
3828+ FpBase := PChar(FBrokenLine)+(FpBase-FpLineBegin);
3829+ FpLineBegin := PChar(FBrokenLine);
3830+ BuffRead(FpBuff);
3831+ FpForward := FpBuff;
3832+ end;
3833+ end;
3834+ end;
3835+ end;
3836+end;
3837+
3838+function TTxtFile.GetChar: Char;
3839+var
3840+ ApForward: PChar;
3841+begin
3842+ ApForward := FpForward;
3843+ result := FpForward^;
3844+ Inc(FpForward);
3845+ {ヌル・キャラクタの処理}
3846+ if FpForward^ = Chr(0) then
3847+ GetCharNullChar(result);
3848+
3849+ if result = Chr($0d) then begin
3850+ if FpForward^ <> Chr($0a) then begin
3851+ {CR($0d)の次がLF($0a)でないときは、$0dを$0aに置換する。}
3852+ if FpForward = FpBuff then
3853+ FpForward := PChar(FBrokenLine)+Length(FBrokenLine)-1
3854+ else
3855+ FpForward := ApForward;
3856+ FpForward^ := Chr($0a);
3857+ result := Chr($0a);
3858+ end else begin
3859+ result := FpForward^;
3860+ Inc(FpForward);
3861+ {ヌル・キャラクタの処理}
3862+ if FpForward^ = Chr(0) then
3863+ GetCharNullChar(result);
3864+ end;
3865+ end;
3866+end;
3867+
3868+function TTxtFile.GetWChar: WChar_t;
3869+var
3870+ ApForward: PChar;
3871+ Ch: Char;
3872+begin
3873+ ApForward := FpForward;
3874+ Ch := FpForward^;
3875+ Inc(FpForward);
3876+ {ヌル・キャラクタの処理}
3877+ if FpForward^ = Chr(0) then
3878+ GetCharNullChar(Ch);
3879+
3880+ if Ch = Chr($0d) then begin
3881+ if FpForward^ <> Chr($0a) then begin
3882+ {CR($0d)の次がLF($0a)でないときは、$0dを$0aに置換する。}
3883+ if FpForward = FpBuff then
3884+ FpForward := PChar(FBrokenLine)+Length(FBrokenLine)-1
3885+ else
3886+ FpForward := ApForward;
3887+ FpForward^ := Chr($0a);
3888+ Ch := Chr($0a);
3889+ end else begin
3890+ Ch := FpForward^;
3891+ Inc(FpForward);
3892+ {ヌル・キャラクタの処理}
3893+ if FpForward^ = Chr(0) then
3894+ GetCharNullChar(Ch);
3895+ end;
3896+ end;
3897+ result := Byte(Ch);
3898+ case result of
3899+ $81..$9F, $E0..$FC: begin
3900+ Ch := FpForward^;
3901+ Inc(FpForward);
3902+ {ヌル・キャラクタの処理}
3903+ if FpForward^ = Chr(0) then
3904+ GetCharNullChar(Ch);
3905+ result := (result shl 8) or Byte(Ch);
3906+ end;
3907+ end;
3908+end;
3909+
3910+function TTxtFile.GetThisLine: RE_LineInfo_t;
3911+var
3912+ i: Integer;
3913+begin
3914+ Application.ProcessMessages;
3915+ if FpCancelRequest^ then
3916+ raise EGrepCancel.Create('CancelRequest');
3917+
3918+ {行末を見つける。}
3919+ while FpBase^ <> Chr($0a) do begin
3920+ IncPBase;
3921+ end;
3922+
3923+ if (FpLineBegin >= PChar(FBrokenLine)) and
3924+ (FpLineBegin < PChar(FBrokenLine)+Length(FBrokenLine)) then begin
3925+ {FpLineBeginがFBrokenLine中を指しているとき}
3926+ if (FpBase >= PChar(FBrokenLine)) and
3927+ (FpBase < PChar(FBrokenLine)+Length(FBrokenLine)) then begin
3928+ {FpBaseもFBrokenLine中を指しているとき}
3929+ result.Line := Copy(FBrokenLine, FpLineBegin-PChar(FBrokenLine)+1,
3930+ FpBase-FpLineBegin);
3931+ end else begin
3932+ {FpBaseはバッファ中を指しているとき}
3933+ SetString(result.Line, FpBuff, FpBase-FpBuff);
3934+ result.Line := Concat(Copy(FBrokenLine, FpLineBegin-PChar(FBrokenLine)+1,
3935+ Length(FBrokenLine)), result.Line);
3936+ end;
3937+ end else begin
3938+ SetString(result.Line, FpLineBegin, FpBase-FpLineBegin);
3939+ end;
3940+
3941+ {TrimRight}
3942+ i := Length(result.Line);
3943+ while (i > 0) and (result.Line[i] in [Chr($0d), Chr($0a)]) do Dec(I);
3944+ result.Line := Copy(result.Line, 1, i);
3945+
3946+ result.LineNo := FLineNo;
3947+end;
3948+
3949+function StringToWordArray(Str: String; pWCharArray: PWordArray): Integer;
3950+var
3951+ i, j: Integer;
3952+ WChar: WChar_t;
3953+begin
3954+ i := 1;
3955+ j := 0;
3956+ WChar := GetWChar(Str, i);
3957+ while WChar <> 0 do begin
3958+ pWCharArray^[j] := WChar;
3959+ Inc(j);
3960+ WChar := GetWChar(Str, i);
3961+ end;
3962+ pWCharArray^[j] := 0;
3963+ result := j;
3964+end;
3965+
3966+constructor TGrep.Create(AOwner: TComponent);
3967+begin
3968+ inherited Create(AOwner);
3969+
3970+ ListOfFuzzyCharDic.Add(RE_FuzzyCharDic); {キャラクタ同一視辞書を追加}
3971+end;
3972+
3973+procedure TGrep.SetRegExp(Str: String);
3974+begin
3975+ inherited SetRegExp(Str);
3976+ if Self.RegExpIsSimple then
3977+ FGrepProc := GrepByStr
3978+ else
3979+ FGrepProc := GrepByRegExp;
3980+end;
3981+
3982+function TGrep.GetLineHeadWChar: WChar_t;
3983+begin
3984+ result := CONST_LF;
3985+end;
3986+
3987+function TGrep.GetLineTailWChar: WChar_t;
3988+begin
3989+ result := CONST_LF;
3990+end;
3991+
3992+procedure TGrep.GrepByRegExp(FileName: String);
3993+var
3994+ TxtFile: TTxtFile;
3995+ pDFAState,pInitialDFAState: RE_pDFAState_t;
3996+ LineInfo: RE_LineInfo_t;
3997+ DFA: TRE_DFA;
3998+ WChar: WChar_t;
3999+ pSub: RE_pDFAStateSub_t;
4000+begin
4001+ {OnMatchイベントハンドラが設定されていないときは、何もしない}
4002+ if not Assigned(FOnMatch) then
4003+ exit;
4004+
4005+ FCancel := False;
4006+ DFA := GetCurrentDFA;
4007+ pInitialDFAState := DFA.pInitialState;
4008+ try
4009+ TxtFile := TTxtFile.Create(FileName, Self.FCancel);
4010+ except on EEndOfFile do exit; {ファイルサイズ０のときはexit} end;
4011+
4012+ try
4013+ try
4014+ {検索}
4015+ while True do begin
4016+ repeat
4017+ WChar := TxtFile.AdvanceBase;
4018+ {↓NextDFAStateメソッド埋め込み}
4019+ pDFAState := nil;
4020+ pSub := pInitialDFAState^.next;
4021+ while pSub <> nil do begin
4022+ if WChar < pSub^.CharClass.StartChar then
4023+ break
4024+ else if WChar <= pSub^.CharClass.EndChar then begin
4025+ pDFAState := pSub^.TransitTo;
4026+ break;
4027+ end;
4028+ pSub := pSub^.next;
4029+ end;
4030+ {↑NextDFAStateメソッド埋め込み}
4031+ until pDFAState <> nil;
4032+
4033+ while True do begin
4034+ if pDFAState^.accepted then begin
4035+ {マッチした}
4036+ LineInfo := TxtFile.GetThisLine;
4037+ FOnMatch(Self, LineInfo);
4038+ break;
4039+ end;
4040+
4041+ {DFAを状態遷移させる}
4042+ pDFAState := NextDFAState(pDFAState, TxtFile.GetWChar);
4043+ if pDFAState = nil then begin
4044+ break;
4045+ end;
4046+ end;
4047+ end;
4048+ finally TxtFile.Free; end;
4049+ except on EEndOfFile do ; end; {Catch EEndOfFile}
4050+end;
4051+
4052+procedure TGrep.GrepByStr(FileName: String);
4053+var
4054+ TxtFile: TTxtFile;
4055+ Pattern: String;
4056+ pPat: PWordArray;
4057+ PatLen: Integer;
4058+ i: Integer;
4059+ LineInfo: RE_LineInfo_t;
4060+begin
4061+ FCancel := False;
4062+ Pattern := Self.SimpleRegExp;
4063+ {OnMatchイベントハンドラが設定されていないときは、何もしない}
4064+ if not Assigned(FOnMatch) then
4065+ exit;
4066+
4067+ try
4068+ TxtFile := TTxtFile.Create(FileName, Self.FCancel);
4069+ except on EEndOfFile do exit; {ファイルサイズ０のときはexit} end;
4070+
4071+ try
4072+ pPat := AllocMem(Length(Pattern)*2+2);
4073+ try
4074+ PatLen := StringToWordArray(Pattern, pPat);
4075+ try
4076+ while True do begin
4077+ while (TxtFile.AdvanceBase <> Word(pPat^[0])) do
4078+ ;
4079+ i := 1;
4080+ while True do begin
4081+ if i = PatLen then begin
4082+ LineInfo := TxtFile.GetThisLine;
4083+ FOnMatch(Self, LineInfo);
4084+ break;
4085+ end;
4086+ if TxtFile.GetWChar = Word(pPat^[i]) then
4087+ Inc(i)
4088+ else
4089+ break;
4090+ end;
4091+ end;
4092+ except on EEndOfFile do ;{Catch EEndOfFile} end;
4093+ finally FreeMem(pPat, Length(Pattern)*2+2); end;
4094+ finally TxtFile.Free; end;
4095+end;
4096+
4097+procedure MakeFuzzyCharDic;
4098+var
4099+ StrList: TStrings;
4100+ i: Integer;
4101+begin
4102+ RE_FuzzyCharDic := nil;
4103+ RE_FuzzyCharDic := TList.Create;
4104+
4105+ i := 0;
4106+ repeat
4107+ StrList := TStringList.Create;
4108+ try
4109+ RE_FuzzyCharDic.Add(StrList);
4110+ except
4111+ on Exception do begin
4112+ StrList.Free;
4113+ raise;
4114+ end;
4115+ end;
4116+
4117+ StrList.CommaText := REFuzzyWChars[i];
4118+ Inc(i);
4119+ until i > High(REFuzzyWChars);
4120+end;
4121+
4122+procedure DestroyFuzzyCharDic;
4123+var
4124+ i: Integer;
4125+begin
4126+ for i := 0 to RE_FuzzyCharDic.Count-1 do
4127+ TStringList(RE_FuzzyCharDic[i]).Free;
4128+ RE_FuzzyCharDic.Free;
4129+end;
4130+
4131+procedure Register;
4132+begin
4133+ RegisterComponents('RegExp', [TGrep, TAWKStr]);
4134+end;
4135+
4136+initialization
4137+ MakeFuzzyCharDic;
4138+
4139+finalization
4140+ DestroyFuzzyCharDic;
4141+
4142+end.
Binary files a/gikoNavi.res and b/gikoNavi.res differ
Show on old repository browser