FreeBASIC 正規表現を使う

#Include Once "pcre.bi"

'' 渡したファイル(.ini とか .txt)から、セクション名([]で囲まれたテキスト)を表示して、
'' そのサイズ(セクション数)を返す。

' 文字列変数を生成して文字列を登録します
Dim FileNo As Integer
Dim pattern As String
Dim i As Integer = 0

Declare Function ExecRegExpr(RegExpr As String, InputStr As String) As Boolean
	
pattern = "\[.+\]"
	
' 空いている、最初のファイル番号を見つけます
FileNo = FreeFile

' プログラムと同じフォルダにある指定ファイルを開きます。ファイル番号は "FileNo" を使います
Open "VB.ini" For Input As #FileNo

If Err > 0 Then Print "ファイル入力でエラー": End

Do Until EOF( FileNo )               '' ファイルの端に達するまで、繰り返します。
   Dim As String text
   Line Input #FileNo, text          '' テキストの行を読みます ...
   'Print text                           
   If ExecRegExpr(pattern, text) = TRUE Then
      i=i + 1
      Print "セクション名" ; text    '' セクションの場合、画面にそれを出力します。
   EndIf
Loop
Print "セクション数" ; i 

Close #FileNo                        '' ファイル番号を通したファイルを閉じます。
Sleep


Function ExecRegExpr(RegExpr As String, InputStr As String) As Boolean
   '[戻り値]
   'InputStr内にRegExprが見つかった場合：True
   'InputStr内にRegExprが見つからなかった場合：False

   Dim re As pcre Ptr  
   Dim error_ As ZString Ptr 
   Dim erroffset As Integer 
   Dim rc As Integer
   Dim OVECCOUNT As Const UInteger = 30    '' should be a multiple of 3
   Dim ovector(OVECCOUNT-1) As Integer 

   '' 正規表現をコンパイル
	re = pcre_compile( RegExpr,   		_ ''   正規表現パターン
					   0,               _ ''   既定オプション
					   @error_,         _ ''   エラー・メッセージ用
					   @erroffset,      _ ''   エラー・オフセット用
					   NULL )           _ ''   既定文字表を使う
	
	'' コンパイル失敗：エラーメッセージを出力して終了
	If re = NULL Then 
		Print "PCRE コンパイルがオフセットで失敗 "; Str(erroffset); ": "; *error_ 
		Sleep
		End 
	End If 
	
	'' コンパイル成功：主題と一致
	rc = pcre_exec( re,                 _ '' コンパイルされたパターン
					NULL,               _ '' 追加データ無し - パターンを研究しません
					InputStr,           _ '' 検索文字列
					Len( InputStr ),    _ '' 検索対象の長さ
					0,                  _ '' 対象のオフセット0 で開始
					0,                  _ '' 既定オプション
					@ovector(0),        _ '' 部分文字列情報のための出力ベクトル
					OVECCOUNT )         _ '' 出力ベクトルの要素数
					
	'' 照合失敗：エラーケースを扱う
	If rc < 0 Then 
	    Select Case rc 
	    Case pcre_error_nomatch
	        'Print "照合せず" 
	    '好みにより、他の特例を扱う
	    Case Else
	    	'Print "照合エラー"; rc
	    End Select 
	    ExecRegExpr = FALSE
	Else
   	    ExecRegExpr = TRUE
	End If 

End Function

[AAA]
a=1
[BBB]
b=1
[CCC]
c=1
[セクション１]
line0=a,b,c
line1=a,bb,ccc,
line2=aa,b,c
[セクション２]
line0=x,y,z
line1=xx,y,
line2=x,y,zz

' preg_class_test.bas by Roland Chastain

#Include "preg_class.bi"

? preg_replace_simple("(\w+) (\w+)", "$2 $1", "Bond James")

Sleep

#Include "preg_class.bi"

'' 渡したファイル(.ini とか .txt)から、セクション名([]で囲まれたテキスト)を表示して、
'' 正規表現置換した結果を表示して、
'' 最後にセクション数を表示します。

' 文字列変数を生成して文字列を登録します
Dim FileNo As Integer
Dim pattern As String
Dim i As Integer = 0

