【VB】简易的山东灯塔党建答题程序源码
本帖最后由 firef0x 于 2018-5-8 11:48 编辑该程序发布在https://www.52pojie.cn/thread-688246-1-1.html
兑现程序发布最初的承诺，在活动结束之后放出程序源码。
之所以在活动结束之后才放出，主要是避免出题方有针对性的修改网站程序，其次防止在活动期间被人利用以牟利（虽然只是很简单一个小程序，但是某些钱实在好赚，不展开说了）。
本源码是第一个版本的程序源码，其后的历次更新均在此基础上修改而来，逐步加入和调整了模糊查询，剩下的就是易用性的改进，程序工作原理并没有什么变化。
昨天对程序进行了一定的修改以适应5月份的“模拟答题”（正式答题会报错，程序发布帖有更新后的完整程序），大家可以在此基础上测试。
除了API操作，其它操作我尽量作了注释，方便大家理解程序工作原理。
很简单的东西，大神轻喷。
程序使用Win7 Ultimate 64bit（Win10 Pro 64bit）+ VB6.0 with SP6开发
以下是程序代码：
Part0.程序窗口
引用Microsoft ActiveX Data Objects 2.8 Library、Microsoft HTML Object Library
插入mdl一个
窗体设置：
CommandButton两个：cmdGet、cmdGO
TextBox两个：txthWnd、txtTitle
ListBox一个：lstAnswer
Part1.窗体代码
Option Explicit
Private Sub cmdGo_Click()
'自动答题过程
Dim x
Dim i As Integer
Dim n As Integer
Dim strTextGet As String
Dim strAnswer As String
Dim tmpString As String
Dim tmpstringArray() As String
Dim MultiFlag As Boolean
i = 0
For Each x In hDoc.getElementsByClassName("w_fz18") '使用getElementsByClassName方法取得ClassName为w_fz18的Nodes集，并进行枚举
strTextGet = Replace(x.innerText, " ", "") '去掉空格，这里只考虑了半角空格一种情况，可以根据需要去掉全角空格或Chr(9)Tab占位符
Select Case i 'Nodes集8个为一个循环，第3个（Index为2）是题干，第4-7个（Index为3-6）为各选项
Case 2
strAnswer = FindAnswer(strTextGet) '根据题干取得答案文本
lstAnswer.AddItem CStr(lstAnswer.ListCount + 1) & "、" & strAnswer
Case 3 To 6 '判断页面上的选项并作答
tmpString = Right(strTextGet, Len(strTextGet) - 2)
If InStr(1, strAnswer, " ") > 0 Then '判断多选，真为多选（字符串中包含空格），假为单选
Erase tmpstringArray
MultiFlag = False
tmpstringArray = Split(strAnswer, " ") '分离多选答案
For n = 0 To UBound(tmpstringArray)
If tmpstringArray(n) = tmpString Then MultiFlag = True '比对并标记
Next
If MultiFlag Then x.parentNode.firstChild.Click '判断标记，如符合便点击选项前的Check或Option
Else
If strAnswer = tmpString Then x.parentNode.firstChild.Click '判断单选答案，如正确便点击选项前的Check
End If
End Select
If i < 7 Then i = i + 1 Else i = 0 '判断Node顺序，累加或重置顺序号
Next
cmdGo.Enabled = False
End Sub
Private Sub cmdGet_Click()
Set hDoc = Nothing
txthWnd.Text = ""
txtTitle.Text = ""
lstAnswer.Clear
Call getWeb '获取句柄并生成iHTMLDocuments对象
If Val(txthWnd.Text) > 0 Then
txtTitle.Text = hDoc.Title
cmdGo.Enabled = True
End If
End Sub
Function FindAnswer(tText As String) As String
'根据题目取得答案
Dim Cn As New ADODB.Connection
Dim Rs As New ADODB.Recordset
Dim i As Integer
Dim SQLStr As String
Dim strOutput As String
Dim strTmp() As String
'建立ADODB连接并打开
Set Cn = New ADODB.Connection
Cn.ConnectionString = "Provider=MSDataShape;Data Source=" & App.Path & "\test.mdb;Data Provider=Microsoft.Jet.OLEDB.4.0"
Cn.Open
'定义SQL命令字符串，这里只是用了绝对比较方法，可以通过 like + % 的方式变为模糊查找（后期即是如此）
SQLStr = "select * from test where Question='" & tText & "'"
'执行SQL语句并返回一个RecordSet对象，因为题库的关系这里的RecordSet只有一条记录，如使用模糊查找，应注意多条记录对应的答案会不同，所以需要通过调整模糊查找的关键词实现返回的记录为唯一值
Rs.Open SQLStr, Cn
If Not (Rs.EOF) Then
strOutput = Rs(6) '字段“Answer”为答案，其Index为6
If Len(strOutput) > 1 Then '判断多选，真为多选，假为单选
strTmp = Split(strOutput, ",") '分离多选答案
strOutput = ""
For i = 0 To UBound(strTmp)
strTmp(i) = Replace(Rs(setFieldIndex(strTmp(i))), " ", "") '根据答案选项取得答案文本
Next
strOutput = Join(strTmp) '将答案文本组合为单个字符串，答案之间以" "（空格）分隔
Else
strOutput = Rs(setFieldIndex(strOutput)) '根据答案选项取得答案文本
End If
End If
Rs.Close
Cn.Close
Set Rs = Nothing
Set Cn = Nothing
FindAnswer = strOutput
End Function
Function setFieldIndex(indexS As String) As Integer
'根据选项字母取得Fields的Index值
setFieldIndex = Switch(indexS = "A", 2, indexS = "B", 3, indexS = "C", 4, indexS = "D", 5)
End Function
Private Sub lstAnswer_Click()
'点击列表项后将列表的Tooltips更改为点击项的文本
lstAnswer.ToolTipText = lstAnswer.Text
End Sub
Part2.模块代码
Option Explicit
Public hDoc As IHTMLDocument
Private Type UUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (Destination As Any, ByVal Length As Long)
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function ObjectFromLresult Lib "oleacc" (ByVal lResult As Long, riid As UUID, ByVal wParam As Long, ppvObject As Any) As Long
Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, lParam As Any, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long
Private Function GenerateiHTMLObject(ByVal hWnd As Long) As IHTMLDocument
Dim ID As UUID
Dim lngReg As Long
Dim lngHnD As Long
lngHnD = RegisterWindowMessage("WM_HTML_GETOBJECT")
With ID
.Data1 = &H626FC520
.Data2 = &HA41E
.Data3 = &H11CF
.Data4(0) = &HA7
.Data4(1) = &H31
.Data4(2) = &H0
.Data4(3) = &HA0
.Data4(4) = &HC9
.Data4(5) = &H8
.Data4(6) = &H26
.Data4(7) = &H37
End With
Call SendMessageTimeout(hWnd, lngHnD, 0, 0, &H2, 2000, lngReg)
Call ZeroMemory(ID, Len(ID))
Call ObjectFromLresult(lngReg, ID, 0, GenerateiHTMLObject)
End Function
Public Sub getWeb()
'获取句柄并生成iHTMLDocument对象
Dim lngFindWn As Long
Dim tmpHwnd As Long
lngFindWn = FindWindow("IEFrame", vbNullString) '使用FindWindow API查找IEFrame子窗口，由于该子窗口仅存在于IE浏览器中，故本程序并不支持其它浏览器
'根据IEFrame的窗口结构逐层查找包含HTML DOM对象的子窗口，取得其句柄
tmpHwnd = FindWindowEx(lngFindWn, 0, "Frame Tab", vbNullString)
If tmpHwnd > 0 Then lngFindWn = tmpHwnd Else MsgBox "Frame Tab"
tmpHwnd = FindWindowEx(lngFindWn, 0, "TabWindowClass", vbNullString)
If tmpHwnd > 0 Then lngFindWn = tmpHwnd Else MsgBox "TabWindowClass"
tmpHwnd = FindWindowEx(lngFindWn, 0, "Shell DocObject View", vbNullString)
If tmpHwnd > 0 Then lngFindWn = tmpHwnd Else MsgBox "Shell DocObject View"
tmpHwnd = FindWindowEx(lngFindWn, 0, "Internet Explorer_Server", vbNullString)
If tmpHwnd > 0 Then lngFindWn = tmpHwnd Else MsgBox "Internet Explorer_Server"
If tmpHwnd > 0 Then
frmMain.txthWnd = lngFindWn
Set hDoc = GenerateiHTMLObject(lngFindWn) '根据查找到的句柄生成iHTMLDocument对象
End If
End Sub
【VB】简易的山东灯塔党建答题程序源码
本帖最后由 firef0x 于 2018-5-8 17:45 编辑下面我们再来谈谈关于HTML的分析。
这是我截取的灯塔党建页面其中一题的HTML，为了方便查看我调整了一下格式，更醒目。
（其中部分span标签被程序员打成了sapn，这个bug从始至终存在，呵呵哒。。。我这里偏不改它[/手动滑稽]，反正对我们使用没什么影响）
<li>
<h1>
<span>
<i class="W_num_i w_fz18">
1
</i>
</span>
.
<span class="w_colred w_fz18 w_boderti">
单选题
</span>
<span class="w_fz18">
我们的哲学社会科学有没有中国特色，归根到底要看有没有主体性、（）。
</span>
</h1>
<div class="W_ml45" answer="A" subjecttype="0">
<label>
<input name="ra_1" type="radio" value="A" goright="A" ids="undefined">
<sapn class="W_ml10 W_col W_pointer w_fz18">
A.原创性
</sapn>
</label>
</div>
<div class="W_ml45" answer="A" subjecttype="0">
<label>
<input name="ra_1" type="radio" value="B" goright="A" ids="undefined">
<sapn class="W_ml10 W_col W_pointer w_fz18">
B.自觉性
</sapn>
</label>
</div>
<div class="W_ml45" answer="A" subjecttype="0">
<label>
<input name="ra_1" type="radio" value="C" goright="A" ids="undefined">
<sapn class="W_ml10 W_col W_pointer w_fz18">
C.本体性
</sapn>
</label>
</div>
<div class="W_ml45" answer="A" subjecttype="0">
<label>
<input name="ra_1" type="radio" value="D" goright="A" ids="undefined">
<sapn class="W_ml10 W_col W_pointer w_fz18">
D.民族性
</sapn>
</label>
</div>
<div class="w_right W_ml45 w_fz18" style="display: none;">
</div>
</li>
我们可以看到，所有出现在页面中的文本都使用了span标签，其中使用css样式表规定了样式，所有的题目和选项都有w_fz18这个类名
所以我们提取页面文字使用GetElementsByClassName这个方法，ClassName当然就是我们观察出来的w_fz18
在一道题目内包含w_fz18的Nodes一共8个，所以程序查找判断是8组为一个循环。
我们提取到的每个Node实际上是<sapn class="W_ml10 W_col W_pointer w_fz18">C.本体性</sapn>这样的HTML代码构成的对象。
Node其中一个属性InnerHTML就是取得这一段HTML代码，而InnerText则是标签之间所有文本内容，所以我们用InnerText属性来获取题目/答案的文本
有了文本就可以进行分析查找判断了，在程序中使用Right(len-2)的方式去掉前面的C.字母项
当确定一个Node就是我们所查找到的正确答案之后，我们要对其进行点选操作，就需要对选项之前的Checkbox或者Radio进行定位，所以我们来分析一下单个选项：
<div class="W_ml45" answer="A" subjecttype="0">
<label>
<input name="ra_1" type="radio" value="C" goright="A" ids="undefined">
<sapn class="W_ml10 W_col W_pointer w_fz18">
C.本体性
</sapn>
</label>
</div>
在这里可以看到，定义Radio的<Input>Node和我们提取到的<span>Node是并列关系，而他们的父Node（parentNode）是<label>，<Input>是<label>下面第一个子Node（firstChild）
所以定位到Radio的<Input>Node，再发送个Click事件给它，就完成了模拟点击的动作
即<span>.parentNode.firstChild.Click。
必须支持大佬，谢谢 貌似我沙发和凳子都占了，超开心，谢谢大佬了 楼上的你是来水经验的吧 ？ 代码写的很漂亮!感谢分享原创源码{:301_1003:} 感谢分享……{:1_893:} 感谢分享，我们单位也有类似的答题，只实现了半自动显示答案，学习下楼主自动化的思路 本帖最后由 firef0x 于 2018-5-8 15:19 编辑
苏紫方璇 发表于 2018-5-8 13:04
感谢分享，我们单位也有类似的答题，只实现了半自动显示答案，学习下楼主自动化的思路
自动化的思路要配合HTML来看，这一部分偷了个懒没有做。。。。。有空了补个说明在上面。
可以自动登录的全自动化操作也要结合HTML来看，也不复杂
比如取得HTML DOM的标题，或者是取得IEFrame子窗口的URL，然后判断当前页面是登录页面还是操作页面
根据页面编写对应的过程就行。如果是多帐号连续操作记得加一个登出的过程。。。。 感谢楼主无私分享，共同学习，共同进步。