6、用vb6写一个仿照SPY++的东西,供大家参考学习用

用以学习EnumWindowsProc、SendMessage、WindowFromPoint、WindowFromPoint、ShowWindow、EnableWindow、FindWindow等等API的用法

共有3个窗体,分别为form1,form2,form3,和一个模块Module1

form1代码:form1有label(0~5)标签,text1、text2.。。。text5等5个textbox

Private Sub Form_Load()
    Success = SetWindowPos(Me.hwnd,-1,3)
    Me.Left = Screen.Width - 1900
    Me.Top = Screen.Height - 1710
End Sub


Private Sub Form_Unload(Cancel As Integer)
    End
End Sub



Private Sub Label1_MouseUp(Index As Integer,Button As Integer,Shift As Integer,x As Single,y As Single)
    If Button And 2 Then PopupMenu Form3.tfile
End Sub




Private Sub Timer1_Timer()

If GetAsyncKeyState(vbKeyF2) Then
    Form2.ListView1.ListItems.Clear
    EnumChildWindows Text1.Text,AddressOf EnumWindowsProc,ByVal 0&
    Form2.Show
End If
If GetAsyncKeyState(vbKeyF3) Then
    Clipboard.Clear
    Clipboard.SetText Text4.Text
    MsgBox "窗口标题已保存至剪贴板。",vbOKOnly,"提示"
End If
    
    Static lX As Long,lY As Long,stayTime As Long
    On Local Error Resume Next
    Dim P As POINTAPI,h As Long,hD As Long,r As Long
    GetCursorPos P

    lX = P.x: lY = P.y
    Px.x = P.x
    Px.y = P.y
    
'设备环境是一个结构,它定义了一系列图形对象及其相关的属性,以及会影响输出结果的绘图方式。这些图形对象包括:画笔(用于画直线),
'笔刷(用于绘图和填充),位图(用于屏幕的拷贝或滚动),调色板(用于定义可用的颜色集),剪裁区(用于剪裁和其他操作),路径(用
'于绘图和画图操作)。设备环境函数用于对设备环境进行创建、删除或获取信息
    h = WindowFromPoint(lX,lY) '取得点所在控件的句柄
    hD = GetDC(h)
    ScreenToClient h,P
    r = GetPixel(hD,P.x,P.y)
    ReleaseDC h,hD
    Text1.Text = h
    Text2.Text = hD
    Text3.Text = Hex(r)
    Text3.BackColor = r
    
    
    Dim WindowText As String,ClassName As String
    WindowText = String(64,0)
    GetWindowText Text1.Text,WindowText,Len(WindowText)
    ClassName = String(64,0)
    GetClassName Text1.Text,ClassName,64
    Text4.Text = Left(WindowText,InStr(1,vbNullChar) - 1)
    Text5.Text = Left(ClassName,vbNullChar) - 1)

End Sub


form2代码:form2只有一个listview1控件

Private Sub ListView1_MouseUp(Button As Integer,y As Single)
If Trim(ListView1.SelectedItem.ListSubItems(2).Text) = "可用" Then
   Form3.tenable = False
   Form3.tdisable = True
Else
   Form3.tenable = True
   Form3.tdisable = False
End If

If Trim(ListView1.SelectedItem.ListSubItems(3).Text) = "可见" Then
   Form3.tshow = False
   Form3.thide = True
Else
   Form3.tshow = True
   Form3.thide = False
End If

If Button And 2 Then PopupMenu Form3.tedit
End Sub


form3是菜单,无控件,菜单内容请看代码:

Private Sub tdisable_Click()
  Dim i As Long
  i = EnableWindow(Form2.ListView1.SelectedItem.Text,0)  '第2参非0即为ENABLE
  Form2.ListView1.SelectedItem.ListSubItems(2).Text = "禁用"
End Sub

Private Sub tenable_Click()
  Dim i As Long
  Dim s As String
  i = EnableWindow(Form2.ListView1.SelectedItem.Text,1)  '第2参非0即为ENABLE
  Form2.ListView1.SelectedItem.ListSubItems(2).Text = "可用"
End Sub

Private Sub tshow_Click()
  Dim i As Long
  i = ShowWindow(Form2.ListView1.SelectedItem.Text,1)  '第2参非0即为ENABLE
  Form2.ListView1.SelectedItem.ListSubItems(3).Text = "可见"
End Sub

Private Sub thide_Click()
  Dim i As Long
  i = ShowWindow(Form2.ListView1.SelectedItem.Text,0)  '第2参非0即为ENABLE
  Form2.ListView1.SelectedItem.ListSubItems(3).Text = "隐藏"
