窄口牛

需要第三方启用ssl和tsl了，把这个改成发送QQ消息吧
WshShell.run"mshta vbscript:clipboardData.SetData("+""""+"text"+""""+","+""""&str&""""+")(close)",0,true
WshShell.run "tencent://message/?uin=QQ号"

窄口牛

自己拼凑了一个，增加进程守护，修改密码，ip一变就改一次随机密码。

'On Error Resume Next
Main        
Sub Main()
  Dim CurIP, LastIP, strSubject, strMessage, Wshshell
  Do
    CurIP = GetWWWIP()
    If CurIP <> LastIP Then
      LastIP = CurIP
      password = nss(8)
      Set Wshshell=WScript.CreateObject("WScript.Shell")
      Wshshell.run "net user 远程系统用户名 " & password
      Wshshell.run "mshta vbscript:clipboardData.SetData("+""""+"text"+""""+","+"""IP为"&CurIP&"密码为"&password&""""+")(close)",0,true
      WshShell.run "tencent://message/?uin=QQ号"
      WScript.Sleep 1000
      WshShell.SendKeys"^v"
      WScript.Sleep 100
      WshShell.SendKeys "%s"
      WScript.Sleep 500
      WshShell.SendKeys"%{F4}"
    End If
    WScript.Sleep 5 * 1000
  Loop
End Sub
Function nss(n)
	For i = 1 To n
		Randomize 
		nss = nss & chr(Int((93 * Rnd) + 33))
	next
End Function
Function GetWWWIP()
  Dim Check, objHttp, strHtml, re
  Check = False
  On Error Resume Next
  Do Until Check = True
    Set objHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    objHttp.SetTimeouts 5000,5000,5000,5000  'ResolveTimeout,ConnectTimeout,SendTimeout,ReceiveTimeout
    objHttp.Open "GET", "http://www.bathome.net/s/ip.php", False
    objHttp.Send
    If objHttp.Status = 200 Then
      strHtml = objHttp.ResponseText()
      Set re = CreateObject("vbScript.regExp")
      re.Pattern = "(\d+\.\d+\.\d+\.\d+)"
      If re.Test(strHtml) Then
        GetWWWIP = re.Execute(strHtml)(0).SubMatches(0)
        Check = True
      End If
    End If
    Set re = Nothing
    Set objHttp = Nothing
    WScript.Sleep 200
    Set objWMIProcess = GetObject("winmgmts:\\.\root\cimv2").ExecQuery("Select * From Win32_Process")
    For Each objProcess In objWMIProcess
      If objProcess.Name = "QQ.exe" Then
          ProcExist = "1"
      End If
   Next
   If ProcExist = "0" Then
      Set objShell = WScript.CreateObject ("WSCript.Shell")
      objShell.Run """QQ路径不用用引号"""
   End If
  Loop
End FunctionCOPY