分享
 
 
 

自动上网抓数据的机器人

王朝vb·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

在大多数情况下,上网冲浪是件令人愉快的事情。但若是数百上千的超链接摆在你面前,而你又不得不一一点击这些链接、进入相应的网页、手工筛选出每页里你需要的信息、最后再将这些信息编进数据库中、....,你将做何感想?如果每天都从事这种繁杂、枯燥的工作会不会让你发疯?

“自动上网机器人”或许可救你出“苦海”:你可以喝着咖啡、听着音乐、看着“机器人”辛勤地替你工作,那感觉是不是棒极了!

本文结合实例详尽讨论了用VB实现“上网机器人”的技术细节。我们知道,搜集和下载资料是人们使用互联网的最主要的目的之一,但有些信息资源过于庞大,用手工摘取的方法是困难的或根本就是行不通的。例如,你需要搜集欧洲进口机械设备的公司名录以便给他们发信邀请其参加博览会,在网上找到这些信息并不难,但出于数据安全等方面的考虑,几乎所有提供类似信息的网站都没有提供直接下载数据的功能。

要想搜集齐想要的数据,唯一可用的方法就是一页一页地浏览每个公司的信息页,摘取其中有用的数据并存入数据库。但当公司总数超过数千时,巨大的工作量会让任何人望而却步!其实,这浩大的工作完全可以由程序来完成,因为这些任务完全是机械的重复性工作。而且,用程序完成比用手工要快得多。本文涉及的技术细节是通用的,即对实例程序稍加修改就可完成任何“自动上网冲浪”任务。

自动拨号上网、自动处理中途掉线、任务完成后自动挂断,这些都是“上网机器人”的最基本的功能之一。它还能给你带来明显的经济回报:如果你让“机器人”在晚间至凌晨的上网费优惠期内拨号上网去自动冲浪,那真可称得上是典型的“一石三鸟”----你睡觉、它工作、还省钱!有关这方面的细节将在本文的第三部分里讨论。该部分提供了实现上述各功能的若干方法,并比较了这些方法各自的优劣。

本文的第一和第二部分分别以两个实例讨论了自动浏览的技术细节:在网页上的输入区内自动填入数据以便完成诸如用户登录等的操作、自动更新CheckBox、自动选择下拉式列表(ComboBox)的值、自动点击网页上的按钮、从网页上精确提取有用的数据并存盘、将网页上二维表(Table)内的数据一一提取出来并转换且存储成可直接导入数据库或 Excel的格式,以及控制浏览进程的技巧等等。

第一部分 从网页上精确提取数据

本部分的实例是:下载沪深两市全部约1100家个股的基本信息及财务数据。若用手工操作,如上图所示,需要在股票代码区内分别输入1100个股票代码,在下拉式列表(ComboBox)中分别选择“个股资料”和“财务数据解读”,算下来约是2200次操作!这样的工作当然是由程序来完成划算得多。况且手工提取数据(先选中、再使用Ctrl+C拷贝)极容易出错(多选或漏选),又很费眼神。

1. 在输入区内自动填入数据

为使程序能高效地自动浏览,需引入一些最基本的功能,如在输入区内自动填入数据、自动点击按钮等等。虽然用变换 URL地址的方法有时也能完成任务,但往往过于费力,尤其当网页上的输入区较多时更是如此。

为了在输入区内输入数据,需要先搜索到该对象的名字,然后将该对象的值置为要填入的数据即可。搜索名字的工作可编程完成,亦可用 FrontPage轻松获得。

2. 自动在下拉式列表(ComboBox)中进行选择

同样地,首先要获得下拉式列表的名字。然后根据下拉式列表的元素总数(length属性)在列表中搜索要设置的值(列表的 Options集合中元素的Text属性),找到后,将该元素设为选中元素(元素的Selected属性)。

3. 自动点击按钮

对于按钮来讲,可根据其名字访问,亦可根据其值访问。按钮的值就是显示在按钮上的文字。一个按钮可能没有名字,但一定有值。本例的程序就是根据值来访问按钮。执行按钮的 Click方法就相当于点击了该按钮。

