第二辑、网页：篡改、保留和屏蔽某些内容

cumulonimbus

[quote]蓝天630902 发表于 2012-9-22 20:57 http://bbs.people.com.cn/ewebeditor/ewebeditor.htm?id=content1&style=coolblue，先是出现这个

后我打开源文件看到这个

没看到要操作的源码。

蓝天630902

cumulonimbus 发表于 2012-9-22 21:15
[quote]蓝天630902 发表于 2012-9-22 20:57 http://bbs.people.com.cn/ewebeditor/ewebeditor.htm?id=conte ...

标签应该是可以读到的，
Sub 读取标签属性()
[a1,n1] = Split("className,clientHeight,clientLeft,clientTop,clientWidth,href,ID,innerText,tabIndex,tagName,Target,Title,uniqueID", ",")
    On Error Resume Next
    With CreateObject("internetexplorer.application")
        .Visible = True
        .Navigate "http://bbs.people.com.cn/ewebeditor/ewebeditor.htm?id=content1&style=coolblue"
        Do Until .ReadyState = 4
            DoEvents
        Loop
        Set r = .document.All
        For i = 0 To r.Length - 1
            Cells(i + 2, 1) = i
            Cells(i + 2, 2) = r(i).className          '对象的类。
            Cells(i + 2, 3) = r(i).clientHeight       '对象的高度，不计算任何边距、边框、滚动条或可能应用到该对象的补白。
            Cells(i + 2, 4) = r(i).clientLeft         'offsetLeft 属性和客户区域的实际左边之间的距离。
            Cells(i + 2, 5) = r(i).clientTop          'offsetTop 属性和客户区域的实际顶端之间的距离。
            Cells(i + 2, 6) = r(i).clientWidth        '对象的宽度，不计算任何边距、边框、滚动条或可能应用到该对象的补白。
            Cells(i + 2, 7) = r(i).href              '目标 URL 或锚点。
            Cells(i + 2, 8) = r(i).ID                '标识对象的字符串。
            Cells(i + 2, 9) = r(i).innerText         '对象标签内的文本。
            Cells(i + 2, 10) = r(i).tabIndex          '对象的 Tab 顺序的索引。
            Cells(i + 2, 11) = r(i).tagName           '对象的标签名称。
            Cells(i + 2, 12) = r(i).Target            '目标内容要显示于哪个窗口或框架。
            Cells(i + 2, 13) = r(i).Title             '对象的咨询信息(工具提示)。
            Cells(i + 2, 14) = r(i).uniqueID          '为对象自动生成的唯一标识符。
        Next i
    End With
End Sub

但还是没办法在http://bbs.people.com.cn/postDisplayAction.do?bid=1里面操作

cumulonimbus

蓝天630902 发表于 2012-9-22 21:26
标签应该是可以读到的，
Sub 读取标签属性()
[a1,n1] = Split("className,clientHeight,clientLeft,cli ...

老师太强大了，我在它的源文件里一个都没看到的，老师居然把它读出来了。

cumulonimbus

谢谢，我懂了

cumulonimbus

谢谢，我懂了。

蓝天630902

cumulonimbus 发表于 2012-9-23 10:35
谢谢，我懂了。

我还没有懂，用ａｐｉ弄了一个：

Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Public Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Public Const MOUSEEVENTF_MOVE = &H1    ' mouse move
Public Const MOUSEEVENTF_LEFTDOWN = &H2    ' left button down
Public Const MOUSEEVENTF_LEFTUP = &H4    ' left button up
Public Const MOUSEEVENTF_RIGHTDOWN = &H8    ' right button down
Public Const MOUSEEVENTF_RIGHTUP = &H10    ' right button up

Sub 发帖_强国社区()
    On Error Resume Next
    With CreateObject("internetexplorer.application")
        .Visible = True
        .Navigate "http://bbs.people.com.cn/postDisplayAction.do?bid=1"
        Do Until .ReadyState = 4
            DoEvents
        Loop
        t1 = Timer
        Do Until Timer > t1 + 2
            DoEvents
        Loop
        .document.All.tags("INPUT")(15).Value = "标签(关键词):"
        .document.All.tags("INPUT")(19).Value = "用户名"
        .document.All.tags("INPUT")(20).Value = "密码"
        .document.All.tags("INPUT")(10).Value = "标题"
        SetCursorPos 333, 489
        mouse_event MOUSEEVENTF_LEFTDOWN, 333, 489, 0, 0    '在坐标(xleft，ytop)处，左键
        mouse_event MOUSEEVENTF_LEFTUP, 333, 489, 0, 0    '在坐标(xleft，ytop)处，左键
        t1 = Timer
        Do Until Timer > t1 + 0.5
            DoEvents
        Loop
        SendKeys "{ENTER}"
        t1 = Timer
        Do Until Timer > t1 + 0.5
            DoEvents
        Loop
        SendKeys "正文标题："
        t1 = Timer
        Do Until Timer > t1 + 0.5
            DoEvents
        Loop
        SendKeys "{ENTER}"
        t1 = Timer
        Do Until Timer > t1 + 0.5
            DoEvents
        Loop
        SendKeys "    正文内容：ABCDEFG"
        t1 = Timer
        Do Until Timer > t1 + 0.5
            DoEvents
        Loop
        '.document.All("send").Click              '点击
        '.Quit
    End With
End Sub

cumulonimbus

蓝天630902 发表于 2012-9-23 17:00
我还没有懂，用ａｐｉ弄了一个：

Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Lo ...

我是说我弄懂了如何关闭打开的IE，你误会啦
要关闭打开的IE，只要用IE.quit就成啦

cumulonimbus

蓝天630902 发表于 2012-9-23 17:00
我还没有懂，用ａｐｉ弄了一个：

Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Lo ...

用mouse_event 无法后台运行。不太实用哈
这里有用户名：image1，密码:123456
这个用户名与密码只要登录该论坛，发贴时不需要重复输入用户名与密码。

cumulonimbus

蓝天630902 发表于 2012-9-23 17:00
我还没有懂，用ａｐｉ弄了一个：

Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Lo ...

下载了一个顶贴机，好像很简单，不知它的工作原理是什么？VBA能否写出这样的程序？

蓝天630902

cumulonimbus 发表于 2012-9-23 18:07
用mouse_event 无法后台运行。不太实用哈
这里有用户名：image1，密码:123456
这个用户名与密码只要登录 ...

Sub 发帖_强国社区()
    On Error Resume Next
    With CreateObject("internetexplorer.application")
        .Visible = True
        .Navigate "http://bbs.people.com.cn/postDisplayAction.do?bid=1"
        Do Until .ReadyState = 4
            DoEvents
        Loop
        Set r = .document.frames(0).document
        r.frames(0).document.body.innerText = "aa44ss"
        r.All("TB_Name_FormatBlock").All.tags("option")(3).Selected = True    '选择“段落样式”的“标题二”
        r.All("TB_Name_FormatBlock").onchange    '确定选择“段落样式”的“标题二”

        'r.All("TB_Name_FontName").All.tags("option")(2).Selected = True    '选择“黑体”
        'r.All("TB_Name_FontName").onchange    '确定选择“黑体”

        'r.All("TB_Name_FontSize").All.tags("option")(2).Selected = True    '选择“小初”
        'r.All("TB_Name_FontSize").onchange    '确定选择“小初”

        'r.All("TB_Name_Bold").Click    '确定选择“粗体”
        'r.All("TB_Name_Italic").All.tags("tiv")(0).Click    '确定选择“斜体”

        'Debug.Print r.body.All("TB_Name_Italic").outerhtml
        '.Quit
    End With
End Sub