编程论坛's Archiver

hxfly 发表于 2008-5-11 19:47

126邮箱自动登陆程序

根据自己的需求改下。
可可以做成固定网页表单输入程序,如果没有验证码的话.....


    Dim g_oIE As InternetExplorer

Private Sub Combo1_Click()
'MsgBox "aaa"
    Select Case Combo1.Text
        Case "1@126.com"
            Label1.Caption = "邮箱一!"
        Case "2@126.com"
            Label1.Caption = "邮箱二!"
        Case "3@126.com"
            Label1.Caption = "邮箱三!"
        Case "4@126.com"
            Label1.Caption = "邮箱四!"
        Case "5@126.com"
            Label1.Caption = "邮箱五!"
        
        Case "6@126.com"
            Label1.Caption = "邮箱六!"
        Case "7@126.com"
            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.126.com/cgi/login", , , 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@126.com")
    Combo1.AddItem ("2@126.com")
    Combo1.AddItem ("3@126.com")
    Combo1.AddItem ("4@126.com")
    Combo1.AddItem ("5@126.com")
    Combo1.AddItem ("6@126.com")
    Combo1.AddItem ("7@126.com")
    Combo1.ListIndex = 0
    Label1.Caption = "hxfly --126邮箱自动登陆程序!"
End Sub

leilei88 发表于 2008-5-11 20:08

程序提示第一行的g_oIE As InternetExplorer这一句,编译错误:用户定义类型未定义。。

hxfly 发表于 2008-5-11 21:10

引用INTERNET控件.....

hxfly 发表于 2008-5-11 21:12

工程--引用---microsoft internet controls

把自己的邮箱名称和密码写到代码中

leilei88 发表于 2008-5-11 21:12

哦~会了,要添加一个引用啊

leilei88 发表于 2008-5-11 21:17

[tk09] 你不早说。。害的我花那么长时间找原因。。[tk05]

hxfly 发表于 2008-5-11 21:23

晕.....呵呵,我以为一看就能看出来呢,看变量类型不就是VB默认中没有的吗?看英文名字就是互联网浏览器空间啊,呵呵

ouzhiguang 发表于 2008-5-12 16:43

实现这个功能,用 webbrows控件,代码更加简单!

wen3988 发表于 2008-5-18 21:33

支持下~~~~~~~~~

duanzelong 发表于 2008-6-4 19:29

顶一下

vfdff 发表于 2008-6-6 08:04

[quote][bo][un]hxfly[/un] 在 2008-5-11 21:12 的发言:[/bo]

工程--引用---microsoft internet controls

把自己的邮箱名称和密码写到代码中 [/quote]
microsoft internet controls
要安装VB才有的把

随风逐流 发表于 2008-6-6 09:55

支持一下
對你開源的代碼非常感興趣,就跟對你人一樣感興趣
不知可否把代碼講解一下?

leilei88 发表于 2008-6-14 22:58

楼主。。我把它改成登陆sina的邮箱成功了,但改成163的邮箱时出问题了,找不到登陆网址,就是那个"http://entry.126.com/cgi/login"部分,我找不到对应的163邮箱的网址。。[em04] [em04]

页: [1]

Powered by Discuz! Archiver 6.1.0  © 2001-2007 Comsenz Inc.