vb.net中如何设计一个监控程序?

vb.net中如何设计一个监控程序?,第1张

以记事本为例

Public Class Form1

Public Sub ShellAndWait(ByVal ProcessPath As String)

Dim objProcess As System.Diagnostics.Process

Try

objProcess = New System.Diagnostics.Process()

objProcess.StartInfo.FileName = ProcessPath

objProcess.StartInfo.WindowStyle = ProcessWindowStyle.Normal

objProcess.Start()

objProcess.WaitForExit()

objProcess.Close()

Catch

MessageBox.Show("无法执行文件 " &ProcessPath, "错误")

End Try

End Sub

'监视程序悄好拦就可以了,若果监视别的窗体的话,用SPY++ 找到句柄,配合FindWindowEx,SendMessage根启胡据其属性做

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

ShellAndWait("Notepad.exe")

MessageBox.Show("笔记本被关袜液闭后我才会出现")

End Sub

End Class

窗体代码:Private Sub Form_Load()

Do: CL.Add 0: Loop While CL.Count <100

Set DRW.PictureBox = PIC1

Set DRW.DataCollection = CL

DRW.PicBackground = vbBlack

DRW.PicForeground = vbGreen

DRW.BorderColor = vbRed

DRW.BorderSize = 0

DRW.GridColor = &H808000

DRW.GridVisible = True

LastMoment = Now

LastLogged = Now

LoggingInterval = 60

Set m_objIpHelper = New CIpHelper

Dim a As Long

For a = 1 To m_objIpHelper.Interfaces.Count

cboConnectionType.AddItem m_objIpHelper.Interfaces(a).InterfaceDescription &" "

Next

If Val(GetSetting(App.Title, "Setting", "Connection", 0)) + 1 <= cboConnectionType.ListCount Then

cboConnectionType.ListIndex = Val(GetSetting(App.Title, "Setting", "Connection", 0))

Else

cboConnectionType.ListIndex = 0

End If

End SubPrivate Sub Timer1_Timer()

If DownloadSpeedTop <>0 Then

DownloadSpeedTop = 0

UploadSpeedTop = 0

Else

Timer1.Enabled = False

End If

End SubPrivate Sub tmrUpdate_Timer()

On Error Resume Next'If DateDiff("s", LastMoment, Now) <1 Then Exit SubtmrUpdate.Enabled = False

Dim objInterface As CInterface

Set objInterface = m_objIpHelper.Interfaces(cboConnectionType.ListIndex + 1)lblType = m_objIpHelper.Interfaces(cboConnectionType.ListIndex + 1).InterfaceDescription &" "Dim BytesRecv As Long, BytesSent As Long

BytesRecv = m_objIpHelper.BytesReceived

BytesSent = m_objIpHelper.BytesSentDoEvents

Dim DS As Long, US As Long

DS = BytesRecv - LastRecvBytes

US = BytesSent - LastSentBytes

If DownloadSpeedTop <DS Then DownloadSpeedTop = DS

If UploadSpeedTop <US Then UploadSpeedTop = US

DoEventslblRecv.Caption = Format(BytesRecv / 1024, "###,###,###,###,##0 KB")

lblSent.Caption = Format(BytesSent / 1024, "###,###,###,###,##0 KB")DownloadSpeedAverage = (DownloadSpeedAverage + DS) / 2

UploadSpeedAverage = (UploadSpeedAverage + US) / 2

lblDownloadSpeedTop = "下载速率: " &Format(DownloadSpeedTop / 1024, "###,###,###,###,#0.#0 Kb/S")

lblUploadSpeedTop = "上载速率: " &Format(UploadSpeedTop / 1024, "###,###,###,###,#0.#0 Kb/S")

lblDownloadSpeedAverage = "平均下载速率: " &Format(DownloadSpeedAverage / 1024, "###,###,###,###,#0.#0 Kb/S")

lblUploadSpeedAverage = "平均上载速率: " &Format(UploadSpeedAverage / 1024, "###,###,###,###,#0.#0 Kb/S")'Me.Caption = lblDownloadSpeedTop.Caption &vbNewLine &_

lblUploadSpeedTop.Caption &vbNewLine &_

lblDownloadSpeedAverage.Caption &vbNewLine &_

lblUploadSpeedAverage.Caption

CL.Add Int(Format(DownloadSpeedAverage / 1024, "###,###,###,###,#0.#0")) + 5

DRW.DrawIf DS / 1024 <1 Then

lblDSpeed = Format(DS, "0 BS ")

Else

lblDSpeed = Format(DS / 1024, "0.#0 KBS ")

End If

If US / 1024 <1 Then