图二中红色箭头所指即为程序自动填入输入框、自动在ComboBox中选择以及自动点击按钮的情况。

4. 精确提取数据

仅将有用的数据存储下来才是有意义的。必须研究网页,找出有效数据所在的Tag区(可用文本编辑器或 FrontPage),然后用该对象的innerText属性获得最终的文本。本例中要存储的数据如下图所示,其所用的Tag为“PRE”。

下面给出的是实例程序的完整代码:

' 程序一:从网页上精确提取数据

'

' 为运行本程序,应在“菜单->工程->部件”中添加“Microsoft Internet Controls”

' 并在“菜单->工程->引用”中添加“Microsoft HTML Object Library”

'

' 为了简洁,程序仅下载九只个股的基本信息

Option Explicit

Private Const Form_ID = 1

Dim Code(9) As String

Dim Current As Long

Private Sub Form_Load()

Form1.MousePointer = 11

' 以下是个股代码

' 为了程序简洁,这里仅使用九只代码。

' 而在真实环境中,应从数据文件中读入全部个股代码。

Code(0) = "600001": Code(1) = "600002": Code(2) = "600003"

Code(3) = "600005": Code(4) = "600006": Code(5) = "600007"

Code(6) = "600008": Code(7) = "600009": Code(8) = "600010"

Current = 0

WebBrowser1.Navigate "www.stockstar.com.cn" ' 起始网址

End Sub

Private Sub WebBrowser1_DocumentComplete(ByValpDisp As Object, URL As Variant)

Dim i, k

Text2 = WebBrowser1.LocationURL ' 显示当前网址

' 判断当前网页是否全部调入完毕

If Not (pDisp Is WebBrowser1.Object) Then Exit Sub

On Error Resume Next

Select Case Text2

Case "http://www.stockstar.com.cn/home.htm" ' 当进入主页面时执行以下程序

For i = 0 To WebBrowser1.Document.Forms(Form_ID).length - 1

' 找到代码输入框后填入个股代码

If WebBrowser1.Document.Forms(Form_ID)(i).Name = "code" Then _

WebBrowser1.Document.Forms(Form_ID)(i).Value = Code(Current)

' 在下拉式列表中进行选择

If WebBrowser1.Document.Forms(Form_ID)(i).Name = "target" Then

For k = 0 To WebBrowser1.Document.Forms(Form_ID)(i).length - 1

If WebBrowser1.Document.Forms(Form_ID)(i).Options(k).Text _

= "个股资料" Then

WebBrowser1.Document.Forms(Form_ID)(i).Options(k).Selected = True

Exit For

End If

Next k

End If

' 点击按钮

If WebBrowser1.Document.Forms(Form_ID)(i).Value = " 查询 " Then _

WebBrowser1.Document.Forms(Form_ID)(i).Click

Next

Case Else ' 当进入数据页面时执行以下程序

For i = 0 To WebBrowser1.Document.All.length - 1

If WebBrowser1.Document.All(i).tagName = "PRE" Then

' 精确提取数据

Text1 = Text1 + Code(Current) + vbCrLf + _

WebBrowser1.Document.All(i).innerText + vbCrLf

Exit For

End If

Next

' 数据存盘

Open "C:\Data2.Txt" For Append As #1

Print #1, Text1: Text1 = "": Close #1

' 换下一只股票

Current = Current + 1

If Current >= 9 Then

' 上网任务完成后,应在此调用自动挂断过程。

Form1.MousePointer = 0: MsgBox "Finished!": End

End If

' 回退到主页面,查询下一只股票的信息

WebBrowser1.GoBack

End Select

End Sub

第二部分 将网页上的二维表导入数据库

在上一部分中,我们讨论了让程序自动在网上浏览并将所需的数据准确、快速地存储下来的方法。现在,我们将迎接更大的挑战:将网页上以表格形式存在的二维数据提取出来,并存成可直接导入数据库的“Microsoft Excel 逗号分隔值文件”(即.csv文件)。

用手工在网页上直接提取类似上图中所示的表格数据是非常困难的。如果这样的表格有数十页甚至上百页之多,手工提取工作将是不可想象的,而且非常容易出错。

