putty.vbs with 1Password support

putty.vbs

' The aim of this script is to execute putty with parameters like ssh://login@host directly using an URL in a browser
'
' Update 2019-02-02, Kai Michael Poppe (twitter @kmpoppe):
' This script now also accepts item and vault data from 1password so that you can log in to putty without having
' username and password in the URL but getting it from your 1password vault. The script now makes use of a Json lib
' by "demon" (http://demon.tw/my-work/vbs-json.html)
'
' Installation:
'   - Launch putty.reg to associate ssh:// and telnet:// to this script
'   - Edit the putty path in parameter below like puttyPath = "C:\Program Files (x86)\putty.exe"
'   - Save this .vbs on your PC like c:\putty.vbs (or change the path in putty.reg)
' If you want to use the script with 1password:
'	- Get 1password CLI-tool from https://app-updates.agilebits.com/product_history/CLI
'	- Read how to get a signin session (variable opSession below): https://support.1password.com/command-line/
' Uninstallation:
'   - Run unputty.reg
' Version 2014-04-23'
' Script Created by Sebastien Biffi
'
' Source Original: https://gist.github.com/sbiffi

puttyPath = "C:\Program Files\putty\putty.exe"
opPath = "<PATH TO OP-CLI>\op.exe"
opSession = "<SESSION FROM OP SIGNIN>"

On Error Resume Next
' initialisation of variables
logResult = "" ' Used for logging purpose during debug or in case of error. Log is a msgBox
logIcon = 0 ' Icon of the MsgBox. By default: none
logTitle = "" ' Title of the MsgBox. By default: none
Set objShell = CreateObject("WScript.Shell")

Set re = New RegExp
' The pattern that matches the URL. Used to check the URL format provided and find fields in it.
re.Pattern = "^([^:]+)://(([^:]+)(:(.*))?@)?(([^/@:]+)(:([0-9]+))?)/?(\?onepasswdfill=(.*)\&onepasswdvault=(.*))?$"

' Check if only 1 parameter is passed to the script, else throw an error
if Wscript.Arguments.Count = 1 then
	url = Wscript.Arguments(0)	
else
	exitWithError("Please pass only 1 parameter to this script like:" & vbCrLf & "   - ssh://login:password@host:port " & vbCrLf & "   - telnet://login@host:port" & vbCrLf & "login, password & port are optional")
end if

' Check if the URL is valid, else throw an error
If re.Test(url) Then
	log("URL is valid: " & url)
Else
	exitWithError(url & " is NOT a valid URL" & vbCrLf & "Please pass only 1 parameter to this script like:" & vbCrLf & "   - ssh://login:password@host:port " & vbCrLf & "   - telnet://login@host:port" & vbCrLf & "login, password & port are optional")
End If

' Find the putty parameters in the URL
Set Matches = re.Execute(url)
protocol = Matches.Item(0).Submatches(0)
login = Matches.Item(0).Submatches(2)
pwd = Matches.Item(0).Submatches(4)
host = Matches.Item(0).Submatches(6)
port = Matches.Item(0).Submatches(8)

' See if 1Password url parts are provided and replace user/password from the item
opwditem = Matches.Item(0).Submatches(10)
opwdvault = Matches.Item(0).Submatches(11)

If opwditem <> "" And opwdvault <> "" Then
	Dim opExecStatement, strTempFileName, opJson
	Set fso = CreateObject("Scripting.FileSystemObject")

	strTempFileName = fso.GetSpecialFolder(2) & "\" & fso.GetTempName
	opExecStatement = opPath & " get item " & opwditem & " --vault=" & opwdvault & " --session=" & opSession & " > " & strTempFileName
	Set returnValue = objShell.Run("cmd /c " & opExecStatement, 0, true)
	
	Set jsonFile = fso.OpenTextFile(strTempFileName, 1)
	opJson = jsonFile.ReadAll
	jsonFile.Close
	fso.DeleteFile strTempFileName
	
	Dim json, o, i
	Set json = New VbsJson
	Set o = json.Decode(opJson)
	For Each i In o("details")("fields")
		If i("designation") = "username" Then login = i("value")
		If i("designation") = "password" Then pwd = i("value")
	Next