pattern = "(\[.+)(\])"

' 空いている、最初のファイル番号を見つけます
FileNo = FreeFile

' プログラムと同じフォルダにある指定ファイルを開きます。ファイル番号は "FileNo" を使います 
Open "VB.ini" For Input As #FileNo

If Err > 0 Then Print "ファイル入力でエラー": End

Do Until EOF( FileNo )                '' ファイルの端に達するまで、繰り返します。
   Dim As String text
   Line Input #FileNo, text           '' テキストの行を読みます ...
   'Print text                           
   If Len(preg_match_simple(pattern, text)) > 0 Then  '正規表現を使って検索します。
      i=i + 1
      Print "セクション名" ; text,     '' ... セクションの場合、画面にそれを出力します。
      Print preg_replace_simple(pattern, "$1渡辺$2", text)  '正規表現置換した結果も表示します
   EndIf
Loop
Print "セクション数" ; i 

Close #FileNo                        '' ファイル番号を通したファイルを閉じます。
Sleep

' preg_class.bi by Roland Chastain

declare function preg_match_simple(pattern as zstring ptr, subject as zstring ptr, _
byval offset as integer = 0, byval flags as integer = 0) as string

declare function preg_replace_simple(pattern as zstring ptr, replacement as zstring ptr, _
subject as zstring ptr, byval offset as integer = 0, byval flags as integer = 0) as string

#Include "preg_class.bas"

/'
'' PCRE example?
'' Copyright (C) 2007  MindlessXD
'' 
'' このプログラムはフリーソフトウェアです。
'' あなたは、GNU General Public License の下で、これを再配布や改変をすることができます。
'' ここで GNU General Public License とは、フリーソフトウェア財団によって発行された、
'' ライセンスのバージョン2、またはそれ以降のバージョンのいずれかを示します。。
'' 
'' このプログラムは、有用でしょうが、全くの無保証であることを前提に配布されます。
'' 商品適格性や、特定の目的に対する適切さについて、暗黙の保証もありません。
'' 詳細については GNU General Public License を参照してください。
'' 
'' あなたはこのプログラムと共に、GNU General Public License の写しを入手してください。
'' フリーソフトウェア財団：
'' Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA
'/


#Define PCRE_STATIC    ' Added By St_W
#Include "pcre.bi"

Type preg_t
   As Integer             substrings_limit '' 照合される部分文字列の最大数、-1は無限大
   As ZString Ptr Ptr Ptr strings          '' read-only, access via result() and result_all()
   As Integer             matches          '' read-only, パターン合致結果の数
   As Integer             substrings       '' read-only, パターン部分文字列合致結果の数

   As Integer     errorcode                '' read-only
   As ZString Ptr err_                     '' read-only
   As Integer     erroffset                '' read-only

   '' match() を使うと1つの例だけに合致し、match_all() を使うとすべての例に合致します

   Declare Function match(pattern As ZString Ptr, subject As ZString Ptr, _
   ByVal offset As Integer = 0, ByVal flags As Integer = 0) As Integer

   Declare Function match_all(pattern As ZString Ptr, subject As ZString Ptr, _
   ByVal offset As Integer = 0, ByVal flags As Integer = 0) As Integer

   '' result() と result_all() を使うことは、それぞれ match() と match_all() を使うことに対応しています。
   '' result(0) は全ての合致です。result(n) は n 番目の部分文字列です。

   Declare Function result(ByVal substring As Integer = 0) As String
   Declare Function result_all(ByVal match_ As Integer, ByVal substring As Integer = 0) As String

   '' 置換では、置換の部分文字列として '$n' を使うことができます。
   '' オプションの終端$ (例 '$n$') を使うと、数字を直接置換の対象にできます。
   '' '$' の文字そのものを挿入したいときは、'$$' を使います。

   Declare Function replace(pattern As ZString Ptr, replacement As ZString Ptr, subject As ZString Ptr, _
   ByVal offset As Integer = 0, ByVal flags As Integer = 0) As Integer

   Declare Function clean_up() As Integer

   Declare Constructor (ByVal substrings_limit_ As Integer = -1)
   Declare Destructor ()
