FreeBASIC 文字列関数 Replace()

目次→フォーラム→FreeBASIC→補足→String Function Replace()←オリジナル・サイト

文字列関数 Replace()　左にメニュー・フレームが表示されていない場合は、ここをクリックして下さい

　このページは、FreeBASIC のフォーラムに投稿された、文字列置換関数を、日本語化して紹介します。

正規表現を使った置換も参照下さい。

fxm さんの関数
TJF さんの関数
dodicat さんの関数(高速バージョン)
xroot さんの関数(ポインタを利用した最高速バージョン)
Eternal_Pain さんの関数

fxm さんの関数

ReplaceFunctionDmontaine3JP.bas　このプログラムは ShiftJIS で保存して実行して下さい。

'ReplaceFunctionDmontaine
'by fxm ≫ Jul 23, 2022 8:06
'https://www.freebasic.net/forum/viewtopic.php?p=293491#p293491

'Program: ReplaceFunctionExample
' This program shows how the included 'Replace' function
' converts all instances of characters in a string to another

'==================================================
' Replace 関数
'==================================================

Function Replace(ByVal SearchString As String,ByVal FromChar As String,ByVal ToChar As String) As String
   If Len(SearchString) = 0 Or Len(FromChar) = 0  Or Len(ToChar) = 0 Then Return ""
   Dim location As Integer = 1 - Len(ToChar)
   Do
       location = InStr(location + Len(ToChar),SearchString,FromChar)
       If location > 0 Then
           SearchString = Left(SearchString,location - 1) & ToChar & Mid(SearchString,location + Len(FromChar))
       Else
           Exit Do
       End If
   Loop
   Return SearchString
End Function

'==================================================
' 活用例
'==================================================
' Replaces all occurances of "|" with ","

Width 80,24
Dim InputString  As WString * 1000

InputString = "a|b|c|d|e|f|g"
Locate 1,1
Print "Replace() 関数の使用例"
Locate 3,5
Print "初期の文字列 = " + InputString
Locate 4,5
Print "すべての出現箇所で ""|"" を "","" に置換します。"
Locate 5,5
Print "置換後文字列 = " + Replace(InputString,"|",",")

Locate 7,1
Print "何かキーを押すと例文を変更します。" ;
Sleep

InputString = "青は愛より出でて愛より青し"
Locate 3,5
Print "初期の文字列 = " + InputString
Locate 4,5
Print "すべての出現箇所で ""愛"" を ""藍"" に置換します。"
InputString = Replace(InputString,"愛","藍")
Locate 5,5
'Print "The modified string = " + Replace(InputString,"愛","藍")
Print "置換後文字列 = " + InputString

Locate 7,1
Print "何かキーを押すと置換内容を変更します。" ;
Sleep

Locate 3,5
Print "初期の文字列 = " + InputString
Locate 4,5
Print Space(50)
Locate 5,5
'Print "The modified string = " + Replace(InputString,"愛","藍")
InputString = Replace(InputString,"藍より出でて","藍から生成するが")
Print "置換後文字列 = " + Replace(InputString,"藍より青し","藍より青い")

Locate 7,1
Print "何かキーを押すと、置換速度チェックの例文を実行します。"
Sleep

Dim As String s
Dim As String g="11001111000001"
For n As Long=1 To 15
    g+=g
Next
Print g
Print " の 11110000 を z に置換"
Print "置換前の文字列の文字数 "; Len(g)
Print

Dim As Double t=Timer
s = replace(g,"11110000","z")

Print "置換にかかった時間 ";Timer-t; " 秒"
Print "置換語後の文字数　　　　";Len(s)
Print
Print "↓　置換後の文字列の先頭 50 文字 "
Print Left(s,50)
Print ". . ."
Print Right(s,50)
Print "↑　置換後の文字列の後ろ 50 文字 "
Print
Print "何かキーを押すと終了します。" 
Sleep

ページの頭に戻る

TJF さんの関数