本部分的实例是:将沪深两市全部约1100家个股的财务评分表数据(共54页,每页20家,如上图所示)快速、准确地转换成“.csv”文件。

1. 自动设置CheckBox的值

由于只有注册用户才能访问上述财务评分表,因此实例程序首先演示了自动注册的功能。下图显示的是注册前以及自动注册后的画面。

我们在上一部分中已讨论了自动填写输入区以及自动点击按钮等的方法。对于自动设置CheckBox值,其方法完全类似:首先要搜索到该CheckBox的名字,然后将该对象的Checked属性置为True或False即可。

2. 将网页上的二维表导入数据库

首先定义一个IHTMLElementCollection对象用于收集网页上所有的 Table,然后用getElementsByTagName方法执行收集工作:

Dim Tables AsIHTMLElementCollection

Set Tables = WebBrowser1.Document.getElementsByTagName("Table")

一个网页上往往有多个 Table。我们用HTMLTable对象来处理每个Table:

Dim Table1 AsHTMLTable

For Each Table1 In Tables

Next

HTMLTable对象的innerText属性记录了整个 Table的全部信息,包括字段名。因此我们可以根据字段名判断出哪个 Table是我们需要的。

为了逐行逐列地提取数据,我们还需要HTMLTableRow对象和HTMLTableCell对象:

Dim Row AsHTMLTableRow, Cell As HTMLTableCell

For i = 1 To Table1.rows.length - 1 ' 逐行处理

Set Row = Table1.rows(i)

j = 0

For Each Cell In Row.cells ' 逐列处理

' Row.cells(j).innerText即为当前行及当前列上的单元数据

Text1 = Text1 + Trim(Row.cells(j).innerText) + ","

j = j + 1

Next

' 一行处理完毕后,去除行尾的逗号并加上回车

Text1 = Left(Text1, Len(Text1) - 1) + vbCrLf

Next

至此,当前网页上的二维表已转换成“.csv”格式。

3. 自动浏览时的页面控制技巧

我们从上个例子中就已经清晰地看到,自动浏览程序的主体是WebBrowser控件的DocumentComplete事件。只有在当前页面已被完全调入后,我们才能开始对当前页面进行数据处理,然后再根据当前在哪个页面来决定下一步的浏览方向。

需要指出的是,DocumentComplete事件的发生并不一定意味着当前页面已被全部调入。如果页面上没有其它子框架(frames),发生DocumentComplete事件即表明当前页面(即主框架)已完成调入;若页面上有多个框架,则每个框架完成时都会发生DocumentComplete事件;当所有子框架都完成后,主框架最后产生一次DocumentComplete事件。为了判断出这最后一次DocumentComplete事件,需要比较每次事件发生时的对象(pDisp)是否是WebBrowser控件对象本身:

Private Sub WebBrowser1_DocumentComplete(ByValpDisp As Object, _

URL As Variant)

If (pDisp Is WebBrowser1.Object) Then

Debug.Print "Document is finished loading."

End If

End Sub

下面是实例程序的完整代码(运行该程序可得到完整的1061行“.csv”格式的数据,分别代表1061个上市公司的财务信息。该文件可直接导入Access数据库或 Excel中。):

' 程序二:将网页上的二维表导入数据库

'

' 为运行本程序,应在“菜单->工程->部件”中添加“Microsoft Internet Controls”

' 并在“菜单->工程->引用”中添加“Microsoft HTML Object Library”

'

Option Explicit

Dim Page As Long

Private Sub Form_Load()

Form1.MousePointer = 11

WebBrowser1.Navigate "www.stockstar.com.cn" ' 起始网址

End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)

Dim Table1 As HTMLTable, Tables As IHTMLElementCollection

Dim Row As HTMLTableRow, Cell As HTMLTableCell

Dim i, j, tmp

Text2 = WebBrowser1.LocationURL ' 显示当前网址

' 判断当前网页是否全部调入完毕

If Not (pDisp Is WebBrowser1.Object) Then Exit Sub

On Error Resume Next

Select Case Text2

Case "http://www.stockstar.com.cn/home.htm" ' 当进入主页面时执行以下程序

' 用户注册登录

For i = 0 To WebBrowser1.Document.Forms(0).length - 1