End Type

Function preg_t.match(pattern As ZString Ptr, subject As ZString Ptr, _
ByVal offset As Integer = 0, ByVal flags As Integer = 0) As Integer
   this.clean_up()

   this.errorcode = 0
   this.strings = 0
   this.matches = 0

   Dim As pcre Ptr temp_c = pcre_compile2(pattern, flags, @this.errorcode, @this.err_, @this.erroffset, 0)

   If temp_c = 0 Then Return this.errorcode

   pcre_fullinfo(temp_c, 0, PCRE_INFO_CAPTURECOUNT, @this.substrings)

   If (this.substrings_limit >= 0 And this.substrings_limit < this.substrings) Then this.substrings = this.substrings_limit

   Dim As Integer Ptr vector = Allocate((this.substrings + 1) * 3 * SizeOf(Integer))

   Dim As Integer temp_e = pcre_exec(temp_c, 0, subject, Len(*subject), offset, 0 /'flags'/, vector, (this.substrings + 1) * 3)

   If temp_e = 0 Then temp_e = this.substrings + 1
   If temp_e < 0 Then
      this.errorcode = temp_e
   Else
      this.strings = ReAllocate(this.strings, (this.matches + 1) * SizeOf(ZString Ptr Ptr))
      this.strings[this.matches] = Callocate((this.substrings + 1) * SizeOf(ZString Ptr))
      For i As Integer = 0 To temp_e - 1
         pcre_get_substring(subject, vector, temp_e, i, @this.strings[this.matches][i])
      Next
      this.matches += 1
   End If
   If this.errorcode = PCRE_ERROR_NOMATCH Then this.errorcode = 0

   DeAllocate(vector)

   pcre_free(temp_c)

   Return this.errorcode
End Function

Function preg_t.match_all(pattern As ZString Ptr, subject As ZString Ptr, _
ByVal offset As Integer = 0, ByVal flags As Integer = 0) As Integer
   this.clean_up()

   this.errorcode = 0
   this.strings = 0
   this.matches = 0

   Dim As pcre Ptr temp_c = pcre_compile2(pattern, flags, @this.errorcode, @this.err_, @this.erroffset, 0)

   If temp_c = 0 Then Return this.errorcode

   pcre_fullinfo(temp_c, 0, PCRE_INFO_CAPTURECOUNT, @this.substrings)

   If (this.substrings_limit >= 0 And this.substrings_limit < this.substrings) Then this.substrings = this.substrings_limit

   Dim As Integer Ptr vector = Allocate((this.substrings + 1) * 3 * SizeOf(Integer))

   Dim As Integer temp_l = Len(*subject), temp_o = offset
   Do
      Dim As Integer temp_e = pcre_exec(temp_c, 0, subject, temp_l, temp_o, 0 /'flags'/, vector, (this.substrings + 1) * 3)
      If temp_e = 0 Then temp_e = this.substrings + 1
      If temp_e < 0 Then
         this.errorcode = temp_e
      Else
         this.strings = ReAllocate(this.strings, (this.matches + 1) * SizeOf(ZString Ptr Ptr))
         this.strings[this.matches] = Callocate((this.substrings + 1) * SizeOf(ZString Ptr))
         For i As Integer = 0 To temp_e - 1
            pcre_get_substring(subject, vector, temp_e, i, @this.strings[this.matches][i])
         Next
         temp_o = vector[1]
         this.matches += 1
      End If
   Loop While this.errorcode = 0

   If this.errorcode = PCRE_ERROR_NOMATCH Then this.errorcode = 0

   DeAllocate(vector)

   pcre_free(temp_c)

   Return this.errorcode
End Function

