CORESERVER or XREAアクセスIP許可

coreserver.vbs

Option Explicit

'doc
'CORESERVER https://apidoc.coreserver.jp/#/tool/2017/07/19/tool-ssh-add.html
'XREA https://apidoc.xrea.com/#/tool/2017/07/19/tool-ssh-add.html

'接続先情報
Const CstStrTarget = "username:[email protected]"
'Const CstStrTarget = "username:[email protected]"

'API情報
Const CstStrDomain = "https://api.coreserver.jp"
'Const CstStrDomain = "https://api.xrea.com"
Const CstStrIPAllow = "/v1/tool/ssh_ip_allow"
Const CstStrIPGet = "http://taruo.net/ip/?raw"

'接続先情報を読み込む
Dim StrUserName, StrApiKey, StrServer
Dim ObjReg, ObjMatches, ObjMatch
Set ObjReg = New RegExp
ObjReg.Pattern = "^([^:]+):([^@]+)@(.+)$"
Set ObjMatches = ObjReg.Execute(CstStrTarget)
If ObjMatches.Count <> 1 Then
	Call MsgBox("認証情報読み込み失敗",, "エラー")
	Call WScript.Quit(ObjMatches.Count)
End If
Set ObjMatch = ObjMatches(0)
With ObjMatch
	StrUserName = .Submatches(0)
	StrApiKey   = .Submatches(1)
	StrServer   = .Submatches(2)
End With
Set ObjMatch = Nothing
Set ObjMatches = Nothing
Set ObjReg = Nothing
Call Debug.WriteLine("UserName:", StrUserName)
Call Debug.WriteLine("ApiKey:",   StrApiKey)
Call Debug.WriteLine("Server:",   StrServer)

Dim ObjHttp, StrBody
Set ObjHttp = WScript.CreateObject("Msxml2.XMLHTTP.6.0")

On Error Resume Next

'自身のIPアドレスを取得
Dim StrMyIP
Call ObjHttp.open("GET", CstStrIPGet, False)
Call ObjHttp.send()
While ObjHttp.readyState <> 4
Wend
StrMyIP = Replace(Replace(ObjHttp.responseText, vbCr, ""), vbLf, "")
Call Debug.WriteLine("IP:", StrMyIP)

'権限取得
Dim AryParam, StrParam
AryParam = Array(_
"account=" & StrUserName,_
"server_name=" & StrServer,_
"api_secret_key=" & StrApiKey,_
"param[addr]=" & StrMyIP)
StrParam = Join(AryParam, "&")
Call Debug.WriteLine("Param:", StrParam)

Call ObjHttp.open("POST", CstStrDomain & CstStrIPAllow, False)
Call ObjHttp.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
Call ObjHttp.send(StrParam)
If Err.Number <> 0 Then
	Call MsgBox(Err.Description,, "エラー")
	Call WScript.Quit(Err.Number)
End If
While ObjHttp.readyState <> 4
Wend
StrBody = ObjHttp.responseText
Call Debug.WriteLine(StrBody)

If InStr(StrBody, """status_code"":200") < 1 Then
	Call MsgBox(StrBody,, "エラー")
	Call WScript.Quit(1)
End If

Set ObjHttp = Nothing