博客园_PctGL SERIES

启用本机 WiFi 热点

2012-01-25T17:11:00Z

条件：

1. 支持 WiFi 热点功能的无线网卡。

2. 相关系统服务已启动

3. 共享 Internet 连接

需要启动的系统服务：

怎么查看自己的无线网卡是否支持虚拟 WIFI 热点：

共享 Internet 连接：

WIFI 连接的 IP 地址问题：

需要手动设置的就一步, 如果你是用 ADSL 上网, 就按照下面方法实现共享连接:

开始菜单 > 连接到 > 打开网络和共享中心 > 更改适配器设置 > ADSL拨号连接属性 > 共享 > 把第 1 项, 第 3 项全部勾选, 在下拉列表中选择被共享的无线网络连接

下面的压缩包中有完整的设置过程截图

设置的步骤到此基本完成, 接下来使用下面的批处理文件, 按照上面的提示运行即可:

v20120127:

http://files.cnblogs.com/pctgl/WiFi20120127.rar

v20120126:

http://files.cnblogs.com/pctgl/WiFi20120126.rar

本文链接

Vasm3 ···

2011-07-26T11:09:00Z

自然语法怎么识别好呢？正在做 vb 的语法编译器，发现一个问题，一个简单的赋值语句识别起来好麻烦···

本文链接

一个简单的模仿系统的下拉列表颜色选择控件《ColorComboBox》

2010-09-25T04:06:00Z

Option Explicit

Private Type VasmColorComBoxConst
    ColorHDC  As Long
    ColorName As String
    ColorRGB  As Long
End Type

Private Type ThisClassSet
    DefaultColor(0 To 17) As VasmColorComBoxConst
    n_hWnd                As Long
    n_DefaultProc         As Long
    n_CID                 As Long
    n_hBurshNor           As Long
    n_hBurshSel           As Long
End Type

Dim PG As ThisClassSet
Dim LinkProc() As Long

Event ItemClick(ByVal RGBColor As Long)

Private Sub MsgHook(Result As Long, ByVal cHwnd As Long, ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long)

    Dim Dit As DRAWITEMSTRUCT
    Dim i As Long

    Dim txtColor As Long
    Dim hBrush As Long
    Dim Rct As RECT

    If (Message = WM_DRAWITEM) And (wParam = PG.n_CID) Then

        CopyMemory Dit, ByVal lParam&, LenB(Dit)
        If Dit.itemID = -1 Then Exit Sub
        i = ((Dit.rcItem.bottom - Dit.rcItem.Top - 12) \ 2) + Dit.rcItem.Top

        Select Case Dit.itemState
            Case 1, 16, 17, 4113: hBrush = PG.n_hBurshSel: txtColor = GetSysColor(COLOR_HIGHLIGHTTEXT)
            Case Else: hBrush = PG.n_hBurshNor: txtColor = 0
        End Select


'        Debug.Print Dit.itemID, Dit.itemState, Timer

        SetBkMode Dit.hDC, 0&
        FillRect Dit.hDC, Dit.rcItem, hBrush
        BitBlt Dit.hDC, Dit.rcItem.Left + 2, i, 25, 12, PG.DefaultColor(Dit.itemID).ColorHDC, 0, 0, SRCCOPY
        Dit.rcItem.Left = Dit.rcItem.Left + 30
        SetTextColor Dit.hDC, txtColor&
        DrawText Dit.hDC, PG.DefaultColor(Dit.itemID).ColorName, -1&, Dit.rcItem, DT_SINGLELINE Or DT_VCENTER
        Exit Sub
    End If



    Result = CallWindowProc(ByVal PG.n_DefaultProc&, ByVal cHwnd, ByVal Message, ByVal wParam&, ByVal lParam&)

    If Message = WM_COMMAND And lParam = PG.n_hWnd Then
        i = ItemSelected
        Dim ps As POINTS
        CopyMemory ps, wParam&, 4&
        If ps.y = CBN_SELCHANGE Then
            If i = 1 Then
                PG.DefaultColor(1).ColorRGB = UserGetColor(PG.n_hWnd, PG.DefaultColor(1).ColorRGB)
                DrawColorLabel PG.DefaultColor(1).ColorHDC, PG.DefaultColor(1).ColorRGB
                UpdateWindow cHwnd

            End If
            RaiseEvent ItemClick(PG.DefaultColor(i).ColorRGB)
        End If

    End If