' 找到 CheckBox 后,将其值改为 False,以防止用户名及密码被存储

If WebBrowser1.Document.Forms(0)(i).Name = "checkSavePW" Then _

WebBrowser1.Document.Forms(0)(i).Checked = False

If WebBrowser1.Document.Forms(0)(i).Name = "userId" Then _

WebBrowser1.Document.Forms(0)(i).Value = "kompass_china"

If WebBrowser1.Document.Forms(0)(i).Name = "passwd" Then _

WebBrowser1.Document.Forms(0)(i).Value = "kompass1"

' 此处是按名字访问按钮(上例中是按值访问按钮)

If WebBrowser1.Document.Forms(0)(i).Name = "continue" Then _

WebBrowser1.Document.Forms(0)(i).Click

Next

Case "http://my.stockstar.com/scripts/mystockstar.dll?login"

' 当用户登录完成后,准备打开表格的第一页

WebBrowser1.Navigate "http://finance.stockstar.com/scripts/finance.dll?" + _

"showstkdfpm&begin=0&ret=1&index=2&concode=01"

Page = 1

Case Else ' 当进入数据页面(表格的第一页至最后一页)时执行以下程序

Set Tables = WebBrowser1.Document.getElementsByTagName("Table")

For Each Table1 In Tables

If Left(Table1.innerText, 2) = "名次" Then ' 找到需要的Table

' 将表格转换成“.csv”格式

For i = 1 To Table1.rows.length - 1

Set Row = Table1.rows(i)

j = 0

For Each Cell In Row.cells

Text1 = Text1 + Trim(Row.cells(j).innerText) + ","

j = j + 1

Next

Text1 = Left(Text1, Len(Text1) - 1) + vbCrLf

Next

' 数据存盘

Open "C:\Data.csv" For Append As #1

Print #1, Left(Text1, Len(Text1) - 2): Text1 = "": Close #1

Exit For

End If

Next

' 准备打开下一页

Page = Page + 1

tmp = "http://finance.stockstar.com/scripts/finance.dll?showstkdfpm&ret=" + _

Trim(Str(Page)) + "&index=2&concode=01"

If Page <= 54 Then ' 判断是否浏览结束

WebBrowser1.Navigate tmp

Else

' 上网任务完成后,应在此调用自动挂断过程。

Form1.MousePointer = 0

MsgBox "Finished!!": End

End If

End Select

End Sub

以下给出的是上述程序所存数据文件的片段:

1,乐凯胶片,600135,材料,81.493,18.445,23.165,8.850,20.717,10.315

2,歌华有线,600037,传播娱乐,80.553,13.009,22.256,12.141,20.304,12.844

3,外运发展,600270,仓储运输,80.326,17.331,23.005,8.829,19.900,11.261

4,东方钽业,0962,有色金属,80.312,15.160,22.483,11.648,21.290,9.730

5,双汇发展,0895,食品,79.772,15.428,20.673,11.508,20.235,11.930

6,四川美丰,0731,化肥,79.361,15.795,23.235,11.323,16.921,12.088

... ... ...

1059,轮胎橡胶,600623,车类,7.167,8.265,10.973,-34.411,14.120,8.219

1060,PT吉轻工,0546,日用轻工产品,-11.895,5.740,-49.149,7.999,14.136,9.379

1061,广船国际,600685,机械仪器,-57.452,9.824,-1.528,-89.648,14.366,9.533

第三部分 自动拨号、自动挂断以及自动处理中途掉线

一个出色的“自动上网机器人”程序应能按照既定的时间准时开始拨号、并当所需任务已完成后立即挂断。而且仅做到这些还不够,它还应在发出拨号指令后跟踪拨号操作是否真的成功、上网速度如何、是否需要挂断后重新拨号、自动浏览过程中是否出现掉线、以及最终的挂断操作是否真的成功完成,等等。

因此,“机器人”程序应定时检查在线状况,以保证浏览时一定在在线状态、浏览完毕后一定不在在线状态。同时还要检查浏览进度,当浏览速度过慢时尝试挂断后重新拨号。