下記は、TJF さんが掲示板で公開しているサブ・ルーチンです。
https://www.freebasic.net/forum/viewtopic.php?f=7&t=16920

STRreplaceTJF2.bas　このプログラムは ShiftJIS で保存して実行して下さい。

'https://www.freebasic.net/forum/viewtopic.php?f=7&t=16920
'by TJF ≫ Nov 22, 2010 6:39 

'ByRef Expression となっているので、
'サブルーチンを呼んだ後、第一引数に指定した変数の値が、置換されています。 

Declare Sub StReplace(ByRef Expression As String, ByRef Find As String, ByRef Replacement As String, ByVal Start As Integer = 1)

Dim mojiretsu As String
Dim mae As String
Dim ato As String

mojiretsu = "H:\Tool\FbEdit\ライブラリ\window9\例.txt"
mae = ".txt"
ato = "_UTF16.txt"

Print mojiretsu
StReplace(mojiretsu , mae, ato)
Print mojiretsu
Print
Print "何かキーを押すと例文を変更します。"
Sleep
Print
mojiretsu = "青は愛より出でて愛より青し"
mae = "愛"
ato = "藍"

Print mojiretsu
StReplace(mojiretsu , mae, ato)
Print mojiretsu

mae = "藍より出でて"
ato = "藍から生成するが"
StReplace(mojiretsu , mae, ato)
Print mojiretsu
mae = "藍より青し"
ato = "藍より青い"
StReplace(mojiretsu , mae, ato)
Print mojiretsu

Print
Print "何かキーを押すと、置換速度チェックの例文を実行します。"
Sleep

Dim As String g="11001111000001"
For n As Long=1 To 15
    g+=g
Next
Print g
Print " の 11110000 を z に置換"
Print "置換前の文字列の文字数 "; Len(g)
Print

Dim As Double t=Timer
StReplace(g,"11110000","z")

Print "置換にかかった時間 ";Timer-t; " 秒"
Print "置換語後の文字数　　　　";Len(g)
Print
Print "↓　置換後の文字列の先頭 50 文字 "
Print Left(g,50)
Print ". . ."
Print Right(g,50)
Print "↑　置換後の文字列の後ろ 50 文字 "
Print
Print "何かキーを押すと終了します。" 
Sleep


Sub StReplace(ByRef Expression As String, ByRef Find As String, ByRef Replacement As String, ByVal Start As Integer = 1)
   Var p = InStr(Start, Expression, Find), li = Len(Find), ls = Len(Replacement) : If li = ls Then li = 0
   While p
      If li Then 
         Expression = Left(Expression, p - 1) & Replacement & Mid(Expression, p + li) 
      Else 
         Mid(Expression, p) = Replacement
      End If
      p = InStr(p + ls, Expression, Find)
   Wend
End Sub

ページの頭に戻る

dodicat さんの関数(高速バージョン)

ReplaceFunctionDodicat2.bas このプログラムは ShiftJIS で保存して実行して下さい。

'ReplaceFunctionDodicat "SAR"
'by dodicat ≫ May 07, 2022 16:28
'https://www.freebasic.net/forum/viewtopic.php?p=291947#p291947

#cmdline "-gen gcc -O 2"
Declare Function tallynum(somestring As String,partstring As String) As Integer
Declare Function SAR(original As String ,find As String ,replace As String) As String

Print "Mississippi の i を消去"
Print SAR("Mississippi","i","")
Print
Print "何かキーを押すと、置換速度チェックの例文を実行します。"
Sleep

Dim As String s
Dim As String g="11001111000001"
For n As Long=1 To 17
    g+=g
Next
Print g
Print " の 11110000 を z に置換"
Print "置換前の文字列の文字数 "; Len(g)
Print
Dim As Double t=Timer
s=SAR(g,"11110000","z")
Print "置換にかかった時間 ";Timer-t; " 秒"
Print "置換語後の文字数　　　　";Len(s)
Print
Print "↓　置換後の文字列の先頭 50 文字 "
Print Left(s,50)
Print ". . ."
Print Right(s,50)
Print "↑　置換後の文字列の後ろ 50 文字 "
Print
Print "何かキーを押すと例文を変更します。"
Sleep