End Sub

Function CreateColorComboBox(hWndParent As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, Optional ByVal cID As Long) As Long
    'CBS_OWNERDRAWVARIABLE Or

    Dim cHwnd As Long
    cHwnd = CreateWindowEx(0&, "ComboBox", vbNullString, WS_CHILD Or WS_TABSTOP Or WS_VISIBLE Or WS_VSCROLL Or CBS_OWNERDRAWFIXED Or CBS_DROPDOWNLIST Or CBS_HASSTRINGS Or CBS_AUTOHSCROLL, X1, Y1, X2, 180&, hWndParent, cID&, App.hInstance, ByVal 0&)

    If cHwnd Then

        SendMessage cHwnd, WM_SETFONT, ByVal SendMessage(hWndParent, WM_GETFONT, ByVal 0&, ByVal 0&), ByVal 0&

        Dim i As Long
        For i = 17 To 0 Step -1
            SendMessageStr cHwnd, CB_ADDSTRING, ByVal 0&, PG.DefaultColor(i).ColorName
        Next

        PG.n_CID = cID
        PG.n_hWnd = cHwnd
        PG.n_DefaultProc = SetWindowLong(hWndParent, ByVal GWL_WNDPROC, ByVal GetWndProcAddress(11))
        ColorSelected = PG.DefaultColor(1).ColorRGB
    End If

End Function

Public Property Get ItemSelected() As Long
    ItemSelected = SendMessage(PG.n_hWnd, ByVal CB_GETCURSEL, ByVal 0&, ByVal 0&)
End Property

Public Property Let ItemSelected(ByVal vNewValue As Long)
    SendMessage PG.n_hWnd, ByVal CB_SETCURSEL, ByVal vNewValue&, ByVal 0&
End Property

Public Property Get ColorSelected() As Long
    Dim i As Long
    i = SendMessage(PG.n_hWnd, ByVal CB_GETCURSEL, ByVal 0&, ByVal 0&)
    ColorSelected = PG.DefaultColor(i).ColorRGB
End Property

Public Property Let ColorSelected(ByVal vNewValue As Long)
    Dim i As Long

    For i = 17 To 0 Step -1
        If i <> 1 Then If PG.DefaultColor(i).ColorRGB = vNewValue Then GoTo l1
    Next
    i = 1
l1:

    If i = 1 Then DrawColorLabel PG.DefaultColor(1).ColorHDC, vNewValue: i = 1: PG.DefaultColor(1).ColorRGB = vNewValue

    SendMessage PG.n_hWnd, ByVal CB_SETCURSEL, ByVal i&, ByVal 0&
End Property

Public Property Get ColorCustom() As Long
    ColorCustom = PG.DefaultColor(1).ColorRGB
End Property

Public Property Let ColorCustom(ByVal vNewValue As Long)
    PG.DefaultColor(1).ColorRGB = vNewValue
    DrawColorLabel PG.DefaultColor(1).ColorHDC, vNewValue
End Property

Public Property Get ID() As Long
    ID = PG.n_CID
End Property

Public Property Get ColorDefault() As Long
    ColorCustom = PG.DefaultColor(0).ColorRGB
End Property

Public Property Let ColorDefault(ByVal vNewValue As Long)
    PG.DefaultColor(0).ColorRGB = vNewValue
    DrawColorLabel PG.DefaultColor(0).ColorHDC, vNewValue
End Property

