VBScriptで多段認証の手間をツールで削減

2025.12.11

急遽、SSHポートフォワーディングができるものを作らないといけなかったので作成しました。

<!doctype html>
<html>
<head>
<meta charset="utf-8">
<HTA:APPLICATION
  ID="HTAApp"
  BORDER="dialog"
  CAPTION="yes"
  SCROLL="no"
/>
<title>TeraTerm マクロ作成ツール</title>

<script language="VBScript">

Dim bindDone
bindDone = False

' -----------------------
' 初期処理
' -----------------------
Sub Window_OnLoad()
    ResetForm
    ToggleInput
End Sub

' -----------------------
' フォームをリセット
' -----------------------
Sub ResetForm()
    On Error Resume Next
    document.getElementById("txtFolder").value = ""
    document.getElementById("txtFile").value   = ""
    document.getElementById("txtSrcIP").value   = ""
    document.getElementById("txtSrcPort").value = ""
    document.getElementById("txtDstIP").value   = ""
    document.getElementById("txtDstPort").value = ""
    document.getElementById("txtUser").value    = ""
    document.getElementById("txtPass").value    = ""
    document.getElementById("chkFile").checked = False
    On Error Goto 0
End Sub

' -----------------------
' 入力切替
' -----------------------
Sub ToggleInput()
    Dim chk
    chk = document.getElementById("chkFile").checked

    document.getElementById("txtFolder").disabled = Not chk
    document.getElementById("txtFile").disabled   = Not chk
    document.getElementById("txtSrcIP").disabled   = chk
    document.getElementById("txtSrcPort").disabled = chk
    document.getElementById("txtDstIP").disabled   = chk
    document.getElementById("txtDstPort").disabled = chk
    document.getElementById("txtUser").disabled    = chk
    document.getElementById("txtPass").disabled    = chk

    If chk Then AutoLoadFile
End Sub

' -----------------------
' ファイル自動読込
' -----------------------
Sub AutoLoadFile()
    If document.getElementById("chkFile").checked = False Then Exit Sub

    Dim filePath
    filePath = Trim(document.getElementById("txtFolder").value)
    If Right(filePath,1) <> "\" And filePath <> "" Then filePath = filePath & "\"
    filePath = filePath & Trim(document.getElementById("txtFile").value)
    If filePath = "\" Or filePath = "" Then Exit Sub
    If Not FileExists(filePath) Then
        document.getElementById("txtSrcIP").value = ""
        document.getElementById("txtSrcPort").value = ""
        document.getElementById("txtDstIP").value = ""
        document.getElementById("txtDstPort").value = ""
        document.getElementById("txtUser").value  = ""
        document.getElementById("txtPass").value  = ""
        Exit Sub
    End If

    Dim srcIP, srcPort, dstIP, dstPort, user, passwd
    Call LoadFromFile(filePath, srcIP, srcPort, dstIP, dstPort, user, passwd)

    document.getElementById("txtSrcIP").value   = srcIP
    document.getElementById("txtSrcPort").value = srcPort
    document.getElementById("txtDstIP").value   = dstIP
    document.getElementById("txtDstPort").value = dstPort
    document.getElementById("txtUser").value    = user
    document.getElementById("txtPass").value    = passwd
End Sub

' -----------------------
' ファイル存在チェック
' -----------------------
Function FileExists(path)
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    FileExists = fso.FileExists(path)
End Function

' -----------------------
' ファイル読み込み（IP/Port/User/Pass）
' -----------------------
Sub LoadFromFile(filePath, ByRef srcIP, ByRef srcPort, ByRef dstIP, ByRef dstPort, ByRef user, ByRef passwd)
    Dim fso, f, i, line
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.OpenTextFile(filePath, 1, False)
    i = 0
    srcIP = "": srcPort = "": dstIP = "": dstPort = ""
    user = "": passwd = ""
    Do Until f.AtEndOfStream
        line = Trim(f.ReadLine)
        i = i + 1
        Select Case i
            Case 1: srcIP = line
            Case 2: srcPort = line
            Case 3: user  = line
            Case 4: passwd= line
            Case 5: dstIP = line
            Case 6: dstPort = line
        End Select
    Loop
    f.Close
End Sub

' -----------------------
' TTL生成（正規版）
' -----------------------
Function BuildTTL(srcIP, srcPort, dstIP, dstPort, user, passwd)
    Dim s
    s = ""

    ' コメント
    s = s & "; Auto Generated TTL" & vbCrLf
    s = s & "; SRC " & srcIP & ":" & srcPort & vbCrLf
    s = s & "; DST " & dstIP & ":" & dstPort & vbCrLf
    s = s & "; User " & user & vbCrLf & vbCrLf

    ' 接続情報（踏み台用）
    s = s & "HOSTADDR = '" & srcIP & "'" & vbCrLf
    s = s & "USERNAME = '" & user & "'" & vbCrLf
    s = s & "PASSWORD = '" & passwd & "'" & vbCrLf & vbCrLf

    ' コマンド組立て（踏み台経由）
    s = s & "COMMAND = HOSTADDR" & vbCrLf
    s = s & "strconcat COMMAND ':" & srcPort & " /ssh /2 /auth=password /user='" & vbCrLf
    s = s & "strconcat COMMAND USERNAME" & vbCrLf
    s = s & "strconcat COMMAND ' /passwd='" & vbCrLf
    s = s & "strconcat COMMAND PASSWORD" & vbCrLf
    s = s & "strconcat COMMAND ' /PF=" & dstPort & ":" & dstIP & ":" & dstPort & "'" & vbCrLf & vbCrLf

    ' 接続
    s = s & "connect COMMAND" & vbCrLf
    s = s & "end" & vbCrLf

    BuildTTL = s
