snippet: HTA #snippets

php.vbs
HTA+WSH用

コマンド実行時のリダイレクト

' リダイレクト > を使うには cmd /c が必要。実行内容を非表示にするため引数0がある。
cmd = "cmd /c dir > a.txt"
wsh.Run(cmd, 0, True)

onClick

input

<input type="button" value="hello1" onClick="hello()">

<script language="VBScript">
Sub hello()
    msgbox "hello"
End Sub
</script>

sleep

Sub Sleep(Sec)
    CreateObject("WScript.Shell").Run "ping.exe localhost -n "&(Sec+1),0,True
End Sub

フォルダを開く

Dim WshShell, oExec
Set WshShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")

Sub openFolder(strPath)
    If fso.FolderExists(strPath) Then
        WshShell.Exec("explorer.exe " & strPath)
    Else
        msgbox strPath & "が存在しません"
    End If
End Sub

ファイル読み込み

Function readFile(fileName)
        Dim strLine
        Set objFile = fso.OpenTextFile(fileName, 1)
        Do Until objFile.AtEndOfStream
            strLine = strLine & objFile.ReadLine() & vbCrLf
        Loop
        readFile = strLine
        '
        objFile.Close
        Set objFile = Nothing
        Set objFso = Nothing
End Function

ファイル書き込み

Sub writeText(fileName, strLine)
        Set objFile = fso.OpenTextFile(fileName, 2, True)
        If Err.Number > 0 Then
            msgbox fileName & "を開くのを失敗しました。"
            Exit Sub
        Else
            objFile.WriteLine strLine
        End If
        '
        objFile.Close
        Set objFile = Nothing
        Set objFso = Nothing
End Sub

文字列置換

置換

Set objRegExp = New RegExp
objRegExp.Pattern = "'"
strLine = objRegExp.Replace(strLine, "　")

onLoad

起動時に実行

Sub Window_OnLoad
    ' 画面リサイズ(横800px, 縦500px)
    Window.ResizeTo 800,500
End Sub

正規表現

match

Function match(strPattern, strLine)
        Dim regex, result, result2
        Set regex = New RegExp
        regex.Pattern = strPattern
        Set result = regex.Execute(strLine)
        If result.Count > 0 Then
            Set result2 = result(0).SubMatches
            For i = 0 To result2.Count - 1
                match = result2(i)
            Next
        End If
        '
        Set regex = Nothing
End Function

Dim strLine
strLine = ""
strLine = strLine & "hoge1=fuga12" & vbCrLf
strLine = strLine & "hoge2=fuga34" & vbCrLf
strLine = strLine & "hoge3=fuga56" & vbCrLf
msgbox match("hoge1=(.*)", strLine) 'fuga12
msgbox match("hoge2=(.*)", strLine) 'fuga34
msgbox match("hoge3=(.*)", strLine) 'fuga56

ウィンドウの移動

<title>Centered HTA</title>

<script language="VBScript">

Sub Window_Onload
    window.moveTo 100, 0
End Sub

</script>

Edgeの起動

<SCRIPT Language=”VBScript”>
    Sub Window_Onload

        CreateObject("Shell.Application").ShellExecute "microsoft-edge:about:start"

    End Sub
</SCRIPT>