'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
'获取外网IPv4，强制等待获取正确IP
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
LoopEnd Function
IP卡
狗仔卡
发表于 2024-12-5 00:33:02
提升卡
沉默卡
喧嚣卡
变色卡
千斤顶
显身卡
楼主