End Function

' -----------------------
' 保存（UTF-8）
' -----------------------
Function SaveTextFile(path, content)
    On Error Resume Next
    Dim stm
    Set stm = CreateObject("ADODB.Stream")
    stm.Type = 2
    stm.Charset = "utf-8"
    stm.Open
    stm.WriteText content
    stm.SaveToFile path, 2
    stm.Close
    Set stm = Nothing
    SaveTextFile = (Err.Number = 0)
    Err.Clear
    On Error Goto 0
End Function

' -----------------------
' 実行：TTL作成
' -----------------------
Sub RunMacro()
    Dim srcIP, srcPort, dstIP, dstPort, user, passwd, outPath, srcFolder

    srcFolder = Trim(document.getElementById("txtFolder").value)
    Dim filePath
    filePath = srcFolder
    If Right(filePath,1) <> "\" And filePath <> "" Then filePath = filePath & "\"
    filePath = filePath & Trim(document.getElementById("txtFile").value)

    If FileExists(filePath) Then
        Call LoadFromFile(filePath, srcIP, srcPort, dstIP, dstPort, user, passwd)
    Else
        srcIP   = Trim(document.getElementById("txtSrcIP").value)
        srcPort = Trim(document.getElementById("txtSrcPort").value)
        dstIP   = Trim(document.getElementById("txtDstIP").value)
        dstPort = Trim(document.getElementById("txtDstPort").value)
        user    = Trim(document.getElementById("txtUser").value)
        passwd  = Trim(document.getElementById("txtPass").value)
    End If

    ' 入力チェック
    If srcIP = "" Or srcPort = "" Or dstIP = "" Or dstPort = "" Or user = "" Or passwd = "" Then
        MsgBox "すべての項目を入力してください。", vbExclamation
        Exit Sub
    End If

    ' 出力先
    Set sh = CreateObject("WScript.Shell")
    If srcFolder = "" Then
        outPath = sh.SpecialFolders("Desktop") & "\TeraTermMacro.ttl"
    Else
        If Right(srcFolder, 1) <> "\" Then srcFolder = srcFolder & "\"
        outPath = srcFolder & "TeraTermMacro.ttl"
    End If

    ' TTL作成
    Dim ttl
    ttl = BuildTTL(srcIP, srcPort, dstIP, dstPort, user, passwd)

    ' 既存TTLがあれば削除
    ' ================================
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")

    If fso.FileExists(outPath) Then
        fso.DeleteFile outPath, True   ' True = 読み取り専用でも削除
    End If
    
    Set fso = Nothing

    ' 保存
    If SaveTextFile(outPath, ttl) Then
        MsgBox "Tera Term マクロを作成しました：" & vbCrLf & outPath, vbInformation

        ' TTL関連付け（初回のみ）
        If Not bindDone Then
            sh.Run "cmd /c assoc .ttl=TeraTermTTL", 0, True
            sh.Run "cmd /c ftype TeraTermTTL=" & Chr(34) & "C:\Program Files\teraterm5\ttermpro.exe" & Chr(34) & " " & Chr(34) & "%1" & Chr(34), 0, True
            bindDone = True
        End If

        ' TTL 実行
        sh.Run Chr(34) & "C:\Program Files\teraterm5\ttermpro.exe" & Chr(34) & " /M=" & Chr(34) & outPath & Chr(34), 1, False
    End If
End Sub

</script>
</head>

<body>

<h3>
  フォルダパスとファイル名を入力してください
  <input type="checkbox" id="chkFile" onclick="ToggleInput">
</h3>

<table border="1" cellpadding="4">
<tr>
  <th>フォルダパス</th>
  <th>ファイル名</th>
</tr>
<tr>
  <td><input id="txtFolder" size="50" onchange="AutoLoadFile"></td>
  <td><input id="txtFile"   size="30" onchange="AutoLoadFile"></td>
</tr>
</table>

<br>

<p>
接続情報を入力してください（IP / Port / ユーザー名 / パスワード）
</p>

<table border="1" cellpadding="4">
<tr>
  <th>接続元(IP)</th>
  <th>接続元(Port)</th>
  <th>ユーザー名</th>
  <th>パスワード</th>
  <th>接続先(IP)</th>
  <th>接続先(Port)</th>

</tr>
<tr>
  <td><input id="txtSrcIP" size="15"></td>
  <td><input id="txtSrcPort" size="6"></td>
  <td><input id="txtUser" size="12"></td>
  <td><input type="password" id="txtPass" placeholder="Password"></td>
  <td><input id="txtDstIP" size="15"></td>
  <td><input id="txtDstPort" size="6"></td>
</tr>
</table>

<br>

<button onclick="RunMacro">Tera Term マクロ作成</button>

</body>
</html>

タイトルとURLをコピーしました