Private Sub DrawColorLabel(ColorHDC As Long, RGB_Color As Long)

    Dim hBrush As Long, hBrush1 As Long
    Dim Rct As RECT

    SetRect Rct, 0&, 0&, 25&, 12&
    hBrush1 = CreateSolidBrush(0&)
    hBrush = CreateSolidBrush(RGB_Color&)

    FillRect ColorHDC, Rct, hBrush
    FrameRect ColorHDC, Rct, hBrush1
    DeleteObject hBrush
    DeleteObject hBrush1

End Sub

Private Function UserGetColor(ByVal hwndOwner As Long, ByVal ColorInit As Long) As Long

    Dim Tcc As TCHOOSECOLOR
    Dim Colors(16) As Long

    With Tcc
        .hInstance = App.hInstance
        .hwndOwner = hwndOwner
        .lStructSize = LenB(Tcc)
        .rgbResult = ColorInit
        .flags = CC_RGBINIT Or CC_FULLOPEN
        .lpCustColors = VarPtr(Colors(0))

    End With

    ChooseColor Tcc
    UserGetColor = Tcc.rgbResult
End Function

Private Function GetWndProcAddress(ByVal SinceCount As Long) As Long
'   地址指针＝ GetWndProcAddress( 取第 N 个公共函数（属性）  =或= 所有公共函数个数 + 第 N 个私有函数的函数地址）
    Dim mePtr As Long
    Dim jmpAddress As Long
    mePtr = ObjPtr(Me)
    CopyMemory jmpAddress, ByVal mePtr, 4
    CopyMemory jmpAddress, ByVal jmpAddress + (SinceCount - 1) * 4 + &H1C, 4

    ReDim LinkProc(10)
    LinkProc(0) = &H83EC8B55
    LinkProc(1) = &HFC8B14EC
    LinkProc(2) = &H56FC758D
    LinkProc(3) = &H3308758D
    LinkProc(4) = &HFC04B1C9
    LinkProc(5) = &HFF68A5F3
    LinkProc(6) = &HB8FFFFFF
    LinkProc(7) = &HFFFFFFFF
    LinkProc(8) = &H48BD0FF
    LinkProc(9) = &H10C2C924

    CopyMemory ByVal VarPtr(LinkProc(5)) + 3, mePtr, 4
    CopyMemory ByVal VarPtr(LinkProc(7)), jmpAddress, 4
    GetWndProcAddress = VarPtr(LinkProc(0))
    VirtualProtect ByVal VarPtr(LinkProc(0)), 44&, &H40, mePtr
End Function

