高速クリップ追加

Option Explicit

Const CON_SCRIPTHOST = "cscript.exe"
Const WIN_SCRIPTHOST = "wscript.exe"
Const CMD_SET_CLIPBOARD = "clip.exe"

Const CLASSNAME_FSO = "Scripting.FileSystemObject"
Const CLASSNAME_HTML = "HTMLFile"
Const CLASSNAME_SHELL = "WScript.Shell"
Const ForReading = 1, ForWriting = 2, ForAppending = 8

Dim fso
Dim html
Dim shell
Set fso = CreateObject(CLASSNAME_FSO)
Set html = CreateObject(CLASSNAME_HTML)
Set shell = CreateObject(CLASSNAME_SHELL)

Dim scriptBaseName
Dim scriptFolder
scriptBaseName = fso.GetBaseName(WScript.ScriptFullName)
scriptFolder = Left( _
    WScript.ScriptFullName, _
    Len(WScript.ScriptFullName) - Len(WScript.ScriptName))

Call HideExec()

Sub HideExec()
    Dim arg
    Dim args

    '// エクスプローラからの起動を確認
    If (LCase(Right(WScript.FullName, 11)) = WIN_SCRIPTHOST) Then
        args = Array(CON_SCRIPTHOST, """" & WScript.ScriptFullName & """")

        For Each arg In WScript.Arguments
            ReDim Preserve args(UBound(args) + 1)
            args(UBound(args)) = """" & arg & """"
        Next

        '// 最小化ウィンドウで自身を呼び出し
        Call WScript.Quit(shell.Run(Join(args, " "), 7, True))
    Else
        '// 最小化ウィンドウでメインの処理を実行
        Call Main()
    End If
End Sub

Sub Main()
    On Error Resume Next

    Dim contents
    contents = DecodeClipBoardText()

    If (contents <> "") Then
        contents = vbNewLine + vbNewLine + "処理結果:" + vbNewLine + contents
    End If
End Sub

Function DecodeClipBoardText()
    DecodeClipBoardText = ""

    Dim contents
    Dim dummyElement
    Dim exec

    '// クリップボード文字列取得
    contents = html.ParentWindow.ClipboardData.GetData("text")

    '// 文字列置換
    Set dummyElement = html.CreateElement("span")
    Call dummyElement.SetAttribute("id", "result")
    Call html.AppendChild(dummyElement)
    Call html.ParentWindow.ExecScript("document.getElementById('result').innerText = decodeURIComponent('" & contents & "');", "JScript")
    
    '// 先頭と末尾の " を削除
    contents = dummyElement.InnerText
    If Left(contents, 1) = """" And Right(contents, 1) = """" Then
        contents = Mid(contents, 2, Len(contents) - 2)
    End If

    ' 文字列の先頭と末尾に < と > を追加
    contents = "<" & contents & ">" & vbNewLine

    '// クリップボード文字列設定
    Set exec = shell.Exec(CMD_SET_CLIPBOARD)
    Call exec.StdIn.Write(contents)
    Call exec.StdIn.Close()
    Call exec.StdOut.ReadAll()

    DecodeClipBoardText = contents
End Function

コメント

コメントを残す

メールアドレスが公開されることはありません。 が付いている欄は必須項目です