⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmmain.frm

📁 B6 And Windows
💻 FRM
📖 第 1 页 / 共 3 页
字号:
        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 + -