Private Sub Class_Initialize()

    PG.DefaultColor(2).ColorName = "黑色": PG.DefaultColor(2).ColorRGB = 0&
    PG.DefaultColor(3).ColorName = "深红色": PG.DefaultColor(3).ColorRGB = &H80& ' &H800000
    PG.DefaultColor(4).ColorName = "绿色": PG.DefaultColor(4).ColorRGB = &H8000&
    PG.DefaultColor(5).ColorName = "橄榄色": PG.DefaultColor(5).ColorRGB = &H8080& '
    PG.DefaultColor(6).ColorName = "藏青色": PG.DefaultColor(6).ColorRGB = &H800000 ' &H80&
    PG.DefaultColor(7).ColorName = "紫色": PG.DefaultColor(7).ColorRGB = &H800080
    PG.DefaultColor(8).ColorName = "绿蓝": PG.DefaultColor(8).ColorRGB = &H808000 '&H8080&
    PG.DefaultColor(9).ColorName = "灰色": PG.DefaultColor(9).ColorRGB = &H808080
    PG.DefaultColor(10).ColorName = "银白": PG.DefaultColor(10).ColorRGB = &HC0C0C0
    PG.DefaultColor(11).ColorName = "红色": PG.DefaultColor(11).ColorRGB = &HFF&
    PG.DefaultColor(12).ColorName = "亮绿色": PG.DefaultColor(12).ColorRGB = &HFF00&
    PG.DefaultColor(13).ColorName = "黄色": PG.DefaultColor(13).ColorRGB = &HFFFF&
    PG.DefaultColor(14).ColorName = "蓝色": PG.DefaultColor(14).ColorRGB = &HFF0000
    PG.DefaultColor(15).ColorName = "紫红色": PG.DefaultColor(15).ColorRGB = &HFF00FF
    PG.DefaultColor(16).ColorName = "兰色": PG.DefaultColor(16).ColorRGB = &HFFFF00
    PG.DefaultColor(17).ColorName = "白色": PG.DefaultColor(17).ColorRGB = &HFFFFFF
    PG.DefaultColor(0).ColorName = "默认"
    PG.DefaultColor(1).ColorName = "自定义"

    Dim nHDC As Long, hBitmap As Long, hBursh As Long
    Dim i As Long, Rct As RECT
    Dim hBrush1 As Long
    nHDC = GetDC(0&)

    SetRect Rct, 0&, 0&, 25&, 12&
    hBrush1 = CreateSolidBrush(0&)

    For i = 2 To 17
        PG.DefaultColor(i).ColorHDC = CreateCompatibleDC(nHDC)
        hBitmap = CreateCompatibleBitmap(nHDC, 25&, 12&)
        SelectObject PG.DefaultColor(i).ColorHDC, hBitmap
        DeleteObject hBitmap
        hBursh = CreateSolidBrush(PG.DefaultColor(i).ColorRGB)
        FillRect PG.DefaultColor(i).ColorHDC, Rct, hBursh
        FrameRect PG.DefaultColor(i).ColorHDC, Rct, hBrush1

        DeleteObject ByVal hBursh
    Next

    PG.DefaultColor(0).ColorHDC = CreateCompatibleDC(nHDC)
    hBitmap = CreateCompatibleBitmap(nHDC, 25&, 12&)
    SelectObject PG.DefaultColor(0).ColorHDC, hBitmap
    DeleteObject hBitmap

    PG.DefaultColor(1).ColorHDC = CreateCompatibleDC(nHDC)
    hBitmap = CreateCompatibleBitmap(nHDC, 25&, 12&)
    SelectObject PG.DefaultColor(1).ColorHDC, hBitmap
    DeleteObject hBitmap

    DeleteObject hBrush1
    ReleaseDC 0&, nHDC

    PG.n_hBurshNor = CreateSolidBrush(&HFFFFFF)
    PG.n_hBurshSel = GetSysColorBrush(COLOR_HIGHLIGHT)

End Sub

Private Sub Class_Terminate()

    DestroyWindow PG.n_hWnd
    SetWindowLong PG.n_hWnd, GWL_WNDPROC, PG.n_DefaultProc
    DeleteObject PG.n_hBurshNor
    DeleteObject PG.n_hBurshSel
    Dim i As Long
    For i = 17 To 0 Step -1
        DeleteDC PG.DefaultColor(i).ColorHDC
    Next
End Sub

下载连接: http://files.cnblogs.com/pctgl/ColorComBoBox.rar

实现方法简单的不得了。。。

效果：

本文链接

机器码转存VB6代码,方便写内嵌汇编代码

2010-08-11T15:42:00Z

其实是前一篇那个无崩溃子类代码里面的东西, 因为这次要写的字节码太多了,我又不爱用文本转换的方法

于是写了个小函数, 做了一些文本自动编辑,替换工作,实现了一个将机器码自动转换为

Long 类型数组, 并提供机器码标志修改的功能.

先说使用:

1. 打开 OD ,选中自己想转换为vb代码的函数或代码段,然后点鼠标右键菜单 > 二进制 > 二进制复制

如图:

2. 打开 Opcodes SaveAs VisualBasic 6.0,在灰色的文本框中,粘贴,你就会得到一串 55 8B EC 83 C4 FC B8 D4 13 40 00 8B 文本

如图:

3. 文本本身就是按照空格分开的1组,1组的,不要修改格式, 直接点 GetVisualBasicCode 按钮,就会得到转换后的内容

如图:

vb代码这样就在绿色文本框中生成了;