End If

log("  host: " & host)
log("  protocol: " & protocol)
log("  port: " & port)
log("  login: " & login)
log("  pwd: " & pwd)

if protocol = "ssh" then 
	paramProtocol = " -ssh"
elseif protocol = "telnet" then
	paramProtocol = " -telnet"
else
	exitWithError("Protocol: " & protocol & " is not a valid protocol (ssh or telnet).")
end if 
if host <> "" then 
	paramHost = " " & host
else
	exitWithError("Host cannot bu null.")
end if 
if login <> "" then 
	paramLogin = " -l " & login
end if
if (pwd <> "") and (protocol <> "telnet") then 
	paramPwd = " -pw " & pwd
end if
if port <> "" then 
	paramPort = " -P " & port
end if

' build the putty command like:
' putty.exe -ssh host -l login -pw password -P port
' putty.exe -telnet host -l login -P port
puttyCommand = chr(34) & puttyPath & chr(34) & paramProtocol & paramHost & paramLogin & paramPwd & paramPort
log (puttyCommand)

' For debugging purpose, uncomment following line:
'outputLog()

' Execute putty
objShell.Run puttyCommand,1,False

' ****************
'   Error Output
' ****************
' Outputs a msgBox including the log and the error message
function exitWithError(str)	
	log(str)
  logIcon = vbCritical
	logTitle = "Error"
	outputLog()	
	wscript.Quit
end function

' ***********
'   Logging 
' ***********
' Adds a message to the log String
function log(str)
	if logResult = "" then 
		logResult = str
	else
		logResult = logResult & vbCrLf & str
	end if
end function
' Outputs a msgBox including the log String
function outputLog()
	if logResult <> "" then
		MsgBox logResult, logIcon, logTitle
	end if
end function