End Sub

Private Sub tquit_Click()
End
End Sub


Private Sub tunlock_Click()

Const WM_USER = &H400
Const EM_SETREADONLY = (WM_USER + 31)



  Dim i As Long
  i = SendMessage(Form2.ListView1.SelectedItem.Text,EM_SETREADONLY,True,ByVal 0&)

End Sub


module1的代码:

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String,ByVal lpWindowName As String) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long,ByVal hdc As Long) As Long
Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long,ByVal x As Long,ByVal y As Long) As Long
Public Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long,lpPoint As POINTAPI) As Long
Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long,ByVal yPoint As Long) As Long

Public Declare Function SetWindowPos Lib "user32" (ByVal h&,ByVal hb%,ByVal x%,ByVal y%,ByVal cx%,ByVal cy%,ByVal f%) As Integer
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long,ByVal lpString As String,ByVal cch As Long) As Long
Public Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long,ByVal lpClassName As String,ByVal nMaxCount As Long) As Long
Public Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long,ByVal lpEnumFunc As Long,ByVal lParam As Long) As Long
Public Declare Function IsWindowEnabled Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long

Public Declare Function EnableWindow Lib "user32" (ByVal hwnd As Long,ByVal fEnable As Long) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long,ByVal nCmdShow As Long) As Long

Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long,ByVal wMsg As Long,ByVal wParam As Long,lParam As Any) As Long

'截获热键
Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vkey As Long) As Integer

Public Type POINTAPI
x As Long
y As Long
End Type


Public Function EnumWindowsProc(ByVal hnd As Long,ByVal lParam As Long) As Boolean
    Dim sSave As String,Ret As Long
    
    Dim isEnabled As Boolean,IsEn As String
    Dim isVisable As Boolean,IsVi As String
    
    isEnabled = IsWindowEnabled(hnd)
    isVisable = IsWindowVisible(hnd)
    
    If isEnabled = True Then
       IsEn = "  可用"
    Else
       IsEn = "  禁用"
    End If
    
    If isVisable = True Then
       IsVi = "  可见"
    Else
       IsVi = "  隐藏"
    End If
      
    Ret = GetWindowTextLength(hnd)
    sSave = Space(Ret)
    GetWindowText hnd,sSave,Ret + 1
    
    Dim ClassName As String
    ClassName = String(64,0)
    GetClassName hnd,64
    ClassName = Left(ClassName,vbNullChar) - 1)
    
    
    Dim ListTemp As Variant
      Set ListTemp = Form2.ListView1.ListItems.Add(,hnd)
      ListTemp.SubItems(1) = sSave
      ListTemp.SubItems(2) = IsEn
      ListTemp.SubItems(3) = IsVi
      ListTemp.SubItems(4) = ClassName
    
    EnumWindowsProc = True '=true继续列举到结束,=false则停止列举
    
End Function


仅供大家参考学习,偶尔用于解除某些软件中按钮的限制,呵呵,当然不要报太大希望,人家都有防止此类情况的措施的。

代码下载链接:http://download.csdn.net/detail/icbyboy/5005114

版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。

相关推荐


