📄 frmmain.frm
字号:
Me.Width = 5580
' And set button caption
cmdProcess.Caption = "Process ->"
End If
End Sub
Private Sub cmdCopy_Click()
Dim sText As String
' Setup window information's
sText = sText & "Window Handle: " & txthWnd.Text & vbCrLf
sText = sText & "Window Caption: " & txtTitle.Text & vbCrLf
sText = sText & "Window Class: " & txtClass.Text & vbCrLf
sText = sText & "Window Style: " & txtStyle.Text & vbCrLf
sText = sText & "Rectangle: " & txtRect.Text & vbCrLf
sText = sText & "Parent Handle: " & txtParent.Text & vbCrLf
sText = sText & "Parent Caption: " & txtParentText.Text & vbCrLf
sText = sText & "Parent Class: " & txtParentClass.Text & vbCrLf
' Clear clipboard
Clipboard.Clear
' Copy text to clipboard
Clipboard.SetText sText
End Sub
Private Sub cmdMemInfo_Click()
' Remove window from top
SetWindowPos Me.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
chkOnTop.Value = 0
frmMemInfo.Show , Me
End Sub
Private Sub cmdAbout_Click()
' Remove window from top
SetWindowPos Me.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
chkOnTop.Value = 0
' Show about box
frmAbout.Show vbModal
End Sub
Private Sub cmdClose_Click()
' Close program
Unload Me
End Sub
Private Sub cmdCodeGeneration_Click()
' Remove window from top
SetWindowPos Me.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
chkOnTop.Value = 0
frmCGWizard.Show , Me
End Sub
'////////////////////////////////////////////////////////////////////
'//// FORM EVENTS
'////////////////////////////////////////////////////////////////////
Private Sub Form_Load()
' Set form width to default width (without process)
Me.Width = 5580
' Make textboxes flat
MakeFlat txthWnd.hwnd
MakeFlat txtTitle.hwnd
MakeFlat txtClass.hwnd
MakeFlat txtRect.hwnd
MakeFlat txtParent.hwnd
MakeFlat txtParentText.hwnd
MakeFlat txtParentClass.hwnd
MakeFlat txtStyle.hwnd
MakeFlat txtMhWnd.hwnd
' Get value from registry
If GetSetting("EliteSpy+", "Settings", "AlwaysOnTop", "0") = "1" Then
' Put window on top of all others
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
Me.chkOnTop.Value = 1
End If
' Enumerate open processes
EnumProcess
Label9_Click
Label10_Click
End Sub
Private Sub Label10_Click()
Frame2.ZOrder 0
Label9.BackColor = &HC0C0C0
Label10.BackColor = &HE0E0E0
End Sub
Private Sub Label9_Click()
Frame1.ZOrder 0
Frame2.ZOrder 1
Label10.BackColor = &HC0C0C0
Label9.BackColor = &HE0E0E0
End Sub
Private Sub lstProcess_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
PopupMenu Mnufile
End If
End Sub
Private Sub lstProcessSystem_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
PopupMenu Mnufile2
End If
End Sub
Private Sub Mnu2FileProps_Click()
Dim sFileName As String
sFileName = lstProcessSystem.Text
If Len(Dir(sFileName)) = 0 Then
MsgBox "File : " & sFileName & " cannot be found"
Exit Sub
End If
DisplayFileProperties sFileName
End Sub
Private Sub Mnu2StopProgram_Click()
Dim theString As String
Dim TheString2 As String
TheString2 = lstProcessSystem.Text
theString = Mid(TheString2, InStrRev(TheString2, "\", -1) + 1, Len(TheString2))
If MsgBox("Are you sure you wish to terminate """ & theString & """, it could cause adverse effects untill you restart your computer", vbOKCancel, "Terminate a system process") = vbOK Then
EnumProcess lstProcessSystem.List(lstProcessSystem.ListIndex)
End If
End Sub
Private Sub MnuFileProps_Click()
Dim sFileName As String
sFileName = lstProcess.Text
If Len(Dir(sFileName)) = 0 Then
MsgBox "File : " & sFileName & " cannot be found"
Exit Sub
End If
DisplayFileProperties sFileName
End Sub
Private Sub MnuStopProgram_Click()
EnumProcess lstProcess.List(lstProcess.ListIndex)
End Sub
'////////////////////////////////////////////////////////////////////
'//// CROSSHAIR EVENTS
'////////////////////////////////////////////////////////////////////
Private Sub picCrossHair_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
' If user pressed left mouse button and we are not dragging
If Button = vbLeftButton And Not m_bDragging Then
' Set dragging flag to true
m_bDragging = True
' Set mouse pointer
Me.MouseIcon = imgCursor.MouseIcon
Me.MousePointer = 99
' Erase picture from picCrossHair
picCrossHair.Picture = Nothing
End If
End Sub
Private Sub picCrossHair_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
' If user pressed left mouse button and we are dragging
If Button = vbLeftButton And m_bDragging Then
Dim tPA As POINTAPI
Dim lhWnd As Long
Dim sTitle As String * 255
Dim sClass As String * 255
Dim tRC As RECT
Dim sParentTitle As String * 255
Dim sParentClass As String * 255
Dim lhWndParent As Long
Dim sStyle As String
Dim lRetVal As Long
' Get cursor position
GetCursorPos tPA
' Get window handle from point
lhWnd = WindowFromPoint(tPA.X, tPA.Y)
' Get window caption
lRetVal = GetWindowText(lhWnd, sTitle, 255)
' Get window class name
lRetVal = GetClassName(lhWnd, sClass, 255)
' Get window style
sStyle = GetWindowStyle(lhWnd)
' Get window rect
GetWindowRect lhWnd, tRC
' Get window parent
lhWndParent = GetParent(lhWnd)
' Get parent window caption
lRetVal = GetWindowText(lhWndParent, sParentTitle, 255)
' Get parent window class name
lRetVal = GetClassName(lhWndParent, sParentClass, 255)
' Set values to textboxes
txthWnd.Text = lhWnd
txtTitle.Text = sTitle
txtClass.Text = sClass
txtStyle.Text = sStyle
txtRect.Text = "(" & tRC.Left & ", " & tRC.Top & ") - (" & tRC.Right & ", " & tRC.Bottom & ")"
txtParent.Text = lhWndParent
txtParentText.Text = sParentTitle
txtParentClass.Text = sParentClass
txtMhWnd.Text = lhWnd
End If
End Sub
Private Sub picCrossHair_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
' If user pressed left mouse button and we are dragging
If Button = vbLeftButton And m_bDragging Then
' Set dragging flag to true
m_bDragging = False
' Restore mouse pointer to normal (arrow)
Me.MousePointer = vbNormal
' Load picture into picCrossHair
picCrossHair.Picture = imgCursor.MouseIcon
End If
End Sub
'////////////////////////////////////////////////////////////////////
'//// PRIVATE FUNCTIONS
'////////////////////////////////////////////////////////////////////
' Get window styles
Private Function GetWindowStyle(ByVal lhWnd As Long) As String
Dim lStyle As Long
' Get window styles
lStyle = GetWindowLong(lhWnd, GWL_STYLE)
' Get window styles
If lStyle And WS_BORDER Then GetWindowStyle = GetWindowStyle & "WS_BORDER "
If lStyle And WS_CAPTION Then GetWindowStyle = GetWindowStyle & "WS_CAPTION "
If lStyle And WS_CHILD Then GetWindowStyle = GetWindowStyle & "WS_CHILD "
If lStyle And WS_CLIPCHILDREN Then GetWindowStyle = GetWindowStyle & "WS_CLIPCHILDREN "
If lStyle And WS_CLIPSIBLINGS Then GetWindowStyle = GetWindowStyle & "WS_CLIPSIBLINGS "
If lStyle And WS_DLGFRAME Then GetWindowStyle = GetWindowStyle & "WS_DLGFRAME "
If lStyle And WS_GROUP Then GetWindowStyle = GetWindowStyle & "WS_GROUP "
If lStyle And WS_HSCROLL Then GetWindowStyle = GetWindowStyle & "WS_HSCROLL "
If lStyle And WS_MAXIMIZEBOX Then GetWindowStyle = GetWindowStyle & "WS_MAXIMIZEBOX "
If lStyle And WS_MINIMIZEBOX Then GetWindowStyle = GetWindowStyle & "WS_MINIMIZEBOX "
If lStyle And WS_SYSMENU Then GetWindowStyle = GetWindowStyle & "WS_SYSMENU "
If lStyle And WS_POPUPWINDOW Then GetWindowStyle = GetWindowStyle & "WS_POPUPWINDOW "
If lStyle And WS_TABSTOP Then GetWindowStyle = GetWindowStyle & "WS_TABSTOP "
If lStyle And WS_THICKFRAME Then GetWindowStyle = GetWindowStyle & "WS_THICKFRAME "
If lStyle And WS_VISIBLE Then GetWindowStyle = GetWindowStyle & "WS_VISIBLE "
If lStyle And WS_VSCROLL Then GetWindowStyle = GetWindowStyle & "WS_VSCROLL "
End Function
' Make textboxes flat
Private Sub MakeFlat(lhWnd As Long)
Dim lStyle As Long
' Get window style
lStyle = GetWindowLong(lhWnd, GWL_EXSTYLE)
' Setup window styles
lStyle = lStyle And Not WS_EX_CLIENTEDGE Or WS_EX_STATICEDGE
' Set window style
SetWindowLong lhWnd, GWL_EXSTYLE, lStyle
RemoveBorder lhWnd
End Sub
Private Sub RemoveBorder(lhWnd As Long)
Dim lStyle As Long
' Get window style
lStyle = GetWindowLong(lhWnd, GWL_STYLE)
' Setup window styles
lStyle = lStyle And Not (WS_BORDER Or WS_DLGFRAME Or WS_CAPTION Or WS_BORDER Or WS_SIZEBOX Or WS_THICKFRAME)
' Set window style
SetWindowLong lhWnd, GWL_STYLE, lStyle
' Update window
SetWindowPos lhWnd, 0, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_NOZORDER Or SWP_FRAMECHANGED Or SWP_NOSIZE Or SWP_NOMOVE
End Sub
' Get current mouse cordinates
Private Sub Timer1_Timer()
Dim tPA As POINTAPI
' Get cursor cordinates
GetCursorPos tPA
' Set label caption to cursor cordinates
lblCordi.Caption = "X: " & tPA.X & " Y: " & tPA.Y
End Sub
' Enumerate open processes
Private Sub EnumProcess(Optional ByVal sExeName As String = "")
Dim lSnapShot As Long
Dim lNextProcess As Long
Dim tPE As PROCESSENTRY32
lstProcessSystem.Clear
' Create snapshot
lSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)
If lSnapShot <> -1 Then
' Clear list
lstProcess.Clear
' Length of the structure
tPE.dwSize = Len(tPE)
' Find first process
lNextProcess = Process32First(lSnapShot, tPE)
Do While lNextProcess
' Found specified process
If sExeName = Left$(tPE.szExeFile, Len(sExeName)) And Len(sExeName) > 0 Then
Dim lProcess As Long
Dim lExitCode As Long
' Open process
lProcess = OpenProcess(0, False, tPE.th32ProcessID)
' Terminate process
TerminateProcess lProcess, lExitCode
' Close handle
CloseHandle lProcess
Else
' Add exe to list
Select Case Mid(Trim(tPE.szExeFile), 19, 7)
Case "SYSTRAY"
lstProcessSystem.AddItem tPE.szExeFile
Case "KERNEL3"
lstProcessSystem.AddItem tPE.szExeFile
Case "SPOOL32"
lstProcessSystem.AddItem tPE.szExeFile
Case "HIDSERV"
lstProcessSystem.AddItem tPE.szExeFile
Case "MSGSRV3"
lstProcessSystem.AddItem tPE.szExeFile
Case "MPREXE."
lstProcessSystem.AddItem tPE.szExeFile
Case "mmtask."
lstProcessSystem.AddItem tPE.szExeFile
Case "DDHELP."
lstProcessSystem.AddItem tPE.szExeFile
Case "RPCSS.E"
lstProcessSystem.AddItem tPE.szExeFile
'C:\WINDOWS\SYSTEM\MDM.EXE
'0000000001111111111222222222
'1234567890123456789012345678
Case Else
If Mid(Trim(tPE.szExeFile), 12, 8) = "EXPLORER" Or Mid(Trim(tPE.szExeFile), 12, 7) = "TASKMON" Then
lstProcessSystem.AddItem tPE.szExeFile
Else
lstProcess.AddItem tPE.szExeFile
End If
End Select
End If
' Get next process
lNextProcess = Process32Next(lSnapShot, tPE)
Loop
' Close handle
CloseHandle (lSnapShot)
Else
lstProcess.AddItem "Cannot enumerate running process!"
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -