VB用Elements値取得関数

getElementsByName等で取得したInput等のElementsから値を取得する関数です。
input(text,password,file,hidden,checkbox,radio),select,textareaに対応しています。
異なるtype(tag)が混在しているElementsを渡した場合に正しく動作しない事があります。

'エレメントから値を取得
Function getElementsValue(ByRef objElms)
    getElementsValue = ""
    If objElms(0).type = "checkbox" Then
        getElementsValue = getCheckedElementsValue(objElms)
    ElseIf objElms(0).type = "radio" Then
        getElementsValue = getSelectedElementValue(objElms)
    Else
        getElementsValue = getTextElementsValue(objElms)
    End If
End Function

'text,password,select,file,hidden,textarea
Function getTextElementsValue(ByRef objElms)
    getTextElementsValue = ""
    Dim lngIu: lngIu = objElms.Length - 1
    If lngIu = 0 Then
        getTextElementsValue = objElms(0).Value
    ElseIf lngIu > 0 Then
        Dim strVals: ReDim strVals(lngIu)
        Dim lngI
        For lngI = 0 To lngIu
            strVals(lngI) = objElms(lngI).Value
        Next
        getTextElementsValue = strVals
    End If
End Function

'checkbox(選択されているものの値を取得)
Function getCheckedElementsValue(ByRef objElms)
    getCheckedElementsValue = ""
    Dim lngIu: lngIu = objElms.Length - 1
    If lngIu = 0 Then
        If objElms(0).Checked Then
            getCheckedElementsValue = objElms(0).Value
        End If
    ElseIf lngIu > 0 Then
        Dim strVals: ReDim strVals(lngIu)
        Dim lngI
        Dim lngSize: lngSize = 0
        For lngI = 0 To lngIu
            If objElms(lngI).Checked Then
                strVals(lngSize) = objElms(lngI).Value
                lngSize = lngSize + 1
            End If
        Next
        ReDim Preserve strVals(lngSize - 1)
        getCheckedElementsValue = strVals
    End If
End Function

'checkbox(選択されているかどうかを取得)
Function getElementsChecked(ByRef objElms)
    getElementsChecked = False
    Dim lngIu: lngIu = objElms.Length - 1
    If lngIu = 0 Then
        getElementsChecked = objElms(0).Checked
    ElseIf lngIu > 0 Then
        Dim strVals: ReDim strVals(lngIu)
        Dim lngI
        For lngI = 0 To lngIu
            strVals(lngI) = objElms(lngI).Checked
        Next
        getElementsChecked = strVals
    End If
End Function

'radio
Function getSelectedElementValue(ByRef objElms)
    getSelectedElementValue = ""
    Dim lngIu: lngIu = objElms.Length - 1
    Dim lngI
    For lngI = 0 To lngIu
        If objElms(lngI).Checked Then
            getSelectedElementValue = objElms(lngI).Value
        End If
    Next
End Function

VBScript用入力フォーム表示関数

InternetExplorer Objectを利用してVBScriptで入力フォームを表示する関数です。
入力フォームの内容をプロパティの指定だけで表示する簡易版と、HTMLで自由に設定できるHTML版を作成しました。
実行するにはVB用Elements値取得関数が必要です。

'配列で指定したプロパティの値を入力フォームから取得する。
Dim strProps: strProps = Array("FIELD1", "FIELD2", "FIELD3")
Dim strVals: strVals = showInputFormLite("Input", strProps, 300, 200)

'取得結果の表示
Dim lngIu: lngIu = UBound(strVals)
Dim lngI
Dim strMsg: strMsg = ""
For lngI = 0 To lngIu
    If IsArray(strVals(lngI)) Then
        Dim lngJu: lngJu = UBound(strVals(lngI))
        Dim lngJ
        For lngJ = 0 To lngJu
            strMsg = strMsg & strProps(lngI) & "='" & strVals(lngI)(lngJ) & "'" & vbCrLf
        Next
    Else
        strMsg = strMsg & strProps(lngI) & "='" & strVals(lngI) & "'" & vbCrLf
    End If
Next
WScript.echo strMsg