lblUSpeed = Format(US, "0 BS ")

Else

lblUSpeed = Format(US / 1024, "0.#0 KBS ")

End IfLastRecvBytes = BytesRecv

LastSentBytes = BytesSent

LastMoment = NowIf m_objIpHelper.Interfaces.Count <>cboConnectionType.ListCount Then

Dim a As Long

cboConnectionType.Clear

For a = 1 To m_objIpHelper.Interfaces.Count

cboConnectionType.AddItem m_objIpHelper.Interfaces(a).InterfaceDescription &" "

Next

If Val(GetSetting(App.Title, "Setting", "Connection", 0)) + 1 <= cboConnectionType.ListCount Then

cboConnectionType.ListIndex = Val(GetSetting(App.Title, "Setting", "Connection", 0))

Else

cboConnectionType.ListIndex = 0

End If

End If

tmrUpdate.Enabled = True

End Sub还有些类模块 你加我QQ发给你 这个字数限制了的

有什么问题?请HI我!

--------------------

控件:3个命令按钮、一个图片框

Private Declare Function capCreateCaptureWindow Lib "avicap32.dll" _

Alias "capCreateCaptureWindowA" ( _

ByVal lpszWindowName As String, _

ByVal dwStyle As Long, _

ByVal x As Long, _

ByVal y As Long, _

ByVal nWidth As Long, _

ByVal nHeight As Long, _

ByVal hWndParent As Long, _

ByVal nID As Long) As Long

Private Const WS_CHILD = &H40000000

Private Const WS_VISIBLE = &H10000000

Private Const WM_USER = &H400

Private Const WM_CAP_START = &H400

Private Const WM_CAP_EDIT_COPY = (WM_CAP_START + 30)

Private Const WM_CAP_DRIVER_CONNECT = (WM_CAP_START + 10)

Private Const WM_CAP_SET_PREVIEWRATE = (WM_CAP_START + 52)

Private Const WM_CAP_SET_OVERLAY = (WM_CAP_START + 51)

Private Const WM_CAP_SET_PREVIEW = (WM_CAP_START + 50)

Private Const WM_CAP_DRIVER_DISCONNECT = (WM_CAP_START + 11)

Private Declare Function SendMessage Lib "user32" _

Alias "SendMessageA" ( _

ByVal hwnd As Long, _

ByVal wMsg As Long, _

ByVal wParam As Long, _

lParam As Any) As Long

Private Preview_Handle As Long

Private Function CreateCaptureWindow( _

hWndParent As Long, _

Optional x As Long = 0, _

Optional y As Long = 0, _

Optional nWidth As Long = 320, _

Optional nHeight As Long = 240, _

Optional nCameraID As Long = 0) As Long

Preview_Handle = capCreateCaptureWindow("Video", _

WS_CHILD + WS_VISIBLE, x, y, _

nWidth, nHeight, hWndParent, 1)

SendMessage Preview_Handle, WM_CAP_DRIVER_CONNECT, nCameraID, 0

SendMessage Preview_Handle, WM_CAP_SET_PREVIEWRATE, 30, 0

SendMessage Preview_Handle, WM_CAP_SET_OVERLAY, 1, 0

SendMessage Preview_Handle, WM_CAP_SET_PREVIEW, 1, 0

CreateCaptureWindow = Preview_Handle

End Function

Private Function CapturePicture(nCaptureHandle As Long) As StdPicture

Clipboard.Clear

SendMessage nCaptureHandle, WM_CAP_EDIT_COPY, 0, 0

Set CapturePicture = Clipboard.GetData

End Function

Private Sub Disconnect(nCaptureHandle As Long, _

Optional nCameraID = 0)

SendMessage nCaptureHandle, WM_CAP_DRIVER_DISCONNECT, _

nCameraID, 0

End Sub

Dim Video_Handle As Long

Private Sub Command2_Click()

Video_Handle = CreateCaptureWindow(PicCapture.hwnd, , , Me.PicCapture.Width, Me.PicCapture.Height)

End Sub

Private Sub Command1_Click()

Dim x As StdPicture

Set x = CapturePicture(Video_Handle)

SavePicture x, App.Path &"\a.bmp"

End Sub

Private Sub Command3_Click()

Disconnect Video_Handle

End Sub

Private Sub Form_Resize()

Me.PicCapture.Width = Me.Width - 400

Me.PicCapture.Height = Me.Height - 1400

Me.PicCapture.Refresh

End Sub

Private Sub Form_Unload(Cancel As Integer)

Disconnect Video_Handle

End Sub


欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/yw/12337548.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-24
下一篇 2023-05-24

发表评论

登录后才能评论

评论列表(0条)

保存