本部分讨论了实现“自动拨号”、“检查在线状况”、以及“自动挂断”这三个功能的若干方法,比较了诸方法各自的优劣,并总结给出了使用建议。本部分的示例程序将这三个功能的诸方法集成在一起,以便于大家对比使用(见下图)。

1. 自动拨号

方法1A:使用rnaui.dll

rnaui.dll是微软的“拨号网络用户接口”程序集,一般在“\Windows\System”目录下。其中的RnaDial程序用于启动拨号。该程序可在命令行执行(在“开始”->“运行”中键入):

rundll32.exe rnaui.dll,RnaDial <拨号网络连接名>

其中的“RnaDial”和“<拨号网络连接名>”是区分大小写的。

但由于上述命令仅启动拨号窗口而未立即开始拨号,因此在程序中使用时还应再

送出模拟“回车”的按键:

ret = Shell("rundll32.exe rnaui.dll,RnaDial " + 连接名, 1)

SendKeys "{enter}", True

方法1B:使用wininet.dll

wininet.dll是微软的Internet扩充函数集,一般在“\Windows\System”目录下。其中的InternetAutodial、InternetAutodialHangup和InternetGetConnectedState三个函数分别可完成自动拨号、自动挂断和判断在线状态等任务。InternetAutodial的定义为:

Private Declare Function InternetAutodial Lib "wininet.dll" _

(ByValdwFlags As Long, ByValdwReserved As Long) As Long

若将第一个参数(dwFlags)的值设为2,该函数无需用户干预就可自动拨号。但使用该函数有一个前提:即必须将“Internet 属性”->“连接”设成“始终拨打默认连接”(见下图)。

用InternetAutodial函数自动拨号的情况可参见下图。从图中可以看出,该方法可自动重试多次。具体的重试次数在默认连接的“设置”->“高级”中定义:

方法1C:使用RAS

RAS 是微软的远程访问服务(Remote Access Service)API集合。其中的 API函数RasDial可完成拨号任务。但由于该函数在使用上略显复杂而不太常用,故示例程序中未采纳。

自动拨号方法小结:rnaui方法使用起来最简单,又由于它不一定非要使用默认连接,因此也最灵活。但这种灵活恰恰又给它带来了弱点,即如果不提供连接名,该方法不会自动调用默认连接。此外,这种方法还有两个最大的缺点:一是仅拨号一次,若出现占线或没有响应等情况时不会自动重试;二是调用程序不容易得到拨号是否成功的返回值。相比之下,wininet方法虽仅能拨打默认连接(无默认连接时,使用第一个连接),但它可多次试拨,并且InternetAutodial函数等待拨号成功或所有试拨结束以便给调用程序返回拨号是否成功的值,因此,在“自动上网机器人”的环境中wininet方法是最适宜的。

2. 检查在线状况

方法2A:wininet方法

若InternetGetConnectedState函数返回True,则为在线状态。该方法最大的缺点是:若当前连接不是用wininet方法建立的,则返回值可能不准确。

方法2B:查找窗口法

拨号连接成功后,下图所示的窗口一定存在(不管它是最小化在任务栏的最右端,或是开启为下图所示的状态):

用FindWindow API函数找到该窗口即意味着当前在线。此外,查找窗口法的另一个用处是查找“重新连接”窗口:当中途掉线时,操作系统往往会询问你是否重新连接,找到该窗口并发出模拟“回车”按键即可实现再拨号。

查找窗口法的缺点是:由于找窗口时需要提供窗口标题,因此即使使用的是默认连接也必须事先知道默认连接名。

方法2C:RAS 方法

先用RasEnumConnections函数返回整个RAS集合,再用RasGetConnectStatus函数判断第一个 RAS连接的状态。RAS方法的最大优点是:不管当前连接是否是用wininet建立的,RAS 方法均可对在线状态做出正确判断。

方法2D:注册表法

在线时,注册表的“\HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\RemoteAccess”处有键值“Remote Connection”,且其值不为零;不在线时,该处无“Remote Connection”键值(当本次系统启动后从未拨号成功时),或者其值为零(表明曾拨号成功,但现在已断掉)。