Dim mojiretsu As String
Dim mae As String
Dim ato As String

mojiretsu = "H:\Tool\FbEdit\ライブラリ\window9\例.txt"
mae = ".txt"
ato = "_UTF16.txt"

Print mojiretsu
Print SAR(mojiretsu , mae, ato)
Print

Dim mojiretsuW As WString *1000
Dim maeW As WString *100
Dim atoW As WString *100

mojiretsuW = WStr("H:\Tool\FbEdit\ライブラリ\window9\例.txt")
maeW = WStr(".txt")
atoW = WStr("_UTF16.txt")

Print mojiretsuW
Print SAR(mojiretsuW , maeW, atoW)
Print
Print "何かキーを押すと例文を変更します。"
Sleep

Print
mojiretsu = "青は愛より出でて愛より青し"
Print mojiretsu

mae = "愛"
ato = "藍"
mojiretsu = SAR(mojiretsu , mae, ato)
Print mojiretsu

mae = "藍より出でて"
ato = "藍から生成するが"
mojiretsu = SAR(mojiretsu , mae, ato)
Print mojiretsu

mae = "藍より青し"
ato = "藍より青い"
Print SAR(mojiretsu , mae, ato) 'この時点では mojiretsu の内容は変わっていない！

Print
Print "何かキーを押すと終了します。" 
Sleep

'**********************************************************************
Function tallynum(somestring As String,partstring As String) As Integer
  Dim As Integer i,j,ln,lnp,count,num
  ln=Len(somestring):If ln=0 Then Return 0
  lnp=Len(partstring):If lnp=0 Then Return 0
  count=0
  i=-1
  Do
    i+=1
    If somestring[i] <> partstring[0] Then Continue Do
    If somestring[i] = partstring[0] Then
      For j=0 To lnp-1
        If somestring[j+i]<>partstring[j] Then Continue Do
      Next j
    End If
    count+=1
    i=i+lnp-1
  Loop Until i>=ln-1
  Return count
End Function

Function SAR(original As String ,find As String ,replace As String) As String
  If Len(find) = 0 Then Return original
  Var t=tallynum(original,find) 'find occurencies of find
  If t=0 Then Return original
  Dim As Long found,n,staid,m
  Var Lf = Len(find),Lr = Len(replace),Lo = Len(original)
  t = Len(original) - t * Lf + t * Lr             'length of output string
  Dim As String res = String(t,0)                 'output string
  Do
    If original[n] = find[0] Then               'got a possible
      For m = 0 To Lf - 1
        If original[n + m] <> find[m] Then GoTo lbl 'no
      Next m
      found = 1                               'Bingo
    End If
    If found Then
      For m = 0 To Lr - 1
        res[staid] = replace[m]             'insert the replacerment
        staid += 1
      Next m
      n += Lf
      found = 0
      Continue Do
    End If
    lbl:
    res[staid] = original[n]
    staid += 1
    n += 1
  Loop Until n >= Lo
  Return res
End Function

ページの頭に戻る

xroot さんの関数(ポインタを利用した最高速バージョン)

ReplaceStrXroot.bas　このプログラムは ShiftJIS で保存して実行して下さい。

'ReplaceFunction
'Replace In Asm
'https://www.freebasic.net/forum/viewtopic.php?p=148641#p148641
'by xroot ≫ Nov 26, 2010 20:34
'https://www.freebasic.net/forum/viewtopic.php?p=291931#p291931
'by fxm ≫ May 05, 2022 7:15

Declare Function ReplaceStr(iStr As zstring ptr,iFind As zstring ptr,iRep as zstring ptr) As zstring Ptr
Dim shared as zstring ptr dStr : dStr = Callocate(2000000)

Dim as zstring ptr OriginalStr ,FindStr ,RepStr
Dim StringVal As String

