平码公式规律出肖|平码可以买3个平码吗

VBGood網站全文搜索 Google

搜索VBGood全站網頁(全文搜索)
首頁 - 經驗之談 - 自動上網的機器人
發表評論(0)作者:不詳, 平臺:VB6.0+Win98, 閱讀:10037, 日期:2001-09-13


在大多數情況下,上網沖浪是件令人愉快的事情。但若是數百上千的超鏈接擺在你面前,而你又不得不一一點擊這些鏈接、進入相應的網頁、手工篩選出每頁里你需要的信息、最后再將這些信息編進數據庫中、....,你將做何感想?如果每天都從事這種繁雜、枯燥的工作會不會讓你發瘋?(編者注:其實真得很多時間都是在干這些的。)

“自動上網機器人”或許可救你出“苦海”:你可以喝著咖啡、聽著音樂、看著“機器人”辛勤地替你工作,那感覺是不是棒極了!

本文結合實例詳盡討論了用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函數使之成為當前窗口,最后發出模擬+C的按鍵操作(從圖九中可以看出,+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
平码公式规律出肖