'============================================================
'入力フォーム表示(簡易版)
Function showInputFormLite(ByRef strTitle, ByRef strProps, ByRef lngWidth, ByRef lngHeight)
    Dim lngIu: lngIu = UBound(strProps)
    Dim lngI
    Dim strHtml: strHtml = ""
    strHtml = strHtml & "<form>"
    For lngI = 0 To lngIu
        strHtml = strHtml & strProps(lngI) & ": <input type='text' name='" & strProps(lngI) & "' /><br/>"
    Next
    strHtml = strHtml & "    <input type='hidden' name='submit_flg' value='0' />"
    strHtml = strHtml & "    <input type='button' onclick = ""getElementsByName('submit_flg')(0).value = '1';"" value='OK' />"
    strHtml = strHtml & "</form>"
    
    showInputFormLite = showInputForm(strTitle, strHtml, strProps, lngWidth, lngHeight)
End Function

'入力フォーム表示(HTML版)
Function showInputForm(ByRef strTitle, ByRef strHtml, ByRef strProps, ByRef lngWidth, ByRef lngHeight)
    'IEのインスタンスを生成
    Dim objIe: Set objIe = CreateObject("InternetExplorer.Application")
    With objIe
        'インプットフォーム初期値設定
        .Width = lngWidth
        .Height = lngHeight
        .ToolBar = False
        .StatusBar = False
        .Visible = True
        .Navigate "about:blank"
        'フォームが表示されるまで待機
        Do While .Busy
            WScript.Sleep 500
        Loop
        .Document.Title = strTitle
        .Document.Body.InnerHtml = strHtml
        'ボタン押下まで待機
        On Error Resume Next
        Dim blnErr: blnErr = False
        Do While objIe.Busy Or (getElementsValueByName(objIe, "submit_flg") <> "1")
            If Err.Number <> 0 Then
                On Error GoTo 0
                blnErr = True
                Exit Do
            End If
            WScript.Sleep 500
        Loop
        Dim lngIu: lngIu = UBound(strProps)
        Dim strVals: ReDim strVals(lngIu)
        If blnErr = False Then
            Dim lngI
            For lngI = 0 To lngIu
                strVals(lngI) = getElementsValueByName(objIe, strProps(lngI))
            Next
            .Quit
        End If
    End With
    Set objIe = Nothing
    showInputForm = strVals
End Function

'指定したnameのエレメントから値を取得
Function getElementsValueByName(Byref objIe, ByRef strName)
    getElementsValueByName = getElementsValue(objIe.Document.GetElementsByName(strName))
End Function

サクラエディタ用GrepDeleteStrategy

サクラエディタのGrep結果を基に行の削除を行うStrategyです。
実行するにはサクラエディタ用Grep結果処理マクロが必要です。

Class Strategy

    Private lngLSize
    Private lngFSize
    Private strPreviousPath

    'コンストラクタ
    Private Sub Class_Initialize()
        strPreviousPath = ""
        lngLSize = 0
        lngFSize = 0
    End Sub
    
    'デストラクタ
    Private Sub Class_Terminate()
    End Sub
    
    '開始処理
    Public Function execStartProc()
        execStartProc = False

        Dim objDialog: Set objDialog = CreateObject("WScript.Shell")
        Dim lngRtn: lngRtn = objDialog.Popup( _
            "Grep結果を基に行の削除を行います。" & vbCrLf & _
            "Grep結果以外のファイルは閉じてください。" & vbCrLf & _
            "またGrep結果はGrepReplace実行時に自動的に閉じられますので" & vbCrLf & _
            "結果を残したい場合は事前に保存をしてください。", _
            0, "GrepReplace", 1)
            
        If lngRtn = 1 Then
            execStartProc = True
        Else
            MsgBox "処理をキャンセルしました。"
        End If
        Set objDialog = Nothing
    End Function
    
    '前処理
    Public Function execPreProc(ByRef objGrepResults)
        execPreProc = True
    End Function
    
    '本処理
    Public Function execProc(ByRef objGrepResult)
        With objGrepResult
            If strPreviousPath <> .strFilePath Then
                If strPreviousPath <> "" Then
                    Call Editor.FileSave()
                    Call Editor.FileClose()
                End If
                Call Editor.FileOpen(.strFilePath)
                lngFSize = lngFSize + 1
            End If
            Call deleteLine(.strFilePath, .lngRow)
            lngLSize = lngLSize + 1
            strPreviousPath = .strFilePath
        End With
        execProc = True
    End Function

    '後処理
    Public Function execPostProc(ByRef objGrepResults)
        Call Editor.FileSave()
        Call Editor.FileClose()
        execPostProc = True
    End Function
    
    '終了処理
    Public Sub execEndProc()
        MsgBox lngFSize & "ファイル、合計" & lngLSize & "行削除しました。"
    End Sub
    
    'エラー処理
    Public Sub execErrProc(ByRef lngErrCode)
        If lngErrCode = ERR_FORMAT Then
            MsgBox "Grepファイルフォーマットエラー"
        Else
            MsgBox "エラー"
        End If
    End Sub
    
    Private Sub deleteLine(ByRef strFilePath, ByRef lngRow)
        With Editor
            Call .GoFileTop(0)
            Call .Jump(lngRow, 1)
            Call .DeleteLine()
            Call .ReDraw(0)
        End With
    End Sub