检查在线状况之方法小结:由于wininet方法的局限性,一般我们应避免使用之;查找窗口法是可靠的,只是要知道连接名;因此我们推荐使用RAS 方法和注册表法。

3. 自动挂断

方法3A:wininet法

使用InternetAutodialHangup函数。同样地,若当前连接不是用wininet方法建立的,则返回值可能不准确(即不能成功挂断)。

方法3B:窗口查找法

找到图九所示的窗口,然后用ShowWindow API函数使之成为当前窗口,最后发出模拟<Alt>+C的按键操作(从图九中可以看出,<Alt>+C是“断开连接”按键的快捷方式)。

方法3C:RAS 法

用RasHangUp函数执行挂断。不管用何种方法建立的连接,RAS 法均能可靠地完成任务。

自动挂断方法小结:相比之下,窗口查找法和RAS 法是可以信赖的。

4. 本部分总结

综上所述,对于“自动拨号”、“检查在线状况”、以及“自动挂断”的各种方法,我们推荐“1A-2C-3C”组合。当然各方法可综合使用(如加入2D、3B等),以确保万无一失。在具体编程时还应注意:拨号后判断结果,如不成功应重新拨号;任务进行过程中定时检查在线状态,出现掉线后应及时处理;最后的挂断操作后应再查在线状态,以确保挂断成功。

下面是实例程序的完整代码。源代码中的全局定义已按照wininet、RAS、注册表等进行分类,各具体方法也均按序排列,以便于大家挑选使用。该程序的执行情况在本部分的开始处已给出(图六)。

' 程序三:自动拨号、自动挂断以及自动处理中途掉线

'

Option Explicit

' 有关 wininet 的全局定义

Private Const INTERNET_AUTODIAL_FORCE_UNATTENDED = 2

Private Const INTERNET_CONNECTION_MODEM = 1

Private Declare Function InternetAutodial Lib "wininet.dll" _

(ByVal dwFlags As Long, ByVal dwReserved As Long) As Long

Private Declare Function InternetAutodialHangup Lib _

"wininet.dll" (ByVal dwReserved As Long) As Long

Private Declare Function InternetGetConnectedState Lib _

"wininet.dll" (ByRef lpdwFlags As Long, ByVal _

dwReserved As Long) As Long

' 有关“窗口查找”的全局定义

Private Declare Function FindWindow Lib "user32" _

Alias "FindWindowA" (ByVal lpClassName As String, _

ByVal lpWindowName As String) As Long

Private Declare Function ShowWindow Lib "user32" _

(ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Private Const SW_SHOW = 5

' 有关 RAS 的全局定义

Private Const RASCS_DONE = &H2000&

Private Const RAS_MaxEntryName = 256

Private Const RAS_MaxDeviceType = 16

Private Const RAS_MaxDeviceName = 128

Private Type RASCONN

dwSize As Long

hRasConn As Long

szEntryName(RAS_MaxEntryName) As Byte

szDeviceType(RAS_MaxDeviceType) As Byte

szDeviceName(RAS_MaxDeviceName) As Byte

End Type

Private Type RASCONNSTATUS

dwSize As Long

RasConnState As Long

dwError As Long

szDeviceType(RAS_MaxDeviceType) As Byte

szDeviceName(RAS_MaxDeviceName) As Byte

End Type

Private Ras_Buf(255) As RASCONN

Private Ras_Status As RASCONNSTATUS

Private lpcb As Long

Private lpcConnections As Long

Private Declare Function RasEnumConnections Lib _

"rasapi32.dll" Alias "RasEnumConnectionsA" (lprasconn _

As Any, lpcb As Long, lpcConnections As Long) As Long

Private Declare Function RasGetConnectStatus Lib _

"rasapi32.dll" Alias "RasGetConnectStatusA" (ByVal _

hRasConn As Long, lpRASCONNSTATUS As Any) As Long

Private Declare Function RasHangUp Lib "rasapi32.dll" _

Alias "RasHangUpA" (ByVal hRasConn As Long) As Long

' 有关“注册表”的全局定义

Private Const HKEY_LOCAL_MACHINE = &H80000002

Private Declare Function RegOpenKey Lib "advapi32.dll" Alias _

"RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As _

String, phkResult As Long) As Long

