以前公開していたものはそれ単品では動作しない形式だったので、
必要な関数なども併せてフルバージョンとして置いておきます。
個人的に作成・利用をしているマクロで十分なデバッグが行われているとは言えません。
また処理対象を直接編集・保存している為、処理後に元に戻すことができません。
こういった点を理解した上、自己責任での利用をお願いします。
GrepAndReplace.vbs
'Grep結果を基に置換を行うマクロ
'
'【詳細】
'サクラエディタのGrep結果を基に文字列の置換を行います。
'置換の対象はGrep結果に載っているファイル&行だけです。
'置換文字列の指定はGrep結果の1行目に下記のフォーマットで記入してください。
'置換前後の文字列に「タブ」や「改行」は指定できません。
'【フォーマット】
'置換前文字列[tab]置換後文字列
'【例】"あいうえお"を"かきくけこ"に置換する場合
'あいうえお かきくけこ
'---------------------------------------------------------------------
'サクラエディタの検索パラメータ
Const OPT_WORD = 1 '単語単位で探す(W)
Const OPT_DIFF = 2 '英大文字と小文字を区別する(C)
Const OPT_RE = 4 '正規表現(E)
Const OPT_MSG = 8 '見つからないときにメッセージを表示(M)
Const OPT_DCLS = 16 '検索ダイアログを自動的に閉じる(L)
Const OPT_LOOP = 32 '先頭（末尾）から再検索する(Z)
Const OPT_CB = 64 'クリップボードから貼り付ける(T)
Const OPT_TGT = 128 '0:ファイル全体(O),1:選択範囲(S)
'置換処理を行うStrategy
'Publicで宣言されている部分の処理を差し替えることで、
'Grep結果に対する様々な処理を実装することができます。
Class Strategy
Private lngSize
Private strBefore
Private strAfter
Private lngOption
Private strPreviousPath
Private strErrMessage
'コンストラクタ
Private Sub Class_Initialize()
End Sub
'デストラクタ
Private Sub Class_Terminate()
End Sub
'初期化処理
Public Function initialize()
initialize = False
'1:選択範囲(S) + '検索ダイアログを自動的に閉じる(L) + '英大文字と小文字を区別する(C)
lngOption = OPT_TGT + OPT_DCLS + OPT_DIFF
lngSize = 0
strPreviousPath = ""
strErrMessage = ""
Dim strReplaceStringArray
strReplaceStringArray = Split(getString(Editor.GetLineStr(1)), vbTab)
If UBound(strReplaceStringArray) <> 1 Then
'置換前後の文字列が正しく設定されていない場合は処理しない
strErrMessage = "置換前後の文字列が正しく設定されていません。" & vbCrLf & "処理を終了します。"
Else
strBefore = strReplaceStringArray(0)
strAfter = strReplaceStringArray(1)
initialize = True
End If
End Function
'前処理
Public Function execPreProc()
execPreProc = True
End Function
'処理
Public Function exec(ByRef objGrepResult)
With objGrepResult
If strPreviousPath <> .strFilePath Then
If strPreviousPath <> "" Then
Call Editor.FileSave()
Call Editor.FileClose()
End If
Call Editor.FileOpen(.strFilePath)
End If
If replaceLine(.lngRow, strBefore, strAfter) Then
lngSize = lngSize + 1
End If
strPreviousPath = .strFilePath
End With
exec = True
End Function
'後処理
Public Sub execPostProc()
Call Editor.FileSave()
Call Editor.FileClose()
End Sub
'マクロ名
Public Function getTitle()
getTitle = "GrepAndReplace"
End Function
'処理開始時メッセージ
Public Function getNoticeMessage()
getNoticeMessage = _
"Grep結果に挙がっている全てのファイル&行に対し置換を行います。" & vbCrLf & _
"Grep結果が自動的に閉じられますので、Grep結果を残したい場合は事前に保存をしてください。" & vbCrLf & _
"また実行時にはGrep結果以外のファイルは全て閉じてください。" & vbCrLf & _
vbCrLf & _
"置換前文字列：""" & strBefore & """" & vbCrLf & _
"置換後文字列：""" & strAfter & """"
End Function
'処理終了時メッセージ
Public Function getEndMessage()
getEndMessage = lngSize & "件置換しました。"
End Function
'エラー時メッセージ
Public Function getErrMessage()
getErrMessage = strErrMessage
End Function
Public Sub setErrMessage(ByRef strArg)
strErrMessage = strArg
End Sub
'指定行のみを置換
Private Function replaceLine(ByRef lngRow, ByRef strBfr, ByRef strAft)
replaceLine = False
Dim lngR
Dim strOrgLine
With Editor
Call .Jump(lngRow, 1)
strOrgLine = .GetLineStr(lngRow)
Call .GoLineTop(1)
Call .BeginSelect()
Call .Jump(lngRow + 1, 1)
If .GetLineCount(0) <> lngRow Then
Call .GoLineTop(1)
Call .Left_Sel()
End If
Call .ReplaceAll(strBfr, strAft, lngOption)
If strOrgLine = .GetLineStr(lngRow) Then
replaceLine = False
Else
replaceLine = True
End If
End With
End Function
End Class
'ここから下は流用可能なロジック
'---------------------------------------------------------------------
Call manageMain()
'メイン処理の実行
Sub manageMain()
'Strategyのインスタンス生成
Dim objStrategy: Set objStrategy = New Strategy
'初期化処理
If objStrategy.initialize() = False Then
'初期化処理に失敗した場合は処理終了
MsgBox objStrategy.getErrMessage()
Set objStrategy = Nothing
Exit Sub
End If
'処理開始可否確認
Dim objDialog: Set objDialog = CreateObject("WScript.Shell")
Dim lngRtn: lngRtn = objDialog.Popup(objStrategy.getNoticeMessage(), 0, objStrategy.getTitle(), 1)
If lngRtn = 1 Then
If execMain(objStrategy) Then
'正常に処理した場合
MsgBox objStrategy.getEndMessage()
Else
'処理中断した場合
MsgBox objStrategy.getErrMessage()
End If
Else
MsgBox "処理を中止しました。"
End If
Set objDialog = Nothing
Set objStrategy = Nothing
End Sub
'メイン処理
Function execMain(Byref objStrategy)
execMain = False
'Grepされたフォルダのパスを取得
Dim strFolderPath: strFolderPath = getFolderPath()
If strFolderPath = "" Then
Call objStrategy.setErrMessage("Grep結果ファイルが想定外のフォーマットです。")
Exit Function
End If
'Grep結果の取得
Dim objGrepResults: objGrepResults = getGrepResults(strFolderPath)
'Grep結果のファイルを閉じる
Editor.FileClose()
'前処理
If objStrategy.execPreProc() Then
'前処理が正常な場合のみ実行
Dim blnErr: blnErr = False
Dim lngIu: lngIu = UBound(objGrepResults)
Dim lngI
For lngI = 0 To lngIu
'本処理
If objStrategy.exec(objGrepResults(lngI)) = False Then
'処理が正常終了しなかった場合は終わり
blnErr = True
Exit For
End If
Next
If blnErr = False Then
execMain = True
End If
End If
'後処理
Call objStrategy.execPostProc()
End Function
'対象ファイルのパスと行を全て取得する。
Function getGrepResults(Byref strFolderPath)
Dim lngRu: lngRu = Editor.GetLineCount(0)
Dim lngR
Dim lngI: lngI = -1
Dim objGrepResults(): Redim objGrepResults(lngRu)
Dim strLine
For lngR = lngRu To 1 Step -1
strLine = getLine(lngR)
If beginWith(strLine, strFolderPath) Then
lngI = lngI + 1
Set objGrepResults(lngI) = getGrepResult(strLine)
End If
Next
Redim Preserve objGrepResults(lngI)
getGrepResults = objGrepResults
End Function
'対象ファイルのパスと行を取得する。
Function getGrepResult(ByRef strArgLine)
Dim objGrepResult: Set objGrepResult = New GrepResult
With objGrepResult
.strLine = strArgLine
.strFilePath = getFilePath(strArgLine)
.lngRow = getRow(strArgLine)
.lngCol = getCol(strArgLine)
End With
Set getGrepResult = objGrepResult
Set objGrepResult = Nothing
End Function
'Grep結果から行を取得する。
Function getLine(ByRef lngR)
getLine = getString(Editor.GetLineStr(lngR))
End Function
'末尾の改行を削除した文字列を取得する。
Function getString(ByRef strLine)
If endWith(strLine, vbCrLf) Then
getString = Left(strLine, Len(strLine) - Len(vbCrLf))
ElseIf endWith(strLine, vbCr) Then
getString = Left(strLine, Len(strLine) - Len(vbCr))
ElseIf endWith(strLine, vbLf) Then
getString = Left(strLine, Len(strLine) - Len(vbLf))
Else
getString = strLine
End If
End Function
'Grep結果から対象フォルダを取得する。
Function getFolderPath()
Const STR_FOLDER_PREFIX = "フォルダ "
getFolderPath = ""
Dim lngRu: lngRu = Editor.GetLineCount(0)
Dim lngR
Dim strLine
For lngR = 1 To lngRu
strLine = getLine(lngR)
If beginWith(strLine, STR_FOLDER_PREFIX) Then
getFolderPath = Mid(strLine, Len(STR_FOLDER_PREFIX) + 1)
Exit Function
End If
Next
End Function
'strArg0がstrArg1で始まる文字列か。
Function beginWith(ByRef strArg0, ByRef strArg1)
beginWith = False
If Len(strArg0) < Len(strArg1) Then
Exit Function
End If
If InStr(1, strArg0, strArg1) = 1 Then
beginWith = True
End If
End Function
'strArg0がstrArg1で終わる文字列か。
Function endWith(ByRef strArg0, ByRef strArg1)
endWith = False
If Len(strArg0) < Len(strArg1) Then
Exit Function
End If
If Right(strArg0, Len(strArg1)) = strArg1 Then
endWith = True
End If
End Function
'Grep結果からファイルのパスを取得する。
Function getFilePath(ByRef strArgLine)
getFilePath = ""
Dim lngPlPos: lngPlPos = getPlPos(strArgLine)
Dim strPath: strPath = Left(strArgLine, lngPlPos - 1)
getFilePath = strPath
End Function
'Grep結果から行を取得する。
Function getRow(ByRef strArgLine)
getRow = 0
Dim lngPlPos: lngPlPos = getPlPos(strArgLine)
Dim lngCmmPos: lngCmmPos = getCmmPos(strArgLine)
Dim strRow: strRow = Mid(strArgLine, lngPlPos + 1, lngCmmPos - lngPlPos - 1)
getRow = CLng(Trim(strRow))
End Function
'Grep結果から列を取得する。
Function getCol(ByRef strArgLine)
getCol = 0
Dim lngCmmPos: lngCmmPos = getCmmPos(strArgLine)
Dim lngPrPos: lngPrPos = getPrPos(strArgLine)
Dim strCol: strCol = Mid(strArgLine, lngCmmPos + 1, lngPrPos - lngCmmPos - 1)
getCol = CLng(Trim(strCol))
End Function
'"("の位置を取得
Function getPlPos(ByRef strArgLine)
getPlPos = -1
Dim lngCrnPos: lngCrnPos = InStr(3, strArgLine, ":")
Dim lngP
Dim lngPlPos
For lngP = lngCrnPos To 3 Step -1
If Mid(strArgLine, lngP, 1) = "(" Then
lngPlPos = lngP
Exit For
End If
Next
getPlPos = lngPlPos
End Function
'","の位置を取得
Function getCmmPos(ByRef strArgLine)
getCmmPos = -1
Dim lngPlPos: lngPlPos = getPlPos(strArgLine)
Dim lngCmmPos: lngCmmPos = InStr(lngPlPos, strArgLine, ",")
getCmmPos = lngCmmPos
End Function
'")"の位置を取得
Function getPrPos(ByRef strArgLine)
getPrPos = -1
Dim lngCmmPos: lngCmmPos = getCmmPos(strArgLine)
Dim lngPrPos: lngPrPos = InStr(lngCmmPos, strArgLine, ")")
getPrPos = lngPrPos
End Function
Class GrepResult
Public strLine
Public strFilePath
Public lngRow
Public lngCol
End Class
0 件のコメント:
コメントを投稿