数组 LinkProc 是 4字节 Long 型, 转换程序会自动声明 Dim LinkProc() as long 并且自动计算元素个数;

通常, 这些机器码我们可能会做些修改, 比如把 Mov eax, 12345 的12345 修改成动态数据, 你可以将这个12345,在od中就修改成16进制的 1000(4字节)

程序将自动查找这个 1000 (最大支持16进制的 20000) ,也就是说把 &H1000 这个值做为标记,程序自动查找,并自动计算他的在 LinkProc 数组中的位置

然后用 CopyMemory 表示出来,如图上那样 CopyMemory ByVal VarPtr(LinkProc(11)) + 3, &H0100000, 4& 这个&H &H0100000 是要你修改的

你可以改成你,需要的数值, ByVal VarPtr(LinkProc(11)) + 3 表示的就是找到的 &H1000 在数组中的位置,自动算出来的.

依次方法, 你可以设置 &H1000 2000 3000 ~ 10000 11000 12000 ~ 20000, 一共20个标记, 这些标记都会被自动找出来,而且表示出来

你要做得就是修改copymemory 的第2个参数为你想要的结果, 如果标记位置正好占据了某个元素的位置,就会以 LinkProc(13) = 0200000 的形式表示,同样

自己修改 0200000.

附:实例程序 http://files.cnblogs.com/pctgl/opcodes2vb6.rar

本文链接

无崩溃子类化的实现

2010-08-11T14:54:00Z

  1 Option Explicit
  2 Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, Optional ByVal Length As Long = 4)
  3 Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  4 Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  5 Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  6 Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Any, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
  7 Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
  8 Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
  9 Private Declare Function GetProcessHeap Lib "kernel32" () As Long