End Class

Call main(New Strategy)

サクラエディタ用GrepReplaceStrategy

サクラエディタのGrep結果を基に置換を行うStrategyです。
実行するにはサクラエディタ用Grep結果処理マクロが必要です。

Const OPT_WORD = 1    '単語単位で探す
Const OPT_DIFF = 2    '英大文字と小文字を区別する
Const OPT_RE = 4    '正規表現
Const OPT_MSG = 8    '見つからないときにメッセージを表示
Const OPT_DCLS = 16    '検索ダイアログを自動的に閉じる
Const OPT_LOOP = 32    '先頭(末尾)から再検索する
Const OPT_CB = 64    'クリップボードから貼り付ける
Const OPT_TGT = 128    '設定なし:ファイル全体、設定あり:選択範囲

Class Strategy

    Private lngLSize
    Private lngFSize
    Private strBefore
    Private strAfter
    Private lngReplaceOption
    Private strPreviousPath

    'コンストラクタ
    Private Sub Class_Initialize()
        strPreviousPath = ""
        lngReplaceOption = OPT_TGT + OPT_DCLS + OPT_DIFF
        lngLSize = 0
        lngFSize = 0
    End Sub
 
    'デストラクタ
    Private Sub Class_Terminate()
    End Sub
 
    '開始処理
    Public Function execStartProc()
        execStartProc = False

        strBefore = InputBox("置換前の文字列を入力してください。")
        If strBefore = "" Then
            MsgBox "処理をキャンセルしました。"
            Exit Function
        End If
        strAfter = InputBox("置換後の文字列を入力してください。")

        Dim objDialog: Set objDialog = CreateObject("WScript.Shell")
        Dim lngRtn: lngRtn = objDialog.Popup( _
            "Grep結果を基に下記の置換を行います。" & vbCrLf & _
            "置換前='" & strBefore & "'" & vbCrLf & _
            "置換後='" & strAfter & "'" & vbCrLf & _
            "Grep結果以外のファイルは閉じてください。" & vbCrLf & _
            "またGrep結果はGrepReplace実行時に自動的に閉じられますので" & vbCrLf & _
            "結果を残したい場合は事前に保存をしてください。", _
            0, "GrepReplace", 1)
         
        If lngRtn = 1 Then
            execStartProc = True
        Else
            MsgBox "処理をキャンセルしました。"
        End If
        Set objDialog = Nothing
    End Function
 
    '前処理
    Public Function execPreProc(ByRef objGrepResults)
        execPreProc = True
    End Function
 
    '本処理
    Public Function execProc(ByRef objGrepResult)
        With objGrepResult
            If strPreviousPath <> .strFilePath Then
                If strPreviousPath <> "" Then
                    Call Editor.FileSave()
                    Call Editor.FileClose()
                End If
                Call Editor.FileOpen(.strFilePath)
                lngFSize = lngFSize + 1
            End If
            Call replaceLine(.strFilePath, .lngRow, strBefore, strAfter)
            lngLSize = lngLSize + 1
            strPreviousPath = .strFilePath
        End With
        execProc = True
    End Function

    '後処理
    Public Function execPostProc(ByRef objGrepResults)
        Call Editor.FileSave()
        Call Editor.FileClose()
        execPostProc = True
    End Function
 
    '終了処理
    Public Sub execEndProc()
        MsgBox "'" & strBefore & "'→'" & strAfter & "'" & vbCrLf & _
            lngFSize & "ファイル、合計" & lngLSize & "行置換しました。"
    End Sub
 
    'エラー処理
    Public Sub execErrProc(ByRef lngErrCode)
        If lngErrCode = ERR_FORMAT Then
            MsgBox "Grepファイルフォーマットエラー"
        Else
            MsgBox "エラー"
        End If
    End Sub
 
    Private Sub replaceLine(ByRef strFilePath, ByRef lngRow, ByRef strBfr, ByRef strAft)
        With Editor
            Call .GoFileTop(0)
            Call .Jump(lngRow, 1)
            Call .GoLineTop(1)
            Call .BeginSelect()
            Call .GoLineEnd_Sel()
            Call .ReplaceAll(strBfr, strAft, lngReplaceOption)
            Call .ReDraw(0)
        End With
    End Sub