Format[$] ( expr [ , fmt ] ) format 返回变体型 format$ 强制返回为文本 -------------------------------- 数字类型的格式化 --------------------------------     固定格式参数:     General Number 普通数字,如可以用来去掉千位分隔号     format$("100,1
VB6或者ASP 格式化时间为 MM/dd/yyyy 格式,竟然没有好的办法, Format 或者FormatDateTime 竟然结果和系统设置的区域语言的日期和时间格式相关。意思是尽管你用诸如 Format(Now, "MM/dd/yyyy"),如果系统的设置格式区域语言的日期和时间格式分隔符是"-",那他还会显示为 MM-dd-yyyy     只有拼凑: <%response.write
在项目中添加如下代码:新建窗口来显示异常信息。 Namespace My ‘全局错误处理,新的解决方案直接添加本ApplicationEvents.vb 到工程即可 ‘添加后还需要一个From用来显示错误。如果到这步还不会则需要先打好基础啦 ‘======================================================== ‘以下事件
转了这一篇文章,原来一直想用C#做k3的插件开发,vb没有C#用的爽呀,这篇文章写与2011年,看来我以前没有认真去找这个方法呀。 https://blog.csdn.net/chzjxgd/article/details/6176325 金蝶K3 BOS的插件官方是用VB6编写的,如果  能用.Net下的语言工具开发BOS插件是一件很愉快的事情,其中缘由不言而喻,而本文则是个人首创,实现在了用V
Sub 分列() ‘以空格为分隔符,连续空格只算1个。对所选中的单元格进行处理 Dim m As Range, tmpStr As String, s As String Dim x As Integer, y As Integer, subStr As String If MsgBox("确定要分列处理吗?请确定分列的数据会覆盖它后面的单元格!", _
  窗体代码 1 Private Sub Text1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) 2 Dim path As String, hash As String 3 For Each fil
  Imports MySql.Data.MySqlClient Public Class Form1 ‘ GLOBAL DECLARATIONS Dim conString As String = "Server=localhost;Database=net2;Uid=root;Pwd=123456;" Dim con As New MySqlConnection
‘導入命名空間 Imports ADODB Imports Microsoft.Office.Interop   Private Sub A1() Dim Sql As String Dim Cnn As New ADODB.Connection Dim Rs As New ADODB.Recordset Dim S As String   S = "Provider=OraOLEDB.Oracl
Imports System.IO Imports System.Threading Imports System.Diagnostics Public Class Form1 Dim A(254) As String    Function ping(ByVal IP As Integer) As String Dim IPAddress As String IPAddress = "10.0.
VB运行EXE程序,并等待其运行结束 参考:https://blog.csdn.net/useway/article/details/5494084 Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long Pr
今天碰到一个问题,登陆的时候,如果不需要验证手机号为空,则不去验证手机号 因为登陆的时候所有的验证信息都存放在一个数组里 Dim CheckUserInfo() As String ={UserBirthday, SecEmail, UserMob, UserSex, RealNameFirst, RealName, CheckCardID, CheckCardType, Contactemail
在VB6.0中,数据访问接口有三种: 1、ActiveX数据对象(ADO) 2、远程数据对象(RDO) 3、数据访问对象(DAO) 1.使用ADO(ActiveX Data Objec,ActiveX数据对象)连接SQL Server 1)使用ADO控件连接 使用ADO控件的ConnectionString属性就可以连接SQL Server,该属性包含一个由分号分隔的argument=value语
注:大家如果没有VB6.0的安装文件,可自行百度一下下载,一般文件大小在200M左右的均为完整版的软件,可以使用。   特别提示:安装此软件的时候最好退出360杀毒软件(包括360安全卫士,电脑管家等,如果电脑上有这些软件的话),因为现如今的360杀毒软件直接会对VB6.0软件误报,这样的话就可能会在安装过程中被误报阻止而导致安装失败,或者是安装后缺乏很多必须的组件(其它的杀毒软件或安全卫士之类的
Private Sub Form_Load() Call conndb End Sub Private Function conndb() Dim cn As New ADODB.Connection Dim rs As New ADODB.Recordset Dim strCn, sql As String Dim db_host As String Dim db_user As String
  PPSM06S70:  Add  moddate  EDITSPRINTJOB:  MAX(TO_CHAR(ETRN.MODDATE, ‘yyyy/mm/dd/HH24:MI AM‘)) ACTUAL_SHIPDATE   4.Test Scenario (1) :Query SQL Test DN:8016578337 SELECT CTRN.TKCTID TRUCK_ID,        
  沒有出現CrystalReportViewer時,須安裝CRforVS_13_0. 新增1個數據集,新增1個數據表,添加二列,列名要和資料庫名一樣. 修改目標Framework 修改app.config, <startup >改成<startup useLegacyV2RuntimeActivationPolicy ="true">  CrystalReport1.rpt增加數據庫專家 在表單
Imports System.Threading Imports System Public Class Form1 Dim th1, th2 As Thread Public Sub Method1() Dim i As Integer For i = 1 To 100 If Me.Label1.BackColor =
Friend Const PROCESS_ALL_ACCESS = &H1F0FFF = 2035711 Friend Const PROCESS_VM_READ = &H10 Friend Const PROCESS_VM_WRITE = &H20 Friend Const PAGE_READONLY = &H2 Friend Const PAGE_READWRITE = &H4 Friend
以下代码随手写的 并没有大量测试 效率也有待提升 如果需要C#的请自行转换 Function SplitBytes(Data As Byte(), Delimiter As Byte()) As List(Of Byte()) Dim i = 0 Dim List As New List(Of Byte()) Dim bytes As New
Imports System.Data.SqlClient Public Class Form1 REM Public conn1 As SqlConnection = New SqlConnection("server=.; Integrated Security=False;Initial Catalog= mydatabase1; User ID= sa;password")