以前公開していたものはそれ単品では動作しない形式だったので、
必要な関数なども併せてフルバージョンとして置いておきます。
個人的に作成・利用をしているマクロで十分なデバッグが行われているとは言えません。
また処理対象を直接編集・保存している為、処理後に元に戻すことができません。
こういった点を理解した上、自己責任での利用をお願いします。
GrepAndDelete.vbs
'Grep結果を基に行削除を行うマクロ
'
'【詳細】
'サクラエディタのGrep結果を基に行の削除を行います。
'削除の対象はGrep結果に載っているファイル&行だけです。
'---------------------------------------------------------------------
'行削除処理を行うStrategy
'Publicで宣言されている部分の処理を差し替えることで、
'Grep結果に対する様々な処理を実装することができます。
Class Strategy
Private lngSize
Private strPreviousPath
Private strErrMessage
'コンストラクタ
Private Sub Class_Initialize()
End Sub
'デストラクタ
Private Sub Class_Terminate()
End Sub
'初期化処理
Public Function initialize()
initialize = False
lngSize = 0
strPreviousPath = ""
strErrMessage = ""
initialize = True
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 deleteLine(.lngRow) 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 = "GrepAndDelete"
End Function
'処理開始時メッセージ
Public Function getNoticeMessage()
getNoticeMessage = _
"Grep結果に挙がっている全てのファイル&行に対し削除を行います。" & vbCrLf & _
"Grep結果が自動的に閉じられますので、Grep結果を残したい場合は事前に保存をしてください。" & vbCrLf & _
"また実行時にはGrep結果以外のファイルは全て閉じてください。"
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 deleteLine(ByRef lngRow)
deleteLine = False
With Editor
Call .Jump(lngRow, 1)
Call .GoLineTop(1)
Call .LineDeleteToEnd()
Call .DeleteLine()
End With
deleteLine = True
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 件のコメント:
コメントを投稿