End Class

Call main(New Strategy)

サクラエディタ用Grep結果処理Strategy

サクラエディタのGrep結果を基に各種の処理をするStrategyのサンプルです。
これに処理を実装していけばサクラエディタ用Grep結果処理マクロを使用して、
Grep結果に対していろいろな処理を行うことができます。

Class Strategy

  'コンストラクタ
 Private Sub Class_Initialize()
 End Sub
 
 'デストラクタ
 Private Sub Class_Terminate()
 End Sub
 
 '開始処理
 Public Function execStartProc()
     MsgBox "開始処理"
     execStartProc = True
 End Function
 
 '前処理
 Public Function execPreProc(ByRef objGrepResults)
     MsgBox "前処理:" & UBound(objGrepResults)
     execPreProc = True
 End Function
 
 '本処理
 Public Function execProc(ByRef objGrepResult)
     With objGrepResult
          MsgBox "本処理:" & vbCrLf & "Path='" & .strFilePath & "'" & vbCrLf & "Row='" & .lngRow & "'" & vbCrLf & "Col='" & .lngCol & "'" & vbCrLf & "Text='" & .strText & "'"
     End With
     execProc = True
 End Function

  '後処理
 Public Function execPostProc(ByRef objGrepResults)
     MsgBox "後処理:" & UBound(objGrepResults)
     execPostProc = True
 End Function
 
 '終了処理
 Public Sub execEndProc()
     MsgBox "終了処理"
 End Sub
 
 'エラー処理
 Public Sub execErrProc(ByRef lngErrCode)
     MsgBox "エラー処理"
 End Sub

End Class

Call main(New Strategy)

サクラエディタ用Grep結果処理マクロ

サクラエディタのGrep結果を基に各種の処理をするために作成しました。

実行するにはサクラエディタ用Grep結果取得マクロが必要です。

--------------------------------------------------------------------------------

Const ERR_FORMAT = 1
Function main(ByRef objStrategy)
    '開始処理
    If objStrategy.execStartProc() = False Then
        Exit Function
    End If
    'Grepしたフォルダのパスを取得
    Dim strFolderPath: strFolderPath = getFolderPath()
    If strFolderPath = "" Then
        'フォルダのパスが取得できない場合はフォーマットエラー
        Call objStrategy.execErrProc(ERR_FORMAT)
        Exit Function
    End If
    'Grepの結果を全て取得
    Dim objGrepResults: objGrepResults = getGrepResults()
    Call Editor.FileClose()
    '前処理
    If objStrategy.execPreProc(objGrepResults) = False Then
        Exit Function
    End If
    Dim objGrepResult
    For Each objGrepResult In objGrepResults
        '本処理
        If objStrategy.execProc(objGrepResult) = False Then
            Exit For
        End If
    Next
    '後処理
    If objStrategy.execPostProc(objGrepResults) = False Then
        Exit Function
    End If
    '終了処理
    Call objStrategy.execEndProc()
End Function

--------------------------------------------------------------------------------

サクラエディタ用Grep結果取得マクロ

サクラエディタのGrep結果を取得するために作成しました。

実行するにはVBScript用文字列関連の関数(1)が必要です。

'Grep結果を全て取得します。
Function getGrepResults()
    Dim strFolderPath: strFolderPath = getFolderPath()
    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 startsWith(strLine, strFolderPath) Then
            lngI = lngI + 1
            Set objGrepResults(lngI) = getGrepResult(strLine)
        End If
    Next
    ReDim Preserve objGrepResults(lngI)
    getGrepResults = objGrepResults
    Erase objGrepResults
End Function

'Grep結果を1行分取得します。
Function getGrepResult(ByRef strLine)
    Dim objGrepResult: Set objGrepResult = New GrepResult
    With objGrepResult
        .strText = getText(strLine)
        .strFilePath = getFilePath(strLine)
        .lngRow = getRow(strLine)
        .lngCol = getCol(strLine)
    End With
    Set getGrepResult = objGrepResult
    Set objGrepResult = Nothing
End Function

'Grep対象のフォルダを取得します。
Function getFolderPath()
    Const PREFIX_FOLDERPATH = "フォルダ   "
    getFolderPath = ""
    Dim lngRu: lngRu = Editor.GetLineCount(0)
    Dim lngR
    Dim strLine
    For lngR = 1 To lngRu
        strLine = getLine(lngR)
        If startsWith(strLine, PREFIX_FOLDERPATH) Then
            getFolderPath = Mid(strLine, Len(PREFIX_FOLDERPATH) + 1)
            Exit Function
        End If
    Next