OriginalStr = @"Mississippi"
FindStr = @"i"
RepStr = @""

? *OriginalStr
? "Mississippi の i を消去"
? *ReplaceStr(OriginalStr,FindStr,RepStr)
?

OriginalStr = @"H:\Tool\FbEdit\ライブラリ\window9\例.txt"
FindStr = @".txt"
RepStr = @"_UTF16.txt"

? *OriginalStr
? *ReplaceStr(OriginalStr,FindStr,RepStr)
Print
Print "何かキーを押すと例文を変更します。"
Sleep

Print
OriginalStr = @"青は愛より出でて愛より青し"
FindStr = @"愛"
RepStr = @"藍"
Print *OriginalStr
Print *ReplaceStr(OriginalStr,FindStr,RepStr)
StringVal = *ReplaceStr(OriginalStr,FindStr,RepStr)
Print

'OriginalStr = @ StringVal 'これは、文字列変数では記述子へのポインタを返すため使えない
OriginalStr = StrPtr(StringVal)
Print *OriginalStr
FindStr = @"藍より出でて"
RepStr = @"藍から生成するが"
Print *ReplaceStr(OriginalStr,FindStr,RepStr)
Print

StringVal = *ReplaceStr(OriginalStr,FindStr,RepStr)
OriginalStr = StrPtr(StringVal)
FindStr = @"藍より青し"
RepStr = @"藍より青い"
Print *OriginalStr
Print *ReplaceStr(OriginalStr,FindStr,RepStr)
Print
Print
Print "何かキーを押すと、置換速度チェックの例文を実行します。"
Sleep

Dim As String s
Dim As String g="11001111000001"
For n As Long=1 To 17
    g+=g
Next
Print g
Print " の 11110000 を z に置換"
Print "置換前の文字列の文字数 "; Len(g)
Print
OriginalStr = StrPtr(g)
FindStr = @"11110000"
RepStr = @"z"

Dim As Double t=Timer
StringVal = *ReplaceStr(OriginalStr,FindStr,RepStr)
Print "置換にかかった時間 ";Timer-t; " 秒"
Print "置換語後の文字数　　　　";Len(StringVal)
Print
Print "↓　置換後の文字列の先頭 50 文字 "
Print Left(StringVal,50)
Print ". . ."
Print Right(StringVal,50)
Print "↑　置換後の文字列の後ろ 50 文字 "
Print
Print "何かキーを押すと終了します。" 
Sleep

DeAllocate(dStr)


Function ReplaceStr(iStr As zstring ptr,iFind As zstring ptr,iRep as zstring ptr) As zstring ptr
    Dim as integer iSize=Len(*iStr)-Len(*iFind)
        Asm
        mov esi,[iStr]
        add [iSize],esi
        mov ebx,[iFind]
        inc dword ptr[iSize]
        mov edi,[dStr]
        sub esi,1
        jmp Start1
Start2: add esi,ecx
Start1: add esi,1
        cmp [iSize],esi
        jle Done
        movzx eax,BYTE PTR[esi]
        cmp al,[ebx]
        je Match
        mov [edi],al
        add edi,1
        jmp Start1
Match:  mov ecx,-1
        mov edx,ebx
B1:     add ecx,1
        movzx eax,BYTE PTR[edx]
        test eax,eax
        jz Change
        add edx,1
        cmp [esi+ecx],al
        je B1
        movzx eax,BYTE PTR[esi]
        mov [edi],al
        add edi,1
        jmp Start1
Change: mov edx,[iRep]
        sub ecx,1
B2:     movzx eax,BYTE PTR[edx]
        test eax,eax
        jz Start2
        add edx,1
        mov [edi],al
        add edi,1
        jmp B2
Done:   mov ecx,-1
B3:     add ecx,1
        movzx eax,BYTE PTR[esi+ecx]
        mov [edi+ecx],al
        test eax,eax
        jnz B3
        mov eax,[dStr]
        mov [Function],eax
    End Asm
End Function

