Rem 转载请注明老刘编写，谢谢合作。
Option Explicit
Public [发送内容],Console
Const API_Address = "http://www.tuling123.com/openapi/api"
Rem —————————————————设置区———————————————————
Const API_Key = "b9f823b5ae0144abb7b0cba774a0f5f8"
Rem 这是老刘的apikey，每天有5000次的使用次数，一般不用操心。
Rem 如果想要大批量使用，请自行前往tuling123.com注册帐号来更改。
Const [用户ID] = "Unknown" '无需更改，改一下也没关系～支持英文与数字混合组合。
Const [用户昵称] = "你"
Const [机器人昵称] = "图灵AI"
Const [首条自动发送] = True
Const [首条自动发送内容] = "你好"
Const [昵称颜色] = 10
Const [信息交互颜色] = 15
Const [提示颜色] = 12
Const [消息延时] = 100
Rem ————————————————设置区尾部——————————————————

Const [宿主] = "WSCRIPT.EXE" '强制固定宿主
If Not UCase(Right(WScript.FullName,11)) = UCase([宿主]) Then
	Dim Args,Arg
	For Each Arg in Wscript.Arguments
		Args=Args&Chr(&H20)&Chr(&H22)&Arg&Chr(&H22)
	Next
	CreateObject("Wscript.Shell").Run _
		[宿主]&Chr(&H20)&Chr(&H22)&WScript.ScriptFullName&Chr(&H22)&Args
	WScript.Quit
End If

Set Console = CreateObject("VBScript.Console")
With Console
	.ForeColor = [提示颜色]
	.WriteLine "按下Alt+Shift切换输入法～"
	If [首条自动发送] = True Then
		.ForeColor = [昵称颜色] : .WriteText [用户昵称] : .ForeColor = 11 : .WriteLine " 说："
		.ForeColor = [信息交互颜色] : .WriteLine [首条自动发送内容]
		WScript.Sleep [消息延时]
		.ForeColor = [昵称颜色] : .WriteText [机器人昵称] : .ForeColor = 11 : .WriteLine " 说："
		.ForeColor = [信息交互颜色] : [机器人交互] [首条自动发送内容]
	End If
	While Not [发送内容] = "退出"&VbNewLine
		.ForeColor = [昵称颜色] : .WriteText [用户昵称] : .ForeColor = 11 : .WriteLine " 说："
		.ForeColor = [信息交互颜色] : [发送内容] = .ReadLine
		WScript.Sleep [消息延时]
		.ForeColor = [昵称颜色] : .WriteText [机器人昵称] : .ForeColor = 11 : .WriteLine " 说："
		.ForeColor = [信息交互颜色] : [机器人交互] [发送内容]
	Wend
End With

Sub [机器人交互](strText) '发信息与返回信息处理的子程序
	Dim [Arr返回内容（JSON）],Re,[返回内容（文字）],[列指针]
	Set Re = New RegExp
	Re.Pattern = "http://"
	[Arr返回内容（JSON）] = Split(HTTP_POST(API_Address,"key="&API_Key&"&info="&strText&"&userid="&[用户ID]),Chr(&H22))
	With Console
		For [列指针] = 5 To UBound([Arr返回内容（JSON）]) Step 4
			If re.Test([Arr返回内容（JSON）]([列指针])) = True Then
				.WriteText [Arr返回内容（JSON）]([列指针])
				.ForeColor = [提示颜色]
				.WriteText "发现链接，是否打开？【按Y确认】"
				If UCase(Chr(.ReadKey)) = "Y" Then CreateObject("Wscript.Shell").Run [Arr返回内容（JSON）]([列指针])
				.ForeColor = [信息交互颜色]
			Else
				.WriteText [Arr返回内容（JSON）]([列指针])
			End If
		Next
		.WriteLine
	End With
End Sub

Function HTTP_POST(Address,Args) 'HTTP-POST函数块
	With CreateObject("MSXML2.XMLHTTP")
		.Open "POST",Address, False
		.SetRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
		.Send Args
		HTTP_POST = .ResponseText
	End With
End Function
复制代码

Const API_Address = "http://www.tuling123.com/openapi/api"
Const API_Key = "b9f823b5ae0144abb7b0cba774a0f5f8" 
'这是老刘的apikey，每天有5000次的使用次数，一般不用操心。
'如果想要大批量使用，请自行前往tuling123.com注册帐号来更改。