''' This class is imported here unchanged from the website mentioned below

Class VbsJson
	'Author: Demon
	'Date: 2012/5/3
	'Website: http://demon.tw
	Private Whitespace, NumberRegex, StringChunk
	Private b, f, r, n, t

	Private Sub Class_Initialize
		Whitespace = " " & vbTab & vbCr & vbLf
		b = ChrW(8)
		f = vbFormFeed
		r = vbCr
		n = vbLf
		t = vbTab

		Set NumberRegex = New RegExp
		NumberRegex.Pattern = "(-?(?:0|[1-9]\d*))(\.\d+)?([eE][-+]?\d+)?"
		NumberRegex.Global = False
		NumberRegex.MultiLine = True
		NumberRegex.IgnoreCase = True

		Set StringChunk = New RegExp
		StringChunk.Pattern = "([\s\S]*?)([""\\\x00-\x1f])"
		StringChunk.Global = False
		StringChunk.MultiLine = True
		StringChunk.IgnoreCase = True
	End Sub
	
	'Return a JSON string representation of a VBScript data structure
	'Supports the following objects and types
	'+-------------------+---------------+
	'| VBScript          | JSON          |
	'+===================+===============+
	'| Dictionary        | object        |
	'+-------------------+---------------+
	'| Array             | array         |
	'+-------------------+---------------+
	'| String            | string        |
	'+-------------------+---------------+
	'| Number            | number        |
	'+-------------------+---------------+
	'| True              | true          |
	'+-------------------+---------------+
	'| False             | false         |
	'+-------------------+---------------+
	'| Null              | null          |
	'+-------------------+---------------+
	Public Function Encode(ByRef obj)
		Dim buf, i, c, g
		Set buf = CreateObject("Scripting.Dictionary")
		Select Case VarType(obj)
			Case vbNull
				buf.Add buf.Count, "null"
			Case vbBoolean
				If obj Then
					buf.Add buf.Count, "true"
				Else
					buf.Add buf.Count, "false"
				End If
			Case vbInteger, vbLong, vbSingle, vbDouble
				buf.Add buf.Count, obj
			Case vbString
				buf.Add buf.Count, """"
				For i = 1 To Len(obj)
					c = Mid(obj, i, 1)
					Select Case c
						Case """" buf.Add buf.Count, "\"""
						Case "\"  buf.Add buf.Count, "\\"
						Case "/"  buf.Add buf.Count, "/"
						Case b    buf.Add buf.Count, "\b"
						Case f    buf.Add buf.Count, "\f"
						Case r    buf.Add buf.Count, "\r"
						Case n    buf.Add buf.Count, "\n"
						Case t    buf.Add buf.Count, "\t"
						Case Else
							If AscW(c) >= 0 And AscW(c) <= 31 Then
								c = Right("0" & Hex(AscW(c)), 2)
								buf.Add buf.Count, "\u00" & c
							Else
								buf.Add buf.Count, c
							End If
					End Select
				Next
				buf.Add buf.Count, """"
			Case vbArray + vbVariant
				g = True
				buf.Add buf.Count, "["
				For Each i In obj
					If g Then g = False Else buf.Add buf.Count, ","
					buf.Add buf.Count, Encode(i)
				Next
				buf.Add buf.Count, "]"
			Case vbObject
				If TypeName(obj) = "Dictionary" Then
					g = True
					buf.Add buf.Count, "{"
					For Each i In obj
						If g Then g = False Else buf.Add buf.Count, ","
						buf.Add buf.Count, """" & i & """" & ":" & Encode(obj(i))
					Next
					buf.Add buf.Count, "}"
				Else
					Err.Raise 8732,,"None dictionary object"
				End If
			Case Else
				buf.Add buf.Count, """" & CStr(obj) & """"
		End Select
		Encode = Join(buf.Items, "")
	End Function

	'Return the VBScript representation of ``str(``
	'Performs the following translations in decoding
	'+---------------+-------------------+
	'| JSON          | VBScript          |
	'+===============+===================+
	'| object        | Dictionary        |
	'+---------------+-------------------+
	'| array         | Array             |
	'+---------------+-------------------+
	'| string        | String            |
	'+---------------+-------------------+
	'| number        | Double            |
	'+---------------+-------------------+
	'| true          | True              |
	'+---------------+-------------------+
	'| false         | False             |
	'+---------------+-------------------+
	'| null          | Null              |
	'+---------------+-------------------+
	Public Function Decode(ByRef str)
		Dim idx
		idx = SkipWhitespace(str, 1)

		If Mid(str, idx, 1) = "{" Then
			Set Decode = ScanOnce(str, 1)
		Else
			Decode = ScanOnce(str, 1)
		End If
	End Function
	
	Private Function ScanOnce(ByRef str, ByRef idx)
		Dim c, ms

		idx = SkipWhitespace(str, idx)
		c = Mid(str, idx, 1)

		If c = "{" Then
			idx = idx + 1
			Set ScanOnce = ParseObject(str, idx)
			Exit Function
		ElseIf c = "[" Then
			idx = idx + 1
			ScanOnce = ParseArray(str, idx)
			Exit Function
		ElseIf c = """" Then
			idx = idx + 1
			ScanOnce = ParseString(str, idx)
			Exit Function
		ElseIf c = "n" And StrComp("null", Mid(str, idx, 4)) = 0 Then
			idx = idx + 4
			ScanOnce = Null
			Exit Function
		ElseIf c = "t" And StrComp("true", Mid(str, idx, 4)) = 0 Then
			idx = idx + 4
			ScanOnce = True
			Exit Function
		ElseIf c = "f" And StrComp("false", Mid(str, idx, 5)) = 0 Then
			idx = idx + 5
			ScanOnce = False
			Exit Function
		End If
		
		Set ms = NumberRegex.Execute(Mid(str, idx))
		If ms.Count = 1 Then
			idx = idx + ms(0).Length
			ScanOnce = CDbl(ms(0))
			Exit Function
		End If
		
		Err.Raise 8732,,"No JSON object could be ScanOnced"
	End Function

	Private Function ParseObject(ByRef str, ByRef idx)
		Dim c, key, value
		Set ParseObject = CreateObject("Scripting.Dictionary")
		idx = SkipWhitespace(str, idx)
		c = Mid(str, idx, 1)
		
		If c = "}" Then
			Exit Function
		ElseIf c <> """" Then
			Err.Raise 8732,,"Expecting property name"
		End If

		idx = idx + 1
		
		Do
			key = ParseString(str, idx)

			idx = SkipWhitespace(str, idx)
			If Mid(str, idx, 1) <> ":" Then
				Err.Raise 8732,,"Expecting : delimiter"
			End If

			idx = SkipWhitespace(str, idx + 1)
			If Mid(str, idx, 1) = "{" Then
				Set value = ScanOnce(str, idx)
			Else
				value = ScanOnce(str, idx)
			End If
			ParseObject.Add key, value

			idx = SkipWhitespace(str, idx)
			c = Mid(str, idx, 1)
			If c = "}" Then
				Exit Do
			ElseIf c <> "," Then
				Err.Raise 8732,,"Expecting , delimiter"
			End If

			idx = SkipWhitespace(str, idx + 1)
			c = Mid(str, idx, 1)
			If c <> """" Then
				Err.Raise 8732,,"Expecting property name"
			End If

			idx = idx + 1
		Loop

		idx = idx + 1
	End Function
	
	Private Function ParseArray(ByRef str, ByRef idx)
		Dim c, values, value
		Set values = CreateObject("Scripting.Dictionary")
		idx = SkipWhitespace(str, idx)
		c = Mid(str, idx, 1)

		If c = "]" Then
			ParseArray = values.Items
			Exit Function
		End If

		Do
			idx = SkipWhitespace(str, idx)
			If Mid(str, idx, 1) = "{" Then
				Set value = ScanOnce(str, idx)
			Else
				value = ScanOnce(str, idx)
			End If
			values.Add values.Count, value

			idx = SkipWhitespace(str, idx)
			c = Mid(str, idx, 1)
			If c = "]" Then
				Exit Do
			ElseIf c <> "," Then
				Err.Raise 8732,,"Expecting , delimiter"
			End If

			idx = idx + 1
		Loop

		idx = idx + 1
		ParseArray = values.Items
	End Function
	
	Private Function ParseString(ByRef str, ByRef idx)
		Dim chunks, content, terminator, ms, esc, char
		Set chunks = CreateObject("Scripting.Dictionary")

		Do
			Set ms = StringChunk.Execute(Mid(str, idx))
			If ms.Count = 0 Then
				Err.Raise 8732,,"Unterminated string starting"
			End If
			
			content = ms(0).Submatches(0)
			terminator = ms(0).Submatches(1)
			If Len(content) > 0 Then
				chunks.Add chunks.Count, content
			End If
			
			idx = idx + ms(0).Length
			
			If terminator = """" Then
				Exit Do
			ElseIf terminator <> "\" Then
				Err.Raise 8732,,"Invalid control character"
			End If
			
			esc = Mid(str, idx, 1)

			If esc <> "u" Then
				Select Case esc
					Case """" char = """"
					Case "\"  char = "\"
					Case "/"  char = "/"
					Case "b"  char = b
					Case "f"  char = f
					Case "n"  char = n
					Case "r"  char = r
					Case "t"  char = t
					Case Else Err.Raise 8732,,"Invalid escape"
				End Select
				idx = idx + 1
			Else
				char = ChrW("&H" & Mid(str, idx + 1, 4))
				idx = idx + 5
			End If

			chunks.Add chunks.Count, char
		Loop

		ParseString = Join(chunks.Items, "")
	End Function

	Private Function SkipWhitespace(ByRef str, ByVal idx)
		Do While idx <= Len(str) And _
			InStr(Whitespace, Mid(str, idx, 1)) > 0
			idx = idx + 1
		Loop
		SkipWhitespace = idx
	End Function

End Class

Might want to apply existing fixes to VbsJson from here.

Hi experts nice to see , I am beginner , I want to use SSH protocol by application SecureCRT (which has more option compare to putty) , I badly needed this , Using windows 10 ... Many thanks in advanced