Function preg_t.replace(pattern As ZString Ptr, replacement As ZString Ptr, subject As ZString Ptr, _
ByVal offset As Integer = 0, ByVal flags As Integer = 0) As Integer
   this.clean_up()

   this.errorcode = 0
   this.strings = 0
   this.matches = 0

   Dim As pcre Ptr temp_c = pcre_compile2(pattern, flags, @this.errorcode, @this.err_, @this.erroffset, 0)

   If temp_c = 0 Then Return this.errorcode

   pcre_fullinfo(temp_c, 0, PCRE_INFO_CAPTURECOUNT, @this.substrings)

   If (this.substrings_limit >= 0 And this.substrings_limit < this.substrings) Then this.substrings = this.substrings_limit

   Dim As String result_

   Dim As Integer Ptr vector = Allocate((this.substrings + 1) * 3 * SizeOf(Integer))

   Dim As Integer temp_s = Len(*subject), temp_o = offset
   Do
      Dim As Integer temp_e = pcre_exec(temp_c, 0, subject, temp_s, temp_o, 0 /'flags'/, vector, (this.substrings + 1) * 3)
      If temp_e = 0 Then temp_e = this.substrings + 1
      If temp_e < 0 Then
         this.errorcode = temp_e
      Else
         result_ &= Left(subject[temp_o], vector[0] - temp_o)

         Dim As Integer temp_s1, temp_s2
         Do
            temp_s2 = InStr(replacement[temp_s1], "$")
            If temp_s2 = 0 Then Exit Do

            result_ &= Left(replacement[temp_s1], temp_s2 - 1)

            Dim As Integer temp_n = -1
            Do While Left(replacement[temp_s1 + temp_s2], 1) >= "0" And Left(replacement[temp_s1 + temp_s2], 1) <= "9"
               temp_n = IIf(temp_n = -1, 0, temp_n * 10)
               temp_n += Val(Left(replacement[temp_s1 + temp_s2], 1))
               temp_s1 += 1
            Loop
            If Left(replacement[temp_s1 + temp_s2], 1) = "$" Then
               If temp_n = -1 Then result_ &= "$"
               temp_s1 += 1
            End If
            If temp_n > -1 And temp_n <= temp_e Then
               If vector[2 * temp_n] > -1 Then
                  result_ &= Left(subject[vector[2 * temp_n]], vector[2 * temp_n + 1] - vector[2 * temp_n])
               End If
            End If

            temp_s1 += temp_s2
         Loop
         result_ &= replacement[temp_s1]

         temp_o = vector[1]
      End If
   Loop While this.errorcode = 0

   If this.errorcode = PCRE_ERROR_NOMATCH Then
      result_ &= subject[temp_o]
      this.errorcode = 0
   End If

   this.matches = 1
   this.substrings = 0
   this.strings = Allocate(1 * SizeOf(ZString Ptr Ptr))
   this.strings[0] = Allocate(1 * SizeOf(ZString Ptr))
   this.strings[0][0] = pcre_malloc(Len(result_) + 1)
   *this.strings[0][0] = result_

   DeAllocate(vector)

   pcre_free(temp_c)

   Return this.errorcode
End Function

Function preg_t.result(ByVal substring As Integer = 0) As String
   If (0 < matches And substring <= this.substrings) Then
      If (this.strings[0][substring]) Then
         Return *this.strings[0][substring]
      End If
   End If
   Return ""
End Function

Function preg_t.result_all(ByVal match_ As Integer, ByVal substring As Integer = 0) As String
   If (match_ < matches And substring <= this.substrings) Then
      If (this.strings[match_][substring]) Then
         Return *this.strings[match_][substring]
      End If
   End If
   Return ""
End Function

Function preg_t.clean_up() As Integer
   If this.err_ Then
      DeAllocate(this.err_)
      this.err_ = 0
   End If

   If this.strings Then
      For i As Integer = 0 To this.matches - 1
         For j As Integer = 0 To this.substrings
            pcre_free_substring(this.strings[i][j])
         Next
         DeAllocate(this.strings[i])
      Next
      DeAllocate(this.strings)
   End If

   Return 0
End Function

Constructor preg_t(ByVal substrings_limit_ As Integer = -1)
   this.substrings_limit = substrings_limit_
End Constructor

Destructor preg_t()
   clean_up()
End Destructor

