广告

SPY++ V2.4 VB源码

源码下载:即得下载 云下载 115下载 千脑下载

 1

FORMMAIN

101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
Option Explicit
 
Dim IsDragging As Boolean
Dim SnapHwnd&
Dim DeskHwnd&, DeskDC&
Dim oldRop2&
Dim rc As RECT
 
Private Function SetOnTop(ByVal hwnd As Long, ByVal IsOnTop As Integer)
    Dim rtn As Long
    If IsOnTop = 1 Then
        '将窗口置于最上面
        rtn = SetWindowPos(hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
    Else
        rtn = SetWindowPos(hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
    End If
End Function
 
Private Sub chkAlwaysOnTop_Click()
    SetOnTop frmMain.hwnd, chkAlwaysOnTop.Value
End Sub
 
Private Sub cmdAbout_Click()
    Dim msg$, rtn&
    msg$ = "Spy Lite 2.0 版权所有(C) 2000-2006 2006.10.31" & vbCrLf & _
"作者:阿珊境界 VB群:12960265 VC群:713035" & vbCrLf & _
"作者主页:http://www.asanscape.com 点击确定打开主页。"
 
    rtn = MsgBox(msg$, vbOKCancel + vbInformation, "AsanScape")
    If rtn = vbOK Then
        ShellExecute 0&, vbNullString, "http://www.AsanScape.com", vbNullString, vbNullString, vbNormalFocus
 
    End If
 
End Sub
 
Private Sub cmdOK_Click()
    '    Unload Me
    End
End Sub
 
Private Sub CmdSave_Click()
    With cdlg
        .Filter = "位图文件(*.BMP)|*.BMP"
        .Action = 2
        If .FileName = "" Then Exit Sub
        If Dir(.FileName) <> "" Then
            If MsgBox("文件" & .FileTitle & "已经存在,是否替换?", vbInformation + vbYesNo + vbDefaultButton2, "提示") = vbNo Then
                Exit Sub
            End If
        End If
        SavePicture Picture2.Image, .FileName
    End With
End Sub
 
Private Sub Form_Load()
    chkAlwaysOnTop.Value = 1                                                    '使默认值为选中
    chkHex.Value = 0
    SetOnTop frmMain.hwnd, chkAlwaysOnTop.Value
    IsDragging = False
End Sub
 
Private Sub HScroll1_Scroll()
    Picture2.Left = (-1) * HScroll1.Value
End Sub
 
Private Sub picShot_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    tmr.Enabled = False                                                         '让闪烁的矩形消失
    If IsDragging = True Then
        Screen.MousePointer = vbDefault
        IsDragging = False
        ReleaseCapture
 
        If SnapHwnd& = 0 Then Exit Sub
 
        Call Fulfill
        picShot.Picture = Image3.Picture
    End If
End Sub
 
Private Sub lblPreHandle_Click()
    If txtPreHandle.Text = "0" Or txtPreHandle.Text = "" Then Exit Sub
    If chkAlwaysOnTop.Value = 1 Then
        SnapHwnd& = Val("&H" & txtPreHandle)
    Else
        SnapHwnd& = Val(txtPreHandle)
    End If
    Call Fulfill
End Sub
Private Sub lblNextHandle_Click()
    If txtNextHandle.Text = "0" Or txtNextHandle.Text = "" Then Exit Sub
    If chkAlwaysOnTop.Value = 1 Then
        SnapHwnd& = Val("&H" & txtNextHandle)
    Else
        SnapHwnd& = Val(txtNextHandle)
    End If
    Call Fulfill
End Sub
Private Sub lblParentHandle_Click()
    If txtParentHandle.Text = "0" Or txtParentHandle.Text = "" Then Exit Sub
    If chkAlwaysOnTop.Value = 1 Then
        SnapHwnd& = Val("&H" & txtParentHandle)
    Else
        SnapHwnd& = Val(txtParentHandle)
    End If
    Call Fulfill
End Sub
Private Sub lblChildHandle_Click()
    If txtChildHandle.Text = "0" Or txtChildHandle.Text = "" Then Exit Sub
    If chkAlwaysOnTop.Value = 1 Then
        SnapHwnd& = Val("&H" & txtChildHandle)
    Else
        SnapHwnd& = Val(txtChildHandle)
    End If
    Call Fulfill
End Sub
 
Private Sub lstStatus_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'写在此事件中是为了只有鼠标点击时才反应。否则,当窗体样式被读入List时也会发生Click事件
'使用Select Case语句是为了不让所有列表项都过一遍,而是只针对改动的项
    Select Case lstStatus.ListIndex
    Case 0:
        If lstStatus.Selected(0) = True Then
            ShowWindow SnapHwnd, SW_SHOW
        Else
            ShowWindow SnapHwnd, SW_HIDE
        End If
    Case 1:
        If lstStatus.Selected(1) = True Then
            ' SendMessage SnapHwnd&, WM_ENABLE, 0, vbNullString
            EnableWindow SnapHwnd, True
        Else
            EnableWindow SnapHwnd, False
        End If
    Case 2:
        If lstStatus.Selected(2) = True Then
            SetOnTop SnapHwnd, 1
        Else
            SetOnTop SnapHwnd, 0
        End If
 
    Case 3:
        If lstStatus.Selected(3) = True Then
            SendMessage SnapHwnd, EM_SETREADONLY, True, 0
        Else
            SendMessage SnapHwnd, EM_SETREADONLY, False, 0
        End If
    Case 4:
        If lstStatus.Selected(4) = True Then
            ShowWindow SnapHwnd, SW_MAXIMIZE
            lstStatus.Selected(5) = False
        Else
            ShowWindow SnapHwnd, SW_RESTORE
        End If
    Case 5:
 
        If lstStatus.Selected(5) = True Then
            ShowWindow SnapHwnd, SW_MINIMIZE
            lstStatus.Selected(4) = False
        Else
            ShowWindow SnapHwnd, SW_RESTORE
 
        End If
    Case 6:
        If lstStatus.Selected(6) = True Then
            ShowWindow SnapHwnd, SW_RESTORE
            lstStatus.Selected(6) = False
            lstStatus.Selected(5) = False
            lstStatus.Selected(4) = False
        End If
    Case 7:
        If lstStatus.Selected(7) = True Then
            SendMessage SnapHwnd, WM_CLOSE, 0, 0
            lstStatus.Selected(7) = False
        End If
    Case 8:
        If lstStatus.Selected(8) = True Then
            BringWindowToTop SnapHwnd
            lstStatus.Selected(8) = False
 
        End If
    End Select
 
End Sub
Private Sub picShot_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    tmr.Enabled = True
    If IsDragging = False Then                                                  '判断是否为拖动状态
        IsDragging = True
        Screen.MousePointer = vbCustom
        Screen.MouseIcon = Image1.Picture                                       '用鼠标指针变为靶状
        picShot.Picture = Image2.Picture                                        '此时图片框加载另一无靶图标
        '将以后的鼠标输入消息都发送到本程序窗口
        SetCapture (picShot.hwnd)
    End If
End Sub
 
Private Sub tmr_Timer()
    Dim pnt As POINTAPI
    Dim newPen&, oldPen&
    'Dim SnapHwnd&
    Dim DeskHwnd&, DeskDC&
    Dim oldRop2&
 
    DeskHwnd& = GetDesktopWindow()    '取得桌面句柄
    DeskDC& = GetWindowDC(DeskHwnd&)     '取得桌面设备场景
    '
    oldRop2& = SetROP2(DeskDC&, 10)
    GetCursorPos pnt                '取得鼠标坐标

    SnapHwnd = WindowFromPoint(pnt.X, pnt.Y)      '取得鼠标指针处窗口句柄
    GetWindowRect SnapHwnd, rc        '获得窗口矩形
    If rc.Left < 0 Then rc.Left = 0
    If rc.Top < 0 Then rc.Top = 0
    If rc.Right > Screen.Width / 15 Then rc.Right = Screen.Width / 15
    If rc.Bottom > Screen.Height / 15 Then rc.Bottom = Screen.Height / 15
    newPen& = CreatePen(0, 3, &H0)       '建立新画笔,载入DeskDC
    oldPen& = SelectObject(DeskDC, newPen)
    Rectangle DeskDC, rc.Left, rc.Top, rc.Right, rc.Bottom     '在指示窗口周围显示闪烁矩形
    Sleep tmr.Interval    '设置闪烁时间间隔
    Rectangle DeskDC, rc.Left, rc.Top, rc.Right, rc.Bottom
 
    SetROP2 DeskDC, oldRop2
    SelectObject DeskDC, oldPen
    DeleteObject newPen
    ReleaseDC DeskHwnd, DeskDC: DeskDC = 0
End Sub
 
Function DisplayNum(Num As Long) As String
    If chkHex.Value = 1 Then
        DisplayNum = Hex(Num)
    Else
        DisplayNum = LTrim(Str(Num))
    End If
End Function
 
Sub WinStyle()
    Dim style&
    Dim useHwnd&    ' Was integer
    Dim crlf$
 
    'useHwnd& = Allhwnd&
    ' Get the class info
    lstWndStyle.Clear
    lstWndExStyle.Clear
    style& = GetWindowLong&(SnapHwnd&, GWL_STYLE)
 
    If style& And WS_BORDER Then
        lstWndStyle.AddItem "WS_BORDER"
    End If
    If style& And WS_CAPTION Then
        lstWndStyle.AddItem "WS_CAPTION"
    End If
    If style& And WS_CHILD Then
        lstWndStyle.AddItem "WS_CHILD"
    End If
    If style& And WS_CLIPCHILDREN Then
        lstWndStyle.AddItem "WS_CLIPCHILDREN"
    End If
    If style& And WS_CLIPSIBLINGS Then
        lstWndStyle.AddItem "WS_CLIPSIBLINGS"
    End If
    If style& And WS_DISABLED Then
        lstWndStyle.AddItem "WS_DISABLED"
    Else
        lstStatus.Selected(1) = True
    End If
    If style& And WS_DLGFRAME Then
        lstWndStyle.AddItem "WS_DLGFRAME"
    End If
    If style& And WS_GROUP Then
        lstWndStyle.AddItem "WS_GROUP"
    End If
    If style& And WS_HSCROLL Then
        lstWndStyle.AddItem "WS_HSCROLL"
    End If
    If style& And WS_MAXIMIZE Then
        lstWndStyle.AddItem "WS_MAXIMIZE"
        lstStatus.Selected(4) = True
    End If
    If style& And WS_MAXIMIZEBOX Then
        lstWndStyle.AddItem "WS_MAXIMIZEBOX"
    End If
    If style& And WS_MINIMIZE Then
        lstWndStyle.AddItem "WS_MINIMIZE"
        lstStatus.Selected(5) = True
    End If
    If style& And WS_MINIMIZEBOX Then
        lstWndStyle.AddItem "WS_MINIMIZEBOX"
    End If
    If style& And WS_POPUP Then
        lstWndStyle.AddItem "WS_POPUP"
    End If
    If style& And WS_SYSMENU Then
        lstWndStyle.AddItem "WS_SYSMENU"
    End If
    If style& And WS_TABSTOP Then
        lstWndStyle.AddItem "WS_TABSTOP"
    End If
    If style& And WS_THICKFRAME Then
        lstWndStyle.AddItem "WS_THICKFRAME"
    End If
    If style& And WS_VISIBLE Then
        lstWndStyle.AddItem "WS_VISIBLE"
        lstStatus.Selected(0) = True
    End If
    If style& And WS_VSCROLL Then
        lstWndStyle.AddItem "WS_VSCROLL"
    End If
 
    If style& And ES_READONLY Then
        lstWndStyle.AddItem "ES_READONLY"
        lstStatus.Selected(3) = True
    End If
 
    If style& And WS_EX_ACCEPTFILES Then
        lstWndExStyle.AddItem "WS_EX_ACCEPTFILES"
    End If
    If style& And WS_EX_DLGMODALFRAME Then
        lstWndExStyle.AddItem "WS_EX_DLGMODALFRAME"
    End If
    If style& And WS_EX_NOPARENTNOTIFY Then
        lstWndExStyle.AddItem "WS_EX_NOPARENTNOTIFY"
    End If
    If style& And WS_EX_TOPMOST Then
        lstWndExStyle.AddItem "WS_EX_TOPMOST"
        lstStatus.Selected(2) = True
    End If
    If style& And WS_EX_TRANSPARENT Then
        lstWndExStyle.AddItem "WS_EX_TRANSPARENT"
    End If
    If style& And WS_EX_MDICHILD Then
        lstWndExStyle.AddItem "WS_EX_MDICHILD"
    End If
    If style& And WS_EX_TOOLWINDOW Then
        lstWndExStyle.AddItem "WS_EX_TOOLWINDOW"
    End If
    If style& And WS_EX_WINDOWEDGE Then
        lstWndExStyle.AddItem "WS_EX_WINDOWEDGE"
    End If
    If style& And WS_EX_CLIENTEDGE Then
        lstWndExStyle.AddItem "WS_EX_CLIENTEDGE"
    End If
    If style& And WS_EX_CONTEXTHELP Then
        lstWndExStyle.AddItem "WS_EX_CONTEXTHELP"
    End If
    If style& And WS_EX_RIGHT Then
        lstWndExStyle.AddItem "WS_EX_RIGHT"
    End If
    If style& And WS_EX_RTLREADING Then
        lstWndExStyle.AddItem "WS_EX_RTLREADING"
    End If
    If style& And WS_EX_LEFTSCROLLBAR Then
        lstWndExStyle.AddItem "WS_EX_LEFTSCROLLBAR"
    End If
    If style& And WS_EX_CONTROLPARENT Then
        lstWndExStyle.AddItem "WS_EX_CONTROLPARENT"
    End If
    If style& And WS_EX_STATICEDGE Then
        lstWndExStyle.AddItem "WS_EX_STATICEDGE"
    End If
    If style& And WS_EX_APPWINDOW Then
        lstWndExStyle.AddItem "WS_EX_APPWINDOW"
    End If
End Sub
Sub ClassStyle()
    Dim clsextra&, wndextra&    ' Change to long, though probably unnecessary
    Dim style&      ' Changed to long
    Dim useHwnd&    ' Changed to long
    Dim crlf$
    'useHwnd& = Allhwnd&
    ' Get the class info
    ' These all used to be GetClassWord and GCW_ constants
    lstClassStyle.Clear
 
    clsextra& = GetClassLong(useHwnd&, GCL_CBCLSEXTRA)
    wndextra& = GetClassLong(useHwnd&, GCL_CBWNDEXTRA)
    style& = GetClassLong(SnapHwnd&, GCL_STYLE)
 
    txtClassName.Text = WndClassText.Text
    txtClassValue.Text = Str(style)
 
    '   outstring$ = "Class & Word Extra = " + Str$(clsextra&) + "," + Str$(wndextra&)
    If style& And CS_BYTEALIGNCLIENT Then
        lstClassStyle.AddItem "CS_BYTEALIGNCLIENT"
    End If
    If style& And CS_BYTEALIGNWINDOW Then
        lstClassStyle.AddItem "CS_BYTEALIGNWINDOW"
    End If
    If style& And CS_CLASSDC Then
        lstClassStyle.AddItem "CS_CLASSDC"
    End If
    If style& And CS_DBLCLKS Then
        lstClassStyle.AddItem "CS_DBLCLKS"
    End If
    ' Was CS_GLOBALCLASS (has same value)
    If style& And CS_PUBLICCLASS Then
        lstClassStyle.AddItem "CS_GLOBALCLASS"
    End If
    If style& And CS_HREDRAW Then
        lstClassStyle.AddItem "CS_HREDRAW"
    End If
    If style& And CS_NOCLOSE Then
        lstClassStyle.AddItem "CS_NOCLOSE"
    End If
    If style& And CS_OWNDC Then
        lstClassStyle.AddItem "CS_OWNDC"
    End If
    If style& And CS_PARENTDC Then
        lstClassStyle.AddItem "CS_PARENTDC"
    End If
    If style& And CS_SAVEBITS Then
        lstClassStyle.AddItem "CS_SAVEBITS"
    End If
    If style& And CS_VREDRAW Then
        lstClassStyle.AddItem "CS_VREDRAW"
    End If
    If lstClassStyle.ListCount = 0 Then lstClassStyle.AddItem "无类信息"
 
End Sub
Private Sub Fulfill()
    Dim tempstr As String, strlong As Long, rtn As Long
 
    '////////填写常规标签页

    hWndText.Text = DisplayNum(SnapHwnd)
    '获得该窗口的类型并显示在WndClassText文本框中
    tempstr = String(255, Chr$(0))
    strlong = Len(tempstr)
    rtn = GetClassName(SnapHwnd, tempstr, strlong)
    If rtn = 0 Then Exit Sub
    WndClassText.Text = tempstr
    '向该窗口发送一个WM_GETTEXT消息,以获得该窗口的文本
    tempstr = Space(90000)
    strlong = Len(tempstr)
    rtn = SendMessage(SnapHwnd, WM_GETTEXT, strlong + 1, tempstr)
    tempstr = Trim(tempstr)
    TitleText.Text = tempstr
 
    txtWindowID.Text = GetWindowLong(SnapHwnd, GWL_ID)
    txtFilePath.Text = GetAppNameFromHwnd(SnapHwnd)
 
    '////////填写窗口标签页

    txtSelfHandle.Text = hWndText.Text                                          '本窗口句柄
    txtSelfTitle.Text = TitleText.Text                                          '本窗口标题

    Dim Pid As Long
    GetWindowThreadProcessId SnapHwnd, Pid                                      '进程ID
    txtProcessID.Text = DisplayNum(Pid)
 
    '窗口矩形
    Dim rc2 As RECT
    GetWindowRect SnapHwnd, rc2                                                 '再次获得窗口矩形

    txtWndRect.Text = "(" & LTrim(Str(rc2.Left)) & "," & LTrim(Str(rc2.Top)) & "),(" & LTrim(Str(rc2.Right)) & "," & LTrim(Str(rc2.Bottom)) & ")  " & LTrim(Str(rc2.Right - rc2.Left)) & "x" & LTrim(Str(rc2.Bottom - rc2.Top))
 
    Dim tempHandle As Long
    tempHandle = GetNextWindow(SnapHwnd, GW_HWNDPREV)                           '上一窗口
    txtPreHandle.Text = DisplayNum(tempHandle)
 
    tempstr = String(255, Chr$(0))                                              '获取上一窗口标题
    strlong = Len(tempstr)
    rtn = SendMessage(tempHandle, WM_GETTEXT, strlong + 1, tempstr)
    tempstr = Trim(tempstr)
    txtPreTitle.Text = tempstr
 
    tempHandle = GetNextWindow(SnapHwnd, GW_HWNDNEXT)                           '下一窗口
    txtNextHandle.Text = DisplayNum(tempHandle)
 
    tempstr = String(255, Chr$(0))                                              '获取下一窗口标题
    strlong = Len(tempstr)
    rtn = SendMessage(tempHandle, WM_GETTEXT, strlong + 1, tempstr)
    tempstr = Trim(tempstr)
    txtNextTitle.Text = tempstr
 
    tempHandle = GetParent(SnapHwnd)                                            '父窗口
    txtParentHandle.Text = DisplayNum(tempHandle)
    tempstr = String(255, Chr$(0))
    strlong = Len(tempstr)
    rtn = SendMessage(tempHandle, WM_GETTEXT, strlong + 1, tempstr)
    tempstr = Trim(tempstr)
    txtParentTitle.Text = tempstr
 
    tempHandle = GetWindow(SnapHwnd, GW_CHILD)                                  '第一子窗口
    txtChildHandle.Text = DisplayNum(tempHandle)
    tempstr = String(255, Chr$(0))
    strlong = Len(tempstr)
    rtn = SendMessage(tempHandle, WM_GETTEXT, strlong + 1, tempstr)
    tempstr = Trim(tempstr)
    txtChildTitle.Text = tempstr
 
    tempHandle = GetWindow(SnapHwnd, GW_OWNER)                                  '所有者窗口
    txtOwnerHandle.Text = DisplayNum(tempHandle)
    tempstr = String(255, Chr$(0))
    strlong = Len(tempstr)
    rtn = SendMessage(tempHandle, WM_GETTEXT, strlong + 1, tempstr)
    tempstr = Trim(tempstr)
    txtOwnerTitle.Text = tempstr
    Call JudgeLink
 
    '////////填写样式标签页

    Dim wndStyle As Long, wndExStyle As Long
    wndStyle = GetWindowLong(SnapHwnd, GWL_STYLE)                               '窗口样式值
    wndExStyle = GetWindowLong(SnapHwnd, GWL_EXSTYLE)                           '扩展样式值
    txtWndStyle.Text = DisplayNum(wndStyle)
    txtWndExStyle.Text = DisplayNum(wndExStyle)
 
    Dim i%
    For i = 0 To lstStatus.ListCount - 1
        lstStatus.Selected(i) = False                                           '去掉“消息”标签页中列表中所有勾选
    Next i
 
    '////////调用下面两个过程填写样式和类标签页
    Call WinStyle
    Call ClassStyle
 
    GetWndPic hWndText, Me.Picture2
 
    VScroll1.Max = Picture2.Width / 2
    HScroll1.Max = Picture2.Height + HScroll1.LargeChange
 
    Me.SetFocus
    '释放鼠标消息抓取

End Sub
Private Sub JudgeLink()                                                         '判断该项窗口是否存在,如果存在,则可以点击(文字变蓝,鼠标变成小手)
    If txtPreHandle.Text = "0" Then
        lblPreHandle.ForeColor = vbBlack
        lblPreHandle.MousePointer = 0
    Else
        lblPreHandle.ForeColor = vbBlue
        lblPreHandle.MousePointer = 99
        lblPreHandle.MouseIcon = imgPointer.Picture
 
    End If
    If txtNextHandle.Text = "0" Then
        lblNextHandle.ForeColor = vbBlack
        lblNextHandle.MousePointer = 0
    Else
        lblNextHandle.ForeColor = vbBlue
        lblNextHandle.MousePointer = 99
        lblNextHandle.MouseIcon = imgPointer.Picture
 
    End If
    If txtParentHandle.Text = "0" Then
        lblParentHandle.ForeColor = vbBlack
        lblParentHandle.MousePointer = 0
    Else
        lblParentHandle.ForeColor = vbBlue
        lblParentHandle.MousePointer = 99
        lblParentHandle.MouseIcon = imgPointer.Picture
 
    End If
    If txtChildHandle.Text = "0" Then
        lblChildHandle.ForeColor = vbBlack
        lblChildHandle.MousePointer = 0
    Else
        lblChildHandle.ForeColor = vbBlue
        lblChildHandle.MousePointer = 99
        lblChildHandle.MouseIcon = imgPointer.Picture
 
    End If
End Sub
 
Private Sub VScroll1_Scroll()
    Picture2.Top = (-1) * VScroll1.Value
End Sub

APIFunction.BAS

101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
Option Explicit
 
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Declare Function GetLastError Lib "kernel32" () As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Declare Function ReleaseCapture Lib "user32" () As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
 
Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
 
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Declare Function BringWindowToTop 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 Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
 
Public Const SW_SHOW = 5
Public Const SW_HIDE = 0
Public Const SW_MAXIMIZE = 3
Public Const SW_MINIMIZE = 6
Public Const SW_RESTORE = 9
 
Public Const GW_HWNDPREV = 3
Public Const GW_HWNDNEXT = 2
Public Const GW_OWNER = 4
 
Public Const WM_GETTEXT = &HD
Public Const WM_ENABLE = &HA
Public Const WM_CLOSE = &H10
Public Const EM_SETREADONLY = &HCF
 
Type POINTAPI
    X As Long
    Y As Long
End Type
Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
 
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function SetROP2 Lib "gdi32" (ByVal hdc As Long, ByVal nDrawMode As Long) As Long
Public Declare Function GetROP2 Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
 
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Public Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetDCEx Lib "user32" (ByVal hwnd As Long, ByVal hrgnclip As Long, ByVal fdwOptions As Long) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function SetActiveWindow Lib "user32" (ByVal hwnd As Long) As Long
 
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function GetClassLong Lib "user32" Alias "GetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
 
Public Const GWL_STYLE = (-16)
Public Const GWL_EXSTYLE = (-20)
Public Const GWL_ID = (-12)
 
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Public Const GW_CHILD = 5
 
Public Const WS_OVERLAPPED = &H0&
Public Const WS_POPUP = &H80000000
Public Const WS_CHILD = &H40000000
Public Const WS_MINIMIZE = &H20000000
Public Const WS_VISIBLE = &H10000000
Public Const WS_DISABLED = &H8000000
Public Const WS_CLIPSIBLINGS = &H4000000
Public Const WS_CLIPCHILDREN = &H2000000
Public Const WS_MAXIMIZE = &H1000000
Public Const WS_CAPTION = &HC00000                                              '  WS_BORDER Or WS_DLGFRAME
Public Const WS_BORDER = &H800000
Public Const WS_DLGFRAME = &H400000
Public Const WS_VSCROLL = &H200000
Public Const WS_HSCROLL = &H100000
Public Const WS_SYSMENU = &H80000
Public Const WS_THICKFRAME = &H40000
Public Const WS_GROUP = &H20000
Public Const WS_TABSTOP = &H10000
 
Public Const WS_MINIMIZEBOX = &H20000
Public Const WS_MAXIMIZEBOX = &H10000
 
Public Const WS_EX_ACCEPTFILES = &H10&
Public Const WS_EX_DLGMODALFRAME = &H1&
Public Const WS_EX_NOPARENTNOTIFY = &H4&
Public Const WS_EX_TOPMOST = &H8&
Public Const WS_EX_TRANSPARENT = &H20&
Public Const WS_EX_MDICHILD = &H40&
Public Const WS_EX_TOOLWINDOW = &H80&
Public Const WS_EX_WINDOWEDGE = &H100&
Public Const WS_EX_CLIENTEDGE = &H200&
Public Const WS_EX_CONTEXTHELP = &H400&
Public Const WS_EX_RIGHT = &H1000&
Public Const WS_EX_RTLREADING = &H2000&
Public Const WS_EX_LEFTSCROLLBAR = &H4000&
Public Const WS_EX_CONTROLPARENT = &H10000
Public Const WS_EX_STATICEDGE = &H20000
Public Const WS_EX_APPWINDOW = &H40000
 
Public Const ES_READONLY = &H800&
 
Public Const CS_VREDRAW = &H1
Public Const CS_HREDRAW = &H2
Public Const CS_KEYCVTWINDOW = &H4
Public Const CS_DBLCLKS = &H8
Public Const CS_OWNDC = &H20
Public Const CS_CLASSDC = &H40
Public Const CS_PARENTDC = &H80
Public Const CS_NOKEYCVT = &H100
Public Const CS_NOCLOSE = &H200
Public Const CS_SAVEBITS = &H800
Public Const CS_BYTEALIGNCLIENT = &H1000
Public Const CS_BYTEALIGNWINDOW = &H2000
Public Const CS_PUBLICCLASS = &H4000
 
Public Const GCL_MENUNAME = (-8)
Public Const GCL_HBRBACKGROUND = (-10)
Public Const GCL_HCURSOR = (-12)
Public Const GCL_HICON = (-14)
Public Const GCL_HMODULE = (-16)
Public Const GCL_CBWNDEXTRA = (-18)
Public Const GCL_CBCLSEXTRA = (-20)
Public Const GCL_WNDPROC = (-24)
Public Const GCL_STYLE = (-26)
Public Const GCW_ATOM = (-32)
 
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
 
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Public Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Public Declare Function Module32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As MODULEENTRY32) As Long
Public Type MODULEENTRY32
    dwSize As Long
    th32ModuleID As Long
    th32ProcessID As Long
    GlblcntUsage As Long
    ProccntUsage As Long
    modBaseAddr As Byte
    modBaseSize As Long
    hModule As Long
    szModule As String * 256
    szExePath As String * 1024
End Type
Public Function GetAppNameFromHwnd(ByVal hwnd As Long) As String
    Dim ME32 As MODULEENTRY32
    Dim Pid As Long
    GetWindowThreadProcessId hwnd, Pid
    Dim hSnapshot As Long
    hSnapshot = CreateToolhelp32Snapshot(&H8, Pid)
 
    ME32.dwSize = Len(ME32)
    Module32First hSnapshot, ME32
    GetAppNameFromHwnd = (Left$(ME32.szExePath, InStr(ME32.szExePath, vbNullChar) - 1))
 
End Function
 
Public Sub GetWndPic(Wnd As Long, Pic As PictureBox)
    Dim R As RECT, DC As Long
    GetWindowRect Wnd, R
    DC = GetWindowDC(Wnd)
    With Pic
        .Cls
        .AutoRedraw = True:
        .BorderStyle = 0
        .Parent.ScaleMode = vbPixels
        .Move .Left, .Top, R.Right - R.Left, R.Bottom - R.Top
        BringWindowToTop Wnd
        BitBlt .hdc, 0, 0, .Width, .Height, DC, 0, 0, vbSrcCopy
    End With
    ReleaseDC Wnd, DC
End Sub

modXP.BAS

101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
'本代码欢迎读者转发及与我相互探讨,但请保留此文字说明 2005/12/31
'作者:宋陈三 作者主页http://www.asanscape.com
'作者BLOG: http://blog.csdn.net/asanscape     QQ:6019187  Email:asangray@163.com

'本工程中的xp.res可以直接加入其他工程进行编译以使其具备XP风格
'注意加入资源文件时要同时加入本模块,  设置工程从Sub Main()启动,否则无初始化过程
'InitCommonControls函数存在于comctl32.dll(版本5)中,不建议使用,而要使用InitCommonControlsEx

Private Type tagInitCommonControlsEx
    lngSize As Long
    lngICC As Long
End Type
Private Declare Function InitCommonControlsEx Lib "comctl32.dll" _
    (iccex As tagInitCommonControlsEx) As Boolean
Private Const ICC_USEREX_CLASSES = &H200
 
Public Function InitCommonControlsVB() As Boolean
   On Error Resume Next
   Dim iccex As tagInitCommonControlsEx
   ' Ensure CC available:
   With iccex
       .lngSize = LenB(iccex)
       .lngICC = ICC_USEREX_CLASSES
   End With
   InitCommonControlsEx iccex
   InitCommonControlsVB = (Err.Number = 0)
   On Error GoTo 0
End Function
 
Sub Main()
   InitCommonControlsVB
   frmMain.Show
End Sub

One thought on “SPY++ V2.4 VB源码

发表评论

电子邮件地址不会被公开。 必填项已用*标注

您可以使用这些HTML标签和属性: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <strike> <strong>