End Function

'Grep結果からファイルのパスを取得します。
Function getFilePath(ByRef strLine)
    getFilePath = ""
    Dim lngPlPos: lngPlPos = getPlPos(strLine)
    getFilePath = Left(strLine, lngPlPos - 1)
End Function

'Grep結果から行を取得します。
Function getRow(ByRef strLine)
    getRow = 0
    Dim lngPlPos: lngPlPos = getPlPos(strLine)
    Dim lngCmmPos: lngCmmPos = getCmmPos(strLine)
    Dim strRow: strRow = Mid(strLine, lngPlPos + 1, lngCmmPos - lngPlPos - 1)
    getRow = CLng(Trim(strRow))
End Function

'Grep結果から桁を取得します。
Function getCol(ByRef strLine)
    getCol = 0
    Dim lngCmmPos: lngCmmPos = getCmmPos(strLine)
    Dim lngPrPos: lngPrPos = getPrPos(strLine)
    Dim strCol: strCol = Mid(strLine, lngCmmPos + 1, lngPrPos - lngCmmPos - 1)
    getCol = CLng(Trim(strCol))
End Function

'Grep結果からテキストを取得します。
Function getText(ByRef strLine)
    getText = ""
    Dim lngCrnPos: lngCrnPos = getCrnPos(strLine)
    getText = Mid(strLine, lngCrnPos + 2)
End Function

'Grep結果から行,桁の前括弧の位置を取得します。
Function getPlPos(ByRef strLine)
    getPlPos = -1
    Dim lngCrnPos: lngCrnPos = getCrnPos(strLine)
    Dim lngP
    Dim lngPlPos
    For lngP = lngCrnPos To 1 Step -1
        If Mid(strLine, lngP, 1) = "(" Then
            lngPlPos = lngP
            Exit For
        End If
    Next
    getPlPos = lngPlPos
End Function

'Grep結果から行,桁を区切るカンマの位置を取得します。
Function getCmmPos(ByRef strLine)
    getCmmPos = -1
    Dim lngPlPos: lngPlPos = getPlPos(strLine)
    getCmmPos = InStr(lngPlPos, strLine, ",")
End Function

'Grep結果から行,桁の後ろ括弧の位置を取得します。
Function getPrPos(ByRef strLine)
    getPrPos = -1
    Dim lngCmmPos: lngCmmPos = getCmmPos(strLine)
    getPrPos = InStr(lngCmmPos, strLine, ")")
End Function

'Grep結果からパス,行,桁情報の終了の位置を取得します。
Function getCrnPos(ByRef strLine)
    getCrnPos = InStr(1, strLine, "]:") + 1
End Function

'改行を含まない1行分の文字列を取得します。
Function getLine(ByRef lngR)
    getLine = getString(Editor.GetLineStr(lngR))
End Function

'これ以降はクラス

'Grep結果1つ分の情報を保持するクラスです。
Class GrepResult
    Public strText
    Public strFilePath
    Public lngRow
    Public lngCol
End Class

VBScript用文字列関連の関数(1)

VBScript用の文字列関連の関数です。

サクラエディタのマクロで使用するために作成しましたが、VBScriptやVBA等で動作します。

'文字列から末尾の改行を除去します。
Function getString(ByRef strLine)
    If endsWith(strLine, vbCrLf) Then
        getString = Left(strLine, Len(strLine) - Len(vbCrLf))
    ElseIf endsWith(strLine, vbCr) Then
        getString = Left(strLine, Len(strLine) - Len(vbCr))
    ElseIf endsWith(strLine, vbLf) Then
        getString = Left(strLine, Len(strLine) - Len(vbLf))
    Else
        getString = strLine
    End If
End Function

'検査対象の文字列が指定の文字列で始まっているか検査します。
Function startsWith(ByRef strStr, ByRef strPrefix)
    startsWith = False
    If Len(strStr) < Len(strPrefix) Then
        Exit Function
    End If
    If InStr(1, strStr, strPrefix) = 1 Then
        startsWith = True
    End If
End Function

'検査対象の文字列が指定の文字列で終わっているか検査します。
Function endsWith(ByRef strStr, ByRef strSuffix)
    endsWith = False
    If Len(strStr) < Len(strSuffix) Then
        Exit Function
    End If
    If Right(strStr, Len(strSuffix)) = strSuffix Then
        endsWith = True
    End If
End Function