本帖最后由 tegl 于 2009-10-18 16:50 编辑
将下列VBS脚本转AU3
Option Explicit
Dim theURL : theURL = "http://www.360key.cn/" '
Const MyName = "GetValidID"
Const MyVersion = &H4000
Const HKeyLocalMachine = "HKEY_LOCAL_MACHINE\"
Const HKEY_LOCAL_MACHINE = &H80000002
Const RegEset30 = "SOFTWARE\Eset\ESET Security\CurrentVersion\Plugins\01000400\Profiles\@My profile\"
Const RegEset27 = "SOFTWARE\Eset\Nod\CurrentVersion\Modules\Update\Settings\Config000\Settings\"
Const UserStartup = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\Startup"
Dim RegEset : RegEset = RegEset30
Dim str : str = ""
Dim ids
Dim un : un = ""
Dim pw : pw = ""
Dim PassBytesA : PassBytesA = Array(&H61, &HD4, &HDD, &HFB, &H5B, &H35, &HB7, &H19, &HEC, &H2B)
Dim PassBytesB : PassBytesB = Array(&HD6, &HE9, &HF0, &HF2, &H64, &HAD, &HC8, &H75, &H31, &HBC)
Dim oShell : Set oShell = CreateObject("WScript.Shell")
Dim oFso : Set oFso = CreateObject("Scripting.FileSystemObject")
Dim oXmlHttp : Set oXmlHttp = CreateObject("Msxml2.XMLHTTP")
Dim StartupPath : StartupPath = oShell.RegRead(UserStartup)
If Wsh.Arguments.Count > 0 Then If Wsh.Arguments(0) = "v" Then Wsh.Quit MyVersion
If Wsh.Arguments.Count <> 0 Then Wsh.Quit -254
If oShell.CurrentDirectory <> StartupPath Then
Dim StartupFullPath : StartupFullPath = StartupPath & "\" & MyName & ".vbs"
If Not oFso.FileExists(StartupFullPath) Then
If oShell.Popup("是否要把这个脚本复制到[启动]菜单?" & vbcrlf & _
"按'是'以後每次开机时这个脚本便会自动运行一次" & vbcrlf & _
"(本窗会在15秒后消失)", 15, MyName, vbYesNo + vbQuestion) = vbYes Then _
oFso.CopyFile Wsh.ScriptFullName, StartupFullPath, True
Else
If oShell.Run(Chr(34) & StartupFullPath & Chr(34) & " v",,True) < MyVersion Then _
If oShell.Popup("这个脚本版本比在[启动]菜单中的现有脚本要新" & vbcrlf & _
"是否要把这个新个脚本复制到[启动]菜单?" & vbcrlf & _
"按'是'以後每次开机时会运行这个新脚本" & vbcrlf & _
"(本窗会在15秒后消失)", 15, MyName, vbYesNo + vbQuestion) = vbYes Then _
oFso.CopyFile Wsh.ScriptFullName, StartupFullPath, True
End If
End If
On Error Resume Next
oShell.RegRead "HKEY_LOCAL_MACHINE\SOFTWARE\ESET\ESET Security\CurrentVersion\Info\ProductVersion"
If Err.Number <> 0 Then
On Error Resume Next
oShell.RegRead "HKEY_LOCAL_MACHINE\SOFTWARE\ESET\NOD\CurrentVersion\Info\CurrentVersion"
If Err.Number <> 0 Then
Wsh.Echo "本机没有安装ESET产品"
Wsh.Quit -128
End If
RegEset = RegEset27
End If
On Error Goto 0
With oXmlHttp
.Open "GET", theURL, False
.SetRequestHeader "Pragma", "no-cache"
.SetRequestHeader "Cache-Control", "no-cache"
On Error Resume Next
.Send
If Err.Number <> 0 Then
Wsh.Echo "连接不上ID分发网站"
Wsh.Quit -1
End If
On Error Goto 0
If .Status <> 200 Then
Wsh.Echo "ID分发网页有错误"
Wsh.Quit -2
End If
With New RegExp
.IgnoreCase = True
.Global = True
.Pattern = "(?:username)\s*:\s*(EAV-\d+)[\s\S]*?(?:password|passw0rd)\s*:\s*(\w+)"
Dim match
For Each match In .Execute(oXmlHttp.responseText)
str = str & match.SubMatches(0) & ":" & _
match.SubMatches(1) & vbcrlf
Next
'Wsh.Echo str : Wsh.Quit
End With
If Len(str) = 0 Then
Wsh.Echo "在ID分发网页内找不到任何ID"
Wsh.Quit -4
End If
Dim i, j, m, k, u, tmp
Randomize
ids = Split(str, vbcrlf)
i = Abs(UBound(ids) - 1)
if i > 15 then i = 15
ReDim rand(i)
For j = 0 To i : rand(j) = j : Next
For j = 0 To i
k = Fix(Rnd() * (i + 1)) : u = Fix(Rnd() * (i + 1))
m = rand(k) : rand(k) = rand(u) : rand(u) = m
Next
For j = 0 To i : Do
un = "" : pw = ""
tmp = Split(ids(rand(j)), ":")
un = Trim(tmp(0)) : pw = Trim(tmp(1))
If un = "" Or pw = "" Then Exit Do
.Open "GET", "http://update.eset.com/download/engine3/em000_32_l0.nup", _
False, un, pw
On Error Resume Next
.Send
If Err.Number <> 0 Then
Wsh.Echo "连接不上ESET官址进行验证..."
Wsh.Quit -1
End If
On Error Goto 0
If .Status <> 200 And .Status <> 304 Then Exit Do
Dim Version : Version = oShell.RegRead _
("HKEY_LOCAL_MACHINE\SOFTWARE\Eset\ESET Security\CurrentVersion\Info\ProductVersion")
if Left(Version, 1) = "4" Then
On Error Resume Next
Dim InstallDir : InstallDir = oShell.RegRead _
("HKEY_LOCAL_MACHINE\SOFTWARE\Eset\ESET Security\CurrentVersion\Info\InstallDir")
If Err.Number <> 0 Then
Wsh.Echo "找不到 ESET 4.0 的安装目录, 不能进行更新"
Wsh.Quit -1
end if
On Error Goto 0
oShell.Run(Chr(34) & InstallDir & "egui.exe" & Chr(34))
while not oShell.AppActivate("ESET NOD32 Antivirus") and _
not oShell.AppActivate("ESET Smart Security")
Wsh.Sleep 50
wend
Wsh.Sleep 50
oShell.SendKeys "%s"
oShell.SendKeys "{ENTER}"
while not oShell.AppActivate("License details")
Wsh.Sleep 50
wend
Wsh.Sleep 50
oShell.SendKeys un
Wsh.Sleep 50
oShell.SendKeys "{TAB}"
Wsh.Sleep 50
oShell.SendKeys pw
Wsh.Sleep 50
oShell.SendKeys "{ENTER}"
Wsh.Sleep 50
oShell.SendKeys "%{F4}"
while oShell.AppActivate("ESET NOD32 Antivirus") or _
oShell.AppActivate("ESET Smart Security")
Wsh.Sleep 50
wend
Else
ReDim binarr((Len(pw) - 1) * 2 + 1)
For k = 0 To UBound(PassBytesA)
binarr(k * 2) = Asc(Mid(pw, k + 1, 1)) Xor PassBytesA(k)
binarr(k * 2 + 1) = PassBytesB(k)
If k + 1 >= Len(pw) Then Exit For
Next
oShell.RegWrite HkeyLocalMachine & RegEset & "Username", un, "REG_SZ"
GetObject("Winmgmts:root\default:StdRegProv")_
.SetBinaryValue HKEY_LOCAL_MACHINE, RegEset, "Password", binarr
End If
oShell.Popup "随机抽选的新ID已被验证和安装" & vbcrlf & " Username: " & un & vbcrlf & _
" Password: " & pw & vbcrlf & " (本窗会在5秒后消失)", 5, MyName, vbOKOnly + vbInformation
Wsh.Quit 0
Loop While False : Next
Wsh.Echo "ID分发网页内的ID全部无效"
Wsh.Quit -3
End With
Wsh.Quit 0 |