10 Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
11 Private Declare Function HeapDestroy Lib "kernel32" (ByVal hHeap As Long) As Long
12
13 Private Type ThisClassSet
14     s_srcWndProcAddress     As Long
15     s_Hwnd                  As Long
16
17     n_heapAlloc             As Long
18 End Type
19 Dim LinkProc(29)  As Long
20 Dim PG                      As ThisClassSet
21
22 Event GetWindowMessage(Result As Long, ByVal cHwnd As Long, ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long)
23
24 Private Sub MsgHook(Result As Long, ByVal cHwnd As Long, ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long)
25     '子类化接口过程
26     RaiseEvent GetWindowMessage(Result, cHwnd, Message, wParam, lParam)
27 End Sub
28
29 Private Function GetWndProcAddress(ByVal OrgWindowProc As Long, ByVal SinceCount As Long) As Long
30 '   地址指针＝ GetWndProcAddress( 取第 N 个公共函数（属性）  =或= 所有公共函数个数 + 第 N 个私有函数的函数地址）
31     Dim mePtr As Long
32     Dim jmpAddress As Long
33     Dim i As Long
34     Dim Protlng As Long
35
36     mePtr = ObjPtr(Me)
37     CopyMemory jmpAddress, ByVal mePtr, 4
38     CopyMemory jmpAddress, ByVal jmpAddress + (SinceCount - 1) * 4 + &H1C, 4
39
40
41     LinkProc(0) = &H83EC8B55
42     LinkProc(1) = &H75FFFCC4
43     LinkProc(2) = &H1075FF14
44     LinkProc(3) = &HFF0C75FF
45     LinkProc(4) = &HB80875
46     LinkProc(5) = &HB000040
47     LinkProc(6) = &HB94575C0
48     LinkProc(7) = &H1000&
49     LinkProc(8) = &H830C458B
50     LinkProc(9) = &H87502F8
51     LinkProc(10) = &H1C7&
52     LinkProc(11) = &H1BEB0000
53     LinkProc(12) = &H863D&
54     LinkProc(13) = &H8B077500
55     LinkProc(14) = &H1891045
56     LinkProc(15) = &H5A3D0DEB
57     LinkProc(16) = &H75000010
58     LinkProc(17) = &H101C706
59     LinkProc(18) = &H83000000
60     LinkProc(19) = &H2750139
61     LinkProc(20) = &H680EEB
62     LinkProc(21) = &HB8000020
63     LinkProc(22) = &H3000&
64     LinkProc(23) = &H13EBD0FF
65     LinkProc(24) = &H50FC458D
66     LinkProc(25) = &H500068
67     LinkProc(26) = &H6000B800
68     LinkProc(27) = &HD0FF0000
69     LinkProc(28) = &HC9FC458B
70     LinkProc(29) = &H10C2&
71
72     i = App.LogMode
73     CopyMemory ByVal VarPtr(LinkProc(4)) + 3, i, 4&                                     ' Label Sign: 0400000
74     CopyMemory ByVal VarPtr(LinkProc(25)) + 1, mePtr, 4&                                ' Label Sign: 0500000
75     CopyMemory ByVal VarPtr(LinkProc(26)) + 2, jmpAddress, 4&                           ' Label Sign: 0600000
76
77     If i Then
78         i = VarPtr(LinkProc(0))
79         Protlng = 120
80     Else
81         PG.n_heapAlloc = HeapAlloc(GetProcessHeap, &H8, 128&)
82         CopyMemory ByVal PG.n_heapAlloc + 120&, 1&, 4
83         LinkProc(7) = PG.n_heapAlloc + 120                                                  ' Label Sign: 0100000
84         CopyMemory ByVal VarPtr(LinkProc(20)) + 3, OrgWindowProc, 4&                        ' Label Sign: 0200000
85         LinkProc(22) = GetProcAddress(GetModuleHandle("user32.dll"), "CallWindowProcA")     ' Label Sign: 0300000
86
87         CopyMemory ByVal PG.n_heapAlloc&, LinkProc(0), 120&
88         i = PG.n_heapAlloc
89         Protlng = 128
90     End If
91
92     VirtualProtect ByVal i&, Protlng, &H40, mePtr
93     GetWndProcAddress = i
94 End Function
95
96 Function CallDefaultWindowProc(ByVal cHwnd As Long, ByVal Message As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
97     '调用窗口默认处理过程
98     CallDefaultWindowProc = CallWindowProc(PG.s_srcWndProcAddress, ByVal cHwnd&, ByVal Message&, ByVal wParam&, ByVal lParam&)
99 End Function
100
101 Function SetMsgHook(ByVal cHwnd As Long) As Long
102     '设置指定窗口的子类化
103     PG.s_Hwnd = cHwnd
104     PG.s_srcWndProcAddress = GetWindowLong(cHwnd, ByVal -4&)
105     SetWindowLong ByVal cHwnd, ByVal -4&, ByVal GetWndProcAddress(PG.s_srcWndProcAddress, 4)
106     SetMsgHook = PG.s_srcWndProcAddress
107 End Function
108
109 Sub SetMsgUnHook()
110     '取消窗口子类化
111     SetWindowLong ByVal PG.s_Hwnd&, ByVal -4&, ByVal PG.s_srcWndProcAddress&
112 End Sub
113
114 Private Sub Class_Terminate()
115 '    If PG.n_heapAlloc Then HeapDestroy (PG.n_heapAlloc)
116 '   还有最后这一点小瑕疵，应该把这个内存释放代码放到内嵌的汇编代码中去释放，懒得弄了，这会有一点的内存浪费
117 End Sub
118
119
120 ''ComCallBack proc hWnd,Msg,wParam,lParam
121 ''
122 ''    LOCAL Result
123 ''    push lParam
124 ''    push wParam
125 ''    push Msg
126 ''    push hWnd
127 ''
128 ''    mov eax,4000h                       ; 调试模式, app.logmode
129 ''    .if !eax
130 ''        mov ecx,1000h                   ; 临时存储区
131 ''        mov eax, Msg
132 ''        .if eax == WM_DESTROY
133 ''            mov dword ptr [ecx],0
134 ''
135 ''        .elseif eax==WM_NCACTIVATE
136 ''            mov eax, wParam
137 ''            mov [ecx], eax
138 ''        .elseif eax == 0105ah
139 ''            mov dword ptr [ecx],1
140 ''        .endif
141 ''
142 ''        .if dword ptr [ecx] ==1
143 ''            jmp @F
144 ''        .endif
145 ''
146 ''        push 2000h                  ; 默认窗口处理函数地址
147 ''        mov eax,3000h                   ; callwindowproc 函数地址
148 ''        Call eax
149 ''
150 ''    .else
151 ''        @@:
152 ''        lea eax, Result
153 ''        push eax
154 ''        push 5000h                  ; objptr(me)
155 ''        mov eax, 6000h                  ; me.subentry
156 ''        Call eax
157 ''        mov eax, Result
158 ''    .endif
159 ''ExitProc:   ret
160 ''
161 ''ComCallBack endp
162

iSubClass 一向是以精简的代码实现的子类化，但一直存在一个大问题就是无法保证调试的安全性；

IDE崩溃是很烦人的，即便有最最方便的最最精简的效率最高的代码实现了单类模块子类化，用起来也很难受。

此代码在我的系统中实现了无崩溃，即调试运行》按 ■ 按钮直接停止运行，而不会崩溃。

我还是把代码公布出来了，目的在于共同讨论下，他的实现方法，网上很流行的那个一大堆代码实现的无崩溃子类

他的方法其实不是很好，一点都不自由，而且最要命的是效率问题，多实现几个子类，就会很卡

另外还有一个问题会引起崩溃，暂时也未考虑解决他，当代码中包含错误代，调试时会被IDE自动暂停，此时按■强制停止就会导致崩溃

临时解决办法就是注释错误行，然后继续运行，然后再停止。。。

之所以没有解决他，因为需要对大量消息进行拦截判断状态，这样的话一是太影像效率，再者就是会吃掉太多消息

说下这个无崩溃的实现方法吧：

我先用spy监视了下窗口切换时的消息，最终使用了 WM_NCACTIVATEA 做为标志，和未知消息 &H105A，再有就是 WM_DESTORY

WM_NCACTIVATE 发生时，直接执行 CallWindowProc 默认过程，并设置了一个状态

&H105A 每次WM_NCACTIVATE 发生，且自己的程序窗口得到焦点或者说是被切换为活动状态时，会有这么一个消息发生

于是，我将这个消息做为关键点，当他发生时，改变WM_NCACTIVATE设置的状态，让他 Call 类中的方法

WM_DESTORY 当发生窗口销毁事件时，代码把之后的所有消息都劫持了，都发送到默认的窗口处理过程去

这样，就相当于没子类化，不过其实也就是浪费了几个消息而已，大多数的应用应该够了

关键点就这些；

另外还有一点就是，关于内嵌汇编所占用的128字节空间，不能保存在数组中了，必须单独开辟一个类销毁时，数据不被销毁的内存区域

这样才能实现不崩溃，但不好的地方在于这128字节的空间，没机会销毁了，我打算接下来这样修改，在 WM_NCDESTORY 消息中，销毁这个内存

目前还不敢肯定能成功，这个销毁其实只是内存不在占用的一个标记，数据部分并没有真正销毁，总之之后再说。。。

下面有测试代码，请大家试试，然后回复下测试环境，和是否成功的实现了无崩溃子类。

测试方法：调试运行 > 有个msgbox ,点确定关了就行 > 随便点两下按钮,然后直接点vb的 ■ 按钮,直接停止调试> 崩溃了吗?

附: 测试代码

(新版本) 支持Win7 , WinXP, 点此下载(<<<<点击下载)

(旧版本) http://files.cnblogs.com/pctgl/%e6%97%a0%e5%b4%a9%e6%ba%83%e5%ad%90%e7%b1%bb.rar

另外,大家有什么好的建议,请跟帖告之...........

本文链接

不谈技术，谈风月。。。

2010-04-30T13:46:00Z

剑者之剑

剑者为人，而剑为程式；

常见剑无异同，而人大不同；

有异者仗剑走天涯，所到之处无一不拜，然只仗剑着通晓其弊；

异者聪慧，心望亲正之；某日，双剑拼杀斗技之时，异者默声视；

但见，其一剑，花样百出，击之，打之，锤之，砸之，或火烧，或水沁，无所不用其极；

异者大喜，谓之高人也，其剑技法如花，用剑之所长，剑锋所到之处几有不破；

异者旁观，乃见剑异人时而冥，时而动，时而阅本；

异者见此，脱声道，此剑必方外之人，方才念铸剑之大功，定悔不知当初，剑之大成还看高人也；

少时，剑高人者，宝剑已出，光芒四射，英气逼人，果有大将之风，众人皆叹之；

有观者曰：但闻剑之高，在于铸就，然铸就高低，只此一观了以，今日一见果不虽然；

多时观者去多，异者喜之预亦往，念，多年仗剑，孰不知剑铸如此之便，待须时日，苦练技法必出人也；

忽见，观者奔走相望，往去者复之至剑异人处，但觉风起云涌，足下亦动；

少顷，剑异者托剑而出；剑高人者仗剑笑曰：尔等莫惊，必是那天孤星前来索剑，以镇天下安，尔等亦见得

此剑之锋，待吾与那剑异者对剑毕，吾愿奉此剑以慰天下；

剑异者微言以对，顿手抚剑，撇去皮卷，挺剑而竖；

众人大惊，此剑似与常剑无异，敢与争锋？

熟时，剑高人者，剑异人者双剑力打，只见似一道闪电自异剑中出，高剑碎段；

。。。

异者曰：儒之剑，异在何处？

剑异者道：吾之剑，无异；但凡铸剑者须知剑本有型，但其心，不在其表；阅本，吾可获识，随动，吾可通理，冥思，吾可制新；

一识，一理，一制新，凡剑不凡，宝剑必断；

异者闻之，心惊色免；大呼，铸剑之道，乃至其深，只知技法则只表其形，通识知理之日，是为制新亮剑之时。

此文有感于，最近看到的无限大标题，什么宇宙首发，地球首发的。。。

太大了，受不了，也看过某某在国内某论坛嚷他的软件已经把某语言某组件发挥到极致了，结果嘛。。。。。

那些大标题的作者，在网上的论坛中，有过简单的接触，从他的言语中就能看出来他到底有多大能耐

垃圾到什么地步，我也看不出他们所谓的那么多高明之处到底有什么可炫耀的

此文所表达的意思其实很清楚，学编程应该从理论开始学习，经过实践，才能推陈出新，沉迷于使用某一语言所提供的那些功能，你学100年

到头来也只是象上面小短文中说的那样。这是我的一家之言，此文也献给那些钻研书海的朋友们，编程不是写代码的斗争，是知识的斗争

只有学了才能会，只有实践了才能理解，只有融汇贯通之后才能推陈出新。

传言，不会数据库的程序员不算程序员，不会算法的程序员不是好的程序员；我是很赞成的，但我也同时要补充一下，算法这个东西

你用高级语言写了一堆代码，实现了某个计算的快速要求，就可以沾沾自喜了吗？绝对是井底之蛙，如果你会汇编多看看汇编角度实现

某个算法的代码，他的含义，他的原理，他所表达的智慧的精妙，绝对是高级语言不可比拟的。

另外，windows 程序员，如果连很多基本的系统知识都没有，那就和垃圾中的垃圾没什么两样，就象有人说 &H80000 处的内存地址是否

可操作，要看程序内存占用是否超过8M一样，都是垃圾中的垃圾。

本文链接

博客园_PctGL SERIES

启用本机 WiFi 热点

Vasm3 ···

一个简单的模仿系统的下拉列表颜色选择控件 《ColorComboBox》

机器码转存VB6代码,方便写内嵌汇编代码

无崩溃子类化的实现

不谈技术，谈风月。。。

一个简单的模仿系统的下拉列表颜色选择控件《ColorComboBox》