Private Declare Function RegQueryValueEx Lib "advapi32.dll" _

Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal _

lpValueName As String, ByVal lpReserved As Long, lpType _

As Long, lpData As Any, lpcbData As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" _

(ByVal hKey As Long) As Long

Dim ret As Long

'自动拨号

Private Sub wininet拨号测试_Click()

If InternetAutodial(INTERNET_AUTODIAL_FORCE_UNATTENDED, 0) _

Then MsgBox "已连接(wininet法)"

End Sub

Private Sub rnaui拨号测试_Click()

ret = Shell("rundll32.exe rnaui.dll,RnaDial " + Text1, 1): DoEvents

SendKeys "{enter}", True: DoEvents

End Sub

'检查是否断线

Private Sub wininet方法_Click() ' wininet法检查是否断线

If InternetGetConnectedState(INTERNET_CONNECTION_MODEM, 0) Then

MsgBox "在线."

Else

MsgBox "当前未连接。"

End If

End Sub

Private Sub 查找窗口法_Click() ' 查找窗口法检查是否断线

ret = FindWindow("#32770", "重新连接")

If ret <> 0 Then

Call ShowWindow(ret, SW_SHOW)

SendKeys "{enter}", True: Exit Sub

End If

ret = FindWindow("#32770", "连接到 The95963")

If ret <> 0 Then

MsgBox "在线."

Else

MsgBox "当前未连接。"

End If

End Sub

Private Sub RAS方法_Click() ' RAS方法检查是否断线

Ras_Buf(0).dwSize = Len(Ras_Buf(0)) + 1

lpcb = 256 * Ras_Buf(0).dwSize

ret = RasEnumConnections(Ras_Buf(0), lpcb, lpcConnections)

If ret Then

MsgBox "出错!": Exit Sub

End If

Ras_Status.dwSize = Len(Ras_Status) + 2

ret = RasGetConnectStatus(Ras_Buf(0).hRasConn, Ras_Status)

If ret = 0 And Ras_Status.RasConnState = RASCS_DONE Then

MsgBox "在线."

Else

MsgBox "当前未连接。"

End If

End Sub

Private Sub 注册表法_Click() ' 注册表法检查是否断线

Dim SubKey As String, ValueName As String

Dim Data As Long, Result As Long

SubKey = "System\CurrentControlSet\Services\RemoteAccess"

ret = RegOpenKey(HKEY_LOCAL_MACHINE, SubKey, Result)

If ret = 0& Then

ValueName = "Remote Connection"

ret = RegQueryValueEx(Result, ValueName, 0&, 0&, ByVal Data, 0&)

ret = RegQueryValueEx(Result, ValueName, 0&, 0&, Data, Len(Data))

If ret = 0& And Data <> 0 Then

MsgBox "在线!"

Else

MsgBox "当前未连接。"

End If

RegCloseKey (Result)

End If

End Sub

'自动挂断

Private Sub wininet法_Click() ' wininet法自动挂断

If InternetAutodialHangup(0) Then MsgBox "已挂断(wininet法)"

End Sub

Private Sub 窗口查找法_Click() ' 窗口查找法自动挂断

ret = FindWindow("#32770", "连接到 The95963")

If ret <> 0 Then

Call ShowWindow(ret, SW_SHOW)

SendKeys "%c", True

MsgBox "已挂断(窗口查找法)"

End If

End Sub

Private Sub RAS法_Click() ' RAS法自动挂断

Ras_Buf(0).dwSize = Len(Ras_Buf(0)) + 1

lpcb = 256 * Ras_Buf(0).dwSize

ret = RasEnumConnections(Ras_Buf(0), lpcb, lpcConnections)

If ret Then

MsgBox "出错!": Exit Sub

End If

Ras_Status.dwSize = Len(Ras_Status) + 2

ret = RasGetConnectStatus(Ras_Buf(0).hRasConn, Ras_Status)

If ret = 0 And Ras_Status.RasConnState = RASCS_DONE Then

If RasHangUp(Ras_Buf(0).hRasConn) = 0 Then _

MsgBox "已挂断(RAS法)"

End If

End Sub

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有