126邮箱自动登陆程序
根据自己的需求改下。可可以做成固定网页表单输入程序,如果没有验证码的话.....
Dim g_oIE As InternetExplorer
Private Sub Combo1_Click()
'MsgBox "aaa"
Select Case Combo1.Text
Case "1@
Label1.Caption = "邮箱一!"
Case "2@
Label1.Caption = "邮箱二!"
Case "3@
Label1.Caption = "邮箱三!"
Case "4@
Label1.Caption = "邮箱四!"
Case "5@
Label1.Caption = "邮箱五!"
Case "6@
Label1.Caption = "邮箱六!"
Case "7@
Label1.Caption = "邮箱七!"
End Select
End Sub
Private Sub Command1_Click()
Dim vPost As Variant
Dim vHeaders As Variant
Set g_oIE = New InternetExplorer
g_oIE.Visible = True
ReDim aByte(0) As Byte
Select Case Split(Combo1.Text, "@")(0)
Case "1"
pass = "1"
Case "2"
pass = "2"
Case "3"
pass = "3"
Case "4"
pass = "4"
Case "5"
pass = "5"
Case "6"
pass = "6"
Case "7"
pass = "7"
End Select
cPostData = "user=" + Split(Combo1.Text, "@")(0) + "&pass=" + pass + "&cookietime=0"
PackBytes aByte(), cPostData
vPost = aByte
vHeaders = "Content-Type: application/x-www-form-urlencoded" + Chr(10) + Chr(13)
g_oIE.Navigate "http://entry., , , vPost, vHeaders
End Sub
Private Sub PackBytes(ByteArray() As Byte, ByVal PostData As String)
Dim iNewBytes As Integer
Dim i As Integer, j As Integer, ch As String
Dim strHex As String
iNewBytes = LenB(StrConv(PostData, vbFromUnicode)) - 1
If iNewBytes < 0 Then Exit Sub
ReDim ByteArray(iNewBytes) As Byte
For i = 0 To Len(PostData) - 1
ch = Mid(PostData, i + 1, 1)
If ch = "" Then
ch = "+"
ByteArray(j) = Asc(ch)
ElseIf Asc(ch) < 0 Then
ByteArray(j) = CByte("&H" & Left(Hex(Asc(ch)), 2))
j = j + 1
ByteArray(j) = CByte("&H" & Right(Hex(Asc(ch)), 2))
Else
ByteArray(j) = Asc(ch)
End If
j = j + 1
Next
End Sub
Private Sub Form_Load()
Combo1.Clear
Combo1.AddItem ("1@)
Combo1.AddItem ("2@)
Combo1.AddItem ("3@)
Combo1.AddItem ("4@)
Combo1.AddItem ("5@)
Combo1.AddItem ("6@)
Combo1.AddItem ("7@)
Combo1.ListIndex = 0
Label1.Caption = "hxfly --126邮箱自动登陆程序!"
End Sub