Function preg_match_simple(pattern As ZString Ptr, subject As ZString Ptr, _
ByVal offset As Integer = 0, ByVal flags As Integer = 0) As String
'戻り値：検索結果文字列
'pattern：正規表現パターン
'subject：検索文字列
'offset：開始文字目
'flags：PCRE_CASELESS パターンの中の文字は 大文字にも小文字にもマッチ

   Dim As preg_t preg = 0
   preg.match(pattern, subject, offset, flags)
   Return preg.result()
End Function

Function preg_replace_simple(pattern As ZString Ptr, replacement As ZString Ptr, subject As ZString Ptr, _
ByVal offset As Integer = 0, ByVal flags As Integer = 0) As String
'戻り値：置換結果
'pattern：正規表現パターン
'replacement：置換文字列
'subject：検索文字列
'offset：開始文字目
'flags：PCRE_CASELESS パターンの中の文字は 大文字にも小文字にもマッチ

   Dim As preg_t preg
   preg.replace(pattern, replacement, subject, offset, flags)
   Return preg.result()
End Function


'' 関数の使用例
'Scope
'   Dim As preg_t foo
'
'   If foo.match("(foo)?ba(r|z)?", "foo foobar bar foobaz baz") Then
'      ? "ERROR: " & foo.errorcode
'   Else
'      ? "match:" & foo.result()
'      For j As Integer = 1 To foo.substrings
'         ? "substring: " & foo.result(j)
'      Next
'   End If
'   ?
'
'   If foo.match_all("(foo)?ba(r|z)?", "foo foobar bar foobaz baz") Then
'      ? "ERROR: " & foo.errorcode
'   Else
'      For i As Integer = 0 To foo.matches - 1
'         ? "match: " & foo.result_all(i)
'         For j As Integer = 1 To foo.substrings
'            ? "substring: " & foo.result_all(i, j)
'         Next
'      Next
'   End If
'   ?
'End Scope
'
'? preg_match_simple("ba[y-z]", "foo bar baz bay")
'? preg_match_simple("ba.", "bar baz", 2)
'? preg_match_simple(".OO", "foo", , PCRE_CASELESS)
'?
'
'? preg_replace_simple("(foo)?ba(r|z)", "//$0//$1$1//$2$$$2//$9//", "foo--foobaz--bar--baz--foo")
'? preg_replace_simple("(foo)?ba(r|z)", "//$$//$0//", "foo--bar--foo")
'? preg_replace_simple("(foo)?ba(r|z)", "//$-//$0//", "foo--bar--foo")
'? preg_replace_simple("(foo)?ba(r|z)", "//$999//$0//", "foo--bar--foo")
'?

''
'' 正規表現の検索の例
''

#Include "regex.bi"

Declare Sub PrintMatches( ByVal pattern As String, ByVal buffer As String )


PrintMatches( "[a-zA-Z_][a-zA-Z_0-9]*", "foo _bar 123 foo123 BAR 456 !!! Foo__ ???" )
Sleep


Sub PrintMatches( ByVal pattern As String, ByVal buffer As String )
   Dim re As regex_t
   Dim pm As regmatch_t
   Dim pbuff As ZString Ptr
   Dim res As Integer

   pbuff = StrPtr( buffer )

   '' パターンをコンパイル
   regcomp( @re, pattern, 0 )

   '' 最初の合致
   res = regexec( @re, pbuff, 1, @pm, 0 )
   Do While( res = 0 )
      Print "<"; Mid( *pbuff, 1 + pm.rm_so, pm.rm_eo - pm.rm_so ); ">"

      '' 次の合致
      pbuff += pm.rm_eo
      res = regexec( @re, pbuff, 1, @pm, REG_NOTBOL )
   Loop

   '' 文脈(コンテキスト)を解放
   regfree( @re )
End Sub

'' PHP-like Regex_Replace() 関数, by MisterD

#Include "regex.bi"

#Ifndef regexmatch
#define regexmatch(match,zeile,n) Mid(zeile,1+match(n).rm_so, match(n).rm_eo-match(n).rm_so)
#EndIf

Declare Function Regex_Replace(ByRef regex As String, ByRef replace_pattern As String, _
ByRef subject As String) As String
'regex：正規表現パターン
'replace_pattern：置換文字列
'subject：検索文字列

