baomaboy
银牌会员
积分 1513
发帖 554
注册 2005-12-30
状态 离线
|
『楼 主』:
163邮箱自动登陆→VBS版
163邮箱自动登陆
| Quote: | '*****************************************************************************
' FileName: Mail_163_AutoLogin.VBS
' Author: baomaboy
' Abstract: 163邮箱自动登陆 by baomaboy
'*****************************************************************************
'-----------------------------------------------------------
'''163.txt的格式(邮箱地址-----密码)
'''xxxxxx@163.com-----yyyyyyyy
'''网络类似脚本存在狂弹网页及窗口关闭异常现象，在此修正。
'''在本机xp－sp2的IE和Maxthon测试通过。
'-----------------------------------------------------------
Dim WshSHell,FSO
On Error Resume Next
Set WshSHell = WScript.CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
CloseTime = 5
FileName = WScript.ScriptName
FileFullName = WScript.ScriptFullName
FilePath = FSO.GetParentFolderName(FileFullName)
InsPath = FSO.GetSpecialFolder(1)'''0=windows,1=system32,2=user-Temp,
InsFullName = FSO.BuildPath(InsPath ,FileName)
MailTxt="MailTxt163.txt"
Copyright="玲珑科技"
QQ="QQ:25926183"
Email="Email:25926183@qq.com"
InsTitle="网易邮箱自登陆"
InsAnswer="网易邮箱自登陆"
RegPath1="HKEY_CLASSES_ROOT\CLSID\{208D2C60-3AEA-1069-A2D7-08002B30309D}\shell\Mail163_AutoLogin\"
RegValue1="网易邮箱自登陆(&Y)"
RegForm1="REG_SZ"
RegPath2="HKEY_CLASSES_ROOT\CLSID\{208D2C60-3AEA-1069-A2D7-08002B30309D}\shell\Mail163_AutoLogin\command\"
RegValue2="wscript.exe "&InsFullName
RegForm2="REG_SZ"
IF FileFullName <> InsFullName then
intAnswer = MsgBox("【是】将“"+ InsAnswer +"”加入到网上邻居右键菜单，"&Chr(10)&Chr(10)&"【否】将“"+ InsAnswer +"”从网上邻居右键菜单删除。 ", vbQuestion + vbYesNoCancel, "安装 - "+ InsTitle +" - by baomaboy")
If intAnswer = vbYes Then
WshSHell.RegWrite RegPath1,RegValue1,RegForm1
WshSHell.RegWrite RegPath2,RegValue2,RegForm2
FSO.GetFile(FileFullName).Copy(InsFullName)
WshSHell.popup _
"添加脚本文件："+chr(10)+InsFullName+chr(10)+chr(10)+ _
"添加注册表项："+chr(10)+chr(34)+ RegPath1 +chr(34)+chr(10)+ _
chr(10) & CloseTime & " 秒钟后本窗口将自动关闭!" +chr(10)+chr(10)+ _
chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _
, CloseTime, "安装成功 - "+ InsTitle +" - by baomaboy", 0 + 64
end if
If intAnswer = vbNo Then
WshSHell.RegDelete RegPath2
WshSHell.RegDelete RegPath1
FSO.DeleteFile InsFullName
FSO.DeleteFile FSO.BuildPath(InsPath,MailTxt)
WshSHell.popup _
"删除脚本文件："+chr(10)+InsFullName+chr(10)+chr(10)+ _
"删除注册表项："+chr(10)+chr(34)+ RegPath1 +chr(34)+chr(10)+ _
chr(10) & CloseTime & " 秒钟后本窗口将自动关闭!" +chr(10)+chr(10)+ _
chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _
, CloseTime, "卸载成功 - "+ InsTitle +" - by baomaboy", 0 + 64
End If
If intAnswer = vbCancel Then
end if
ELSE
If (FSO.FileExists(FSO.BuildPath(InsPath,MailTxt))) Then
else
Set NewFile = FSO.CreateTextFile(FSO.BuildPath(InsPath,MailTxt), True)
NewFile.WriteLine("xxxxxx@163.com-----yyyyyyyy")
NewFile.Close
end if
N=InputBox("请输入每个用户名的登陆次数:"&vbcrlf&vbcrlf&"输入 25926183 修改邮箱信息。","163邮箱自动登陆—by baomaboy","1")
If N=False Then WScript.Quit
if N=25926183 then
Call fixtxt
end if
For i=1 To N
Set FSO=CreateObject("Scripting.FileSystemObject")
Set FR=FSO.OpenTextFile(FSO.BuildPath(InsPath,MailTxt),1)
Do Until FR.AtEndOfStream
Login FR.ReadLine
Loop
FR.Close
Next
END IF
Set WshSHell=Nothing
Set FSO=Nothing
WScript.Quit(0)
Function Login(text)
'AppName="163邮箱"
Set ie=WScript.CreateObject("InternetExplorer.Application")
ie.visible=True
text=Trim(text)
ID=Left(text,InStr(text,"@")-1)
PW=Right(text,len(text)-instrrev(text,"-"))
if ID="" or PW="" then
WshSHell.popup "没有取得邮箱信息，请查看修改:"&MailTxt&vbcrlf&vbcrlf&CloseTime&" 秒钟后本窗口自动关闭。",CloseTime,"邮箱自动登陆 - by baomaboy",0 + 48
Call fixtxt
end if
ie.navigate "http://mail.163.com"
Check = True
Do
err.Clear
Wscript.Sleep 1000
On Error Resume Next
title=left(ie.Document.title,5)
if err.number = 0 then Check = False
On Error GoTo 0
Loop Until Check = False
Do
Wscript.Sleep 1000
title=left(ie.Document.title,5)
Loop Until (ie.ReadyState=4 and title = "网易163")
ie.Document.login163.username.value=ID
ie.Document.login163.password.value=PW
'WshSHell.SendKeys "~" ' 回车
WshSHell.SendKeys "{ENTER}" ' 回车
Do
Wscript.Sleep 1000
title=left(ie.Document.title,5)
if title = "网易通行证" then
WshSHell.popup "用户名或密码错误。"&vbcrlf&vbcrlf&CloseTime&" 秒钟后自动关闭。",CloseTime,"邮箱自动登陆 - by baomaboy",0 + 48
Exit Do
end if
Loop Until (ie.ReadyState=4 and title = "网易电子邮")
Wscript.Sleep 1000
'WshSHell.SendKeys "^W" ' 关闭IE窗口
WshSHell.SendKeys "%FC" ' 关闭IE窗口
Wscript.Sleep 1000
Set ie=Nothing
End Function
Sub fixtxt()
WshSHell.Run ("Notepad.exe "&FSO.BuildPath(InsPath,MailTxt))
Set WshSHell=Nothing
Set FSO=Nothing
WScript.Quit(0)
End Sub |
|
[ Last edited by baomaboy on 2008-3-25 at 12:59 AM ]
|
好多菩提树，好多明镜台。本来好多物，好多的尘埃。 |
|