[城市名] = Inputbox("输入城市名：")
Msgbox Split(HTTP_POST(API_Address,"key="&API_Key&"&info="&[城市名]&Chr(&HB5C4)&Chr(&HD3CA)&Chr(&HB1E0)),"""")(5)

Function HTTP_POST(Address,Args)
	With CreateObject("MSXML2.XMLHTTP")
		.Open "POST",Address, False
		.SetRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
		.Send Args
		HTTP_POST = .ResponseText
	End With
End Function
复制代码

Const API_Address = "http://www.tuling123.com/openapi/api"
Const API_Key = "b9f823b5ae0144abb7b0cba774a0f5f8" 
'这是作者的apikey，每天有5000次的使用次数，一般不用操心。
'如果想要大批量使用，请自行前往tuling123.com注册帐号来更改。
Const Userid = "Unknown" '无需更改，改一下也没关系～

[快递号] = Inputbox("输入快递号：")
Msgbox Replace(Split(HTTP_POST(API_Address,"key="&API_Key&"&info="&Chr(&HB2E9)&Chr(&HD1AF)&Chr(&HBFEC)&Chr(&HB5DD)&[快递号]&"&userid="&Userid),"""")(5),"\n",VbNewLine)

Function HTTP_POST(Address,Args)
	With CreateObject("MSXML2.XMLHTTP")
		.Open "POST",Address, False
		.SetRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
		.Send Args
		HTTP_POST = .ResponseText
	End With
End Function
复制代码

Const API_Address = "http://www.tuling123.com/openapi/api"
Const API_Key = "b9f823b5ae0144abb7b0cba774a0f5f8"
'这是作者的apikey，每天有5000次的使用次数，一般不用操心。
'如果想要大批量使用，请自行前往tuling123.com注册帐号来更改。
Const Userid = "Unknown" '无需更改，改一下也没关系～
Const [城市名] = "临河" '如果有同城的，握个手哈～

Msgbox Replace(Split(HTTP_POST(API_Address,"key="&API_Key&"&info="&[城市名]&Chr(&HCCEC)&Chr(&HC6F8)&"&userid="&Userid),"""")(5),";",VbNewLine),,_
[城市名]&"天气"

Function HTTP_POST(Address,Args)
	With CreateObject("MSXML2.XMLHTTP")
		.Open "POST",Address, False
		.SetRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
		.Send Args
		HTTP_POST = .ResponseText
	End With
End Function
复制代码

Const API_Address = "http://www.tuling123.com/openapi/api"
Const API_Key = "b9f823b5ae0144abb7b0cba774a0f5f8" 
'这是老刘的apikey，每天有5000次的使用次数，一般不用操心。
'如果想要大批量使用，请自行前往tuling123.com注册帐号来更改。

Msgbox _
Split(HTTP_POST(API_Address,"key="&API_Key&"&info="&Chr(&HBDB2)&Chr(&HB8F6)&Chr(&HD0A6)&Chr(&HBBB0)),Chr(&H22))(5),, _
"笑话一则"

Function HTTP_POST(Address,Args)
	With CreateObject("MSXML2.XMLHTTP")
		.Open "POST",Address, False
		.SetRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
		.Send Args
		HTTP_POST = .ResponseText
	End With
End Function
复制代码

Const API_Address = "http://www.tuling123.com/openapi/api"
Const API_Key = "b9f823b5ae0144abb7b0cba774a0f5f8" 
'这是老刘的apikey，每天有5000次的使用次数，一般不用操心。
'如果想要大批量使用，请自行前往tuling123.com注册帐号来更改。

Const [宿主] = "WSCRIPT.EXE"
If Not UCase(Right(WScript.FullName,11)) = UCase([宿主]) Then
	Dim Args,Arg
	For Each Arg in Wscript.Arguments
		Args=Args&Chr(&H20)&Chr(&H22)&Arg&Chr(&H22)
	Next
	CreateObject("Wscript.Shell").Run _
		[宿主]&Chr(&H20)&Chr(&H22)&WScript.ScriptFullName&Chr(&H22)&Args
	WScript.Quit
End If

Wscript.Echo _
Replace(Split(HTTP_POST(API_Address,"key="&API_Key&"&info="&Chr(&HBDB2)&Chr(&HB8F6)&Chr(&HB9CA)&Chr(&HCAC2)),"""")(5),"\n",VBNEWLINE)


Function HTTP_POST(Address,Args)
	With CreateObject("MSXML2.XMLHTTP")
		.Open "POST",Address, False
		.SetRequestHeader "CONTENT-TYPE","application/x-www-form-urlencoded"
		.Send Args
		HTTP_POST = .ResponseText
	End With
End Function
复制代码