163 Mail Auto Login
'*****************************************************************************
' FileName: Mail_163_AutoLogin.VBS
' Author: baomaboy
' Abstract: 163 Mail Auto Login by baomaboy
'*****************************************************************************
'-----------------------------------------------------------
'''Format of 163.txt (email address-----password)
'''xxxxxx@163.com-----yyyyyyyy
'''Similar scripts on the web have the problem of crazily popping up web pages and abnormal window closing; fixed here.
'''Tested OK with IE and Maxthon on this local XP-SP2 machine.
'-----------------------------------------------------------
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="Linglong Technology"
QQ="QQ:25926183"
Email="Email:25926183@qq.com"
InsTitle="NetEase Mail Auto Login"
InsAnswer="NetEase Mail Auto Login"
RegPath1="HKEY_CLASSES_ROOT\CLSID\{208D2C60-3AEA-1069-A2D7-08002B30309D}\shell\Mail163_AutoLogin\"
RegValue1="NetEase Mail Auto Login(&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(" will add “"+ InsAnswer +"” to the right-click menu of My Network Places,"&Chr(10)&Chr(10)&" will remove “"+ InsAnswer +"” from the right-click menu of My Network Places. ", vbQuestion + vbYesNoCancel, "Install - "+ InsTitle +" - by baomaboy")
If intAnswer = vbYes Then
WshSHell.RegWrite RegPath1,RegValue1,RegForm1
WshSHell.RegWrite RegPath2,RegValue2,RegForm2
FSO.GetFile(FileFullName).Copy(InsFullName)
WshSHell.popup _
"Added script file:"+chr(10)+InsFullName+chr(10)+chr(10)+ _
"Added registry item:"+chr(10)+chr(34)+ RegPath1 +chr(34)+chr(10)+ _
chr(10) & CloseTime & " seconds later this window will close automatically!" +chr(10)+chr(10)+ _
chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _
, CloseTime, "Install successful - "+ 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 _
"Deleted script file:"+chr(10)+InsFullName+chr(10)+chr(10)+ _
"Deleted registry item:"+chr(10)+chr(34)+ RegPath1 +chr(34)+chr(10)+ _
chr(10) & CloseTime & " seconds later this window will close automatically!" +chr(10)+chr(10)+ _
chr(10) & "Copyright(C) " + Copyright +" " & QQ &" " + Email _
, CloseTime, "Uninstall successful - "+ 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("Please enter the number of login attempts for each username:"&vbcrlf&vbcrlf&"Enter 25926183 to modify the mail information.","163 Mail Auto Login—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 Mail"
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 "Could not get the mail information, please check and modify:"&MailTxt&vbcrlf&vbcrlf&CloseTime&" seconds later this window will close automatically.",CloseTime,"Mail Auto Login - 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 = "NetEase 163")
ie.Document.login163.username.value=ID
ie.Document.login163.password.value=PW
'WshSHell.SendKeys "~" ' Enter
WshSHell.SendKeys "{ENTER}" ' Enter
Do
Wscript.Sleep 1000
title=left(ie.Document.title,5)
if title = "NetEase Passport" then
WshSHell.popup "Username or password error."&vbcrlf&vbcrlf&CloseTime&" seconds later it will close automatically.",CloseTime,"Mail Auto Login - by baomaboy",0 + 48
Exit Do
end if
Loop Until (ie.ReadyState=4 and title = "NetEase Email")
Wscript.Sleep 1000
'WshSHell.SendKeys "^W" ' Close IE window
WshSHell.SendKeys "%FC" ' Close IE window
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 ]
|