Print Regex_Replace("-(.+?)-", "*1*", "Hi -you- strange -user- :D")
Sleep


Function Regex_Replace(ByRef regex As String, ByRef replace_pattern As String, _
ByRef subject As String) As String
    Dim replaced As String, rest As String
    rest=subject
    Dim re As regex_t
    If regcomp( @re, regex, REG_EXTENDED Or REG_ICASE )<>0 Then Return ""
    Dim match(re.re_nsub) As regmatch_t, n As Integer
    While regexec( @re, StrPtr(rest), re.re_nsub+1, @match(0), 0 )=0
        replaced+=Left(rest,match(0).rm_so)
        For n = 1 To Len(replace_pattern)
            If Mid(replace_pattern,n,1) = "" And _
               Mid(replace_pattern,n-1,1)<>"\" And _
               Val(Mid(replace_pattern,n+1,1)) > 0 And _
               Val(Mid(replace_pattern,n+1,1)) <= re.re_nsub _
            Then
                replaced+=regexmatch(match,rest,Val(Mid(replace_pattern,n+1,1)))
                n+=1
            Else
                replaced+=Mid(replace_pattern,n,1)
            End If
        Next n
        If match(0).rm_eo=Len(rest) Then Return replaced
        rest=Mid(rest,match(0).rm_eo+1)
    Wend
    Return replaced+rest
End Function

''
'' 正規表現の検索の例
''

#Include  "regex.bi"

Enum eFilePartKind
   eFPK_Full
   eFPK_Path
   eFPK_File
   eFPK_Basename
   eFPK_Extension
End Enum

Function get_filepart( ByRef buffer As String, ByVal kind As eFilePartKind ) As String
   Dim re As regex_t
   Dim pm As regmatch_t
   Dim pbuff As ZString Ptr
   Dim res As Integer
   Dim nsub As Integer

   If Len(buffer)=0 Then Exit Function

   pbuff = StrPtr( buffer )

   '' compile the pattern
   If regcomp( @re, "^(.*/)*([^/.]*)(((\.[^.]*)*)(\.[^.]*))?", REG_EXTENDED Or REG_ICASE )<>0 Then
      Exit Function
   End If

   nsub = re.re_nsub + 1
   ReDim match(1 To nsub) As regmatch_t

   '' first match
   res = regexec( @re, pbuff, nsub, @match(1), 0 )
   If ( res = 0 ) Then

      Select Case kind
      Case eFPK_Full
         Function = buffer
      Case eFPK_Path
         Function = Mid( *pbuff, 1 + match(2).rm_so, match(2).rm_eo - match(2).rm_so )
      Case eFPK_File
         Function = Mid( *pbuff, 1 + match(3).rm_so, match(3).rm_eo - match(3).rm_so ) + _
                    Mid( *pbuff, 1 + match(4).rm_so, match(4).rm_eo - match(4).rm_so )
      Case eFPK_Basename
         Function = Mid( *pbuff, 1 + match(3).rm_so, match(3).rm_eo - match(3).rm_so ) + _
                    Mid( *pbuff, 1 + match(5).rm_so, match(5).rm_eo - match(5).rm_so )
      Case eFPK_Extension
         Function = Mid( *pbuff, 1 + match(7).rm_so, match(7).rm_eo - match(7).rm_so )
      End Select
   End If
End Function

Private Sub ShowAll( ByRef s As String )
   Print "Full:", s
   Print "Path:", get_filepart(s, eFPK_Path)
   Print "File:", get_filepart(s, eFPK_File)
   Print "Base:", get_filepart(s, eFPK_Basename)
   Print "Ext :", get_filepart(s, eFPK_Extension)
   Print
End Sub

ShowAll "path/name.ext"
ShowAll "path/name.ext1.ext2"
ShowAll "path/name.ext1.ext2.ext3"
ShowAll "path/name"
ShowAll "path/"
ShowAll "name.ext"
ShowAll "name.ext1.ext2"
ShowAll "name.ext1.ext2.ext3"
ShowAll "name"
ShowAll ".ext"
ShowAll ".ext1.ext2"
ShowAll ".ext1.ext2.ext3"
ShowAll ""

Sleep