ページの頭に戻る

Eternal_Pain さんの関数

Eternal_Pain さんの StrReplace 関数を転載させていただきます。

STRreplace_Eternal_Pain.bas　このプログラムは ShiftJIS で保存して実行して下さい。

'STRreplace_Eternal_Pain
'https://www.freebasic-portal.de/code-beispiele/string-funktionen/strreplace-59.html
'Eternal_Pain	 '03.08.2007

Declare Function StrReplace (ByVal StrEx As String, ByVal StrMask As String, ByVal StrRplce As String) As String

Dim BeforeString As String
Dim AfterString As String
Dim SearchString As String
Dim ReplaceString As String

BeforeString = "H:\Tool\FbEdit\ライブラリ\window9\例.txt"
SearchString = ".txt"
ReplaceString = "_UTF16.txt"
AfterString = StrReplace(BeforeString,SearchString,ReplaceString)

? BeforeString
? AfterString

?
BeforeString = "青は愛より出でて愛より青し"
SearchString = "愛"
ReplaceString = "藍"
AfterString = StrReplace(BeforeString,SearchString,ReplaceString)

? BeforeString
? AfterString
?
BeforeString = AfterString
SearchString = "藍より出でて"
ReplaceString = "藍から生成するが"
AfterString = StrReplace(BeforeString,SearchString,ReplaceString)

? BeforeString
? AfterString
?
BeforeString = AfterString
SearchString = "藍より青し"
ReplaceString = "藍より青い"
AfterString = StrReplace(BeforeString,SearchString,ReplaceString)

? BeforeString
? AfterString
Print
Print "何かキーを押すと、置換速度チェックの例文を実行します。"
Sleep

Dim As String s
Dim As String g="11001111000001"
For n As Long=1 To 15
    g+=g
Next
Print g
Print " の 11110000 を z に置換"
Print "置換前の文字列の文字数 "; Len(g)
Print

Dim As Double t=Timer
s = StrReplace(g,"11110000","z")
Print "置換にかかった時間 ";Timer-t; " 秒"
Print "置換語後の文字数　　　　";Len(s)
Print
Print "↓　置換後の文字列の先頭 50 文字 "
Print Left(s,50)
Print ". . ."
Print Right(s,50)
Print "↑　置換後の文字列の後ろ 50 文字 "
Print
Print "何かキーを押すと終了します。" 
Sleep

'-----------------------------------------------------------------------------'
Function StrReplace (ByVal StrEx As String, _
                     ByVal StrMask As String, _
                     ByVal StrRplce As String) As String

    If Len(StrEx)=0 Or Len(StrMask)>Len(StrEx) Then Return StrEx

    Dim Buffer As String=StrEx
    Dim MaskSearch As UInteger
    Dim MFound As Byte
    Dim lp As UInteger=1

    Do
        MaskSearch=InStr(lp,Buffer,StrMask)
        MFound=0

        If MaskSearch Then
            MFound=1:lp=MaskSearch+Len(StrRplce)
            ''
            Buffer=Left(Buffer,MaskSearch-1)+ _
            StrRplce+ _
            Right(Buffer,Len(Buffer)-(MaskSearch+(Len(StrMask)-1)))
            ''
        End If

    Loop While MFound=1

    Return Buffer
End Function

ページの頭に戻る

補足に戻る

←リンク元に戻る　プログラム開発関連に戻る

ページ歴史:2022-07-24
日本語翻訳：WATANABE Makoto、原文著作者：fxm、TJF、dodicat、xroot、Eternal_Pain

FreeBASIC 文字列関数 Replace()

文字列関数 Replace() 左にメニュー・フレームが表示されていない場合は、ここをクリックして下さい

fxm さんの関数

TJF さんの関数

dodicat さんの関数(高速バージョン)

xroot さんの関数(ポインタを利用した最高速バージョン)

Eternal_Pain さんの関数

文字列関数 Replace()　左にメニュー・フレームが表示されていない場合は、ここをクリックして下さい