VB 无组件发邮件（QQ、163、126、tom）教程

1.最终界面如下图

http://s2/mw690/8439a4e5gdc206a8d9ee1&690无组件发邮件（QQ、163、126、tom）教程（一）- 亲测可行" TITLE="VB 无组件发邮件（QQ、163、126、tom）教程（一）- 亲测可行" />


2.控件名字如下图
http://s10/mw690/8439a4e5gdc206c427669&690无组件发邮件（QQ、163、126、tom）教程（一）- 亲测可行" TITLE="VB 无组件发邮件（QQ、163、126、tom）教程（一）- 亲测可行" />

3.combo1的列表框内容如下4个

smtp.qq.com
smtp.163.com
smtp.126.com
smtp.tom.com

4.打开这个窗口的代码区  复制下列内容

Option Explicit
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private 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
Private Const SW_SHOWNORMAL = 1
Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type
    Dim NameSpace As String
    Dim Email As Object

Private Sub Command1_Click()
On Error GoTo err
If Text1 = "" Then
List1.AddItem ">> Ne友情提示：请输入正确的收件箱...."
Exit Sub
Else
List1.AddItem ">> 正向 " & Text1 & " 发送邮件,请稍等....."
End If
    NameSpace = "http://schemas.microsoft.com/cdo/configuration/"
    Set Email = CreateObject("CDO.Message")
    Email.From = Text2  '发件邮箱
    Email.To = Text1 '收件邮箱
    Email.Subject = Text5   '邮件主题
    Email.Textbody = Text6   '邮件内容

    With Email.Configuration.Fields
        .Item(NameSpace & "sendusing") = 2
        .Item(NameSpace & "smtpserver") = Combo1.Text   'smtp服务器，QQ的是：smtp.qq.com
        .Item(NameSpace & "smtpserverport") = 25      '端口，不要改！
        .Item(NameSpace & "smtpauthenticate") = 1
        .Item(NameSpace & "sendusername") = Text3   '邮箱用户名（QQ的对应QQ号）
        .Item(NameSpace & "sendpassword") = Text4   '邮箱密码（QQ的对应邮箱密码）
        .Update
    End With
   
    If Text6 = "" Then
    Exit Sub
    Else
    Email.AddAttachment "" & Text7   '附
    End If
 Email.Send
List1.AddItem ">> 已向 " & Text1 & " 发送一封邮件..."
err:
If Error <> "" Then
List1.AddItem ">> 出现错误 : " & Error
End If
End Sub

Private Sub Command2_Click()                  ' 保存
    Open "setting.ini" For Output As #1
        Print #1, Text1
        Print #1, Text2
        Print #1, Text3
        Print #1, Text4
        Print #1, Text5
        Print #1, Text6
        Print #1, Text7
        Print #1, Combo1.Text
        '............
    Close #1
End Sub

Private Sub Command3_Click()
MsgBox "注意事项 1、如果没有选择附件时，收件箱会收到一个 1 个字节的附件，大家大可放心此文件,这是微软公司默认的 !" & vbCrLf & vbCrLf & _
       " 2、程序仅供学习参考,请勿用于非法用途、病毒木马的传播、垃圾邮箱,否则后果自负 !" & vbCrLf & vbCrLf & _
       " 3、本教程网上转载，感谢原作者！", 64
End Sub

Private Sub Command4_Click()
Text1 = ""
Text2 = ""
Text3 = ""
Text4 = ""
Text5 = ""
Text6 = ""
Text7 = ""
Combo1.Text = "Smtp.qq.com"
End Sub

Private Sub Command5_Click()
On Error Resume Next
Dim Tmp As OPENFILENAME
Dim rtn As Long
Dim APICmdlg As String
Tmp.lStructSize = Len(Tmp)
Tmp.hwndOwner = Me.hwnd
Tmp.hInstance = App.hInstance
Tmp.lpstrFilter = "所有文件 (*.*)" + Chr$(0) + "*.*" + Chr$(0)
Tmp.lpstrFile = Space(254)
Tmp.nMaxFile = 255
Tmp.lpstrFileTitle = Space(254)
Tmp.nMaxFileTitle = 255
Tmp.lpstrInitialDir = App.Path
Tmp.lpstrTitle = "打开文件"
Tmp.flags = 6148
rtn = GetOpenFileName(Tmp)
If rtn >= 1 Then
    APICmdlg = Tmp.lpstrFile
    Text7.Text = APICmdlg
End If
End Sub
'Download by http://www.codefans.net
Private Sub Form_Load()
On Error GoTo err
Call MSkinner.Attach(Me.hwnd)
Dim s1, s2, s3, s4, s5, s6, s7, s8
If Dir("setting.ini", vbSystem) <> "" Then
    Open "setting.ini" For Input As #1
    Line Input #1, s1
    Line Input #1, s2
    Line Input #1, s3
    Line Input #1, s4
    Line Input #1, s5
    Line Input #1, s6
    Line Input #1, s7
    Line Input #1, s8
    Close #1
Text1 = s1
Text2 = s2
Text3 = s3
Text4 = s4
Text5 = s5
Text6 = s6
Text7 = s7
Combo1.Text = s8
End If
err:
If Error <> "" Then
List1.AddItem ">> 程序加载时出现错误：" & Error
End If
End Sub

Private Sub List1_DblClick()
List1.Clear
End Sub
5.添加一个模块名字 MSkinner  如图

http://s12/mw690/8439a4e5gdc206e22476b&690无组件发邮件（QQ、163、126、tom）教程（一）- 亲测可行" TITLE="VB 无组件发邮件（QQ、163、126、tom）教程（一）- 亲测可行" />


6.模块里添加如下代码

Option Explicit           '调用：'Call MSkinner.Attach(Me.hwnd)

Private Type POINTAPI
        X As Long
        Y As Long
End Type

Private Type RECT
        Left        As Long
        Top         As Long
        Right       As Long
        Bottom      As Long
End Type

Private Type RECTW
        Left                As Long
        Top                 As Long
        Right               As Long
        Bottom              As Long
        Width               As Long
        Height              As Long
End Type

Private Type PAINTSTRUCT
        hDC                 As Long
        fErase              As Long
        rcPaint             As RECT
        fRestore            As Long
        fIncUpdate          As Long
        rgbReserved(32)     As Byte
End Type

Private Type HDITEM
        mask                As Long
        cxy                 As Long
        pszText             As String
        hbm                 As Long
        cchTextMax          As Long
        fmt                 As Long
        IntPtr              As Long
End Type

Private Type TRACKMOUSEEVENTTYPE
    cbSize      As Long
    dwFlags     As Long
    hwndTrack   As Long
    dwHoverTime As Long
End Type

Private Type WINDOWPOS
   hwnd                     As Long
   hWndInsertAfter          As Long
   X                        As Long
   Y                        As Long
   cx                       As Long
   cy                       As Long
   flags                    As Long
End Type

Private Type NCCALCSIZE_PARAMS
   rgrc(0 To 2)             As RECT
   lppos                    As Long
End Type

Private Type DRAWITEMSTRUCT
        CtlType As Long
        CtlID As Long
        itemID As Long
        itemAction As Long
        itemState As Long
        hwndItem As Long
        hDC As Long
        rcItem As RECT
        itemData As Long
End Type

Private Enum DTSTYLE
    DT_LEFT = &H0
    DT_TOP = &H0
    DT_CENTER = &H1
    DT_RIGHT = &H2
    DT_VCENTER = &H4
    DT_BOTTOM = &H8
    DT_WORDBREAK = &H10
    DT_SINGLELINE = &H20
    DT_EXPANDTABS = &H40
    DT_TABSTOP = &H80
    DT_NOCLIP = &H100
    DT_EXTERNALLEADING = &H200
    DT_CALCRECT = &H400
    DT_NOPREFIX = &H800
    DT_INTERNAL = &H1000
    DT_EDITCONTROL = &H2000
    DT_PATH_ELLIPSIS = &H4000
    DT_FORE_ELLIPSIS = &H8000
    DT_END_ELLIPSIS = &H8000&
    DT_MODIFYSTRING = &H10000
    DT_RTLREADING = &H20000
    DT_WORD_ELLIPSIS = &H40000
End Enum

Private Const GWL_WNDPROC = (-4)
Private Const GWL_STYLE = (-16)
Private Const GWL_EXSTYLE = (-20)

Private Const WM_ACTIVATE                   As Long = &H6
Private Const WM_ACTIVATEAPP                As Long = &H1C
Private Const WM_ASKCBFORMATNAME            As Long = &H30C
Private Const WM_CANCELJOURNAL              As Long = &H4B
Private Const WM_CANCELMODE                 As Long = &H1F
Private Const WM_CHANGECBCHAIN              As Long = &H30D
Private Const WM_CHAR                       As Long = &H102
Private Const WM_CHARTOITEM                 As Long = &H2F
Private Const WM_CHILDACTIVATE              As Long = &H22
Private Const WM_CLEAR                      As Long = &H303
Private Const WM_CLOSE                      As Long = &H10
Private Const WM_COMMAND                    As Long = &H111
Private Const WM_COMMNOTIFY                 As Long = &H44
Private Const WM_COMPACTING                 As Long = &H41
Private Const WM_COMPAREITEM                As Long = &H39
Private Const WM_CONVERTREQUESTEX           As Long = &H108
Private Const WM_COPY                       As Long = &H301
Private Const WM_COPYDATA                   As Long = &H4A
Private Const WM_CREATE                     As Long = &H1
Private Const WM_CUT                        As Long = &H300
Private Const WM_DEADCHAR                   As Long = &H103
Private Const WM_DELETEITEM                 As Long = &H2D
Private Const WM_DESTROY                    As Long = &H2
Private Const WM_DESTROYCLIPBOARD           As Long = &H307
Private Const WM_DEVMODECHANGE              As Long = &H1B
Private Const WM_DRAWCLIPBOARD              As Long = &H308
Private Const WM_DRAWITEM                   As Long = &H2B
Private Const WM_DROPFILES                  As Long = &H233
Private Const WM_ENABLE                     As Long = &HA
Private Const WM_ENDSESSION                 As Long = &H16
Private Const WM_ENTERIDLE                  As Long = &H121
Private Const WM_ENTERMENULOOP              As Long = &H211
Private Const WM_ERASEBKGND                 As Long = &H14
Private Const WM_EXITMENULOOP               As Long = &H212
Private Const WM_FONTCHANGE                 As Long = &H1D
Private Const WM_GETDLGCODE                 As Long = &H87
Private Const WM_GETFONT                    As Long = &H31
Private Const WM_GETHOTKEY                  As Long = &H33
Private Const WM_GETMINMAXINFO              As Long = &H24
Private Const WM_GETTEXT                    As Long = &HD
Private Const WM_GETTEXTLENGTH              As Long = &HE
Private Const WM_HOTKEY                     As Long = &H312
Private Const WM_HSCROLL                    As Long = &H114
Private Const WM_HSCROLLCLIPBOARD           As Long = &H30E
Private Const WM_ICONERASEBKGND             As Long = &H27
Private Const WM_IME_CHAR                   As Long = &H286
Private Const WM_IME_COMPOSITION            As Long = &H10F
Private Const WM_IME_COMPOSITIONFULL        As Long = &H284
Private Const WM_IME_CONTROL                As Long = &H283
Private Const WM_IME_ENDCOMPOSITION         As Long = &H10E
Private Const WM_IME_KEYDOWN                As Long = &H290
Private Const WM_IME_KEYLAST                As Long = &H10F
Private Const WM_IME_KEYUP                  As Long = &H291
Private Const WM_IME_NOTIFY                 As Long = &H282
Private Const WM_IME_SELECT                 As Long = &H285
Private Const WM_IME_SETCONTEXT             As Long = &H281
Private Const WM_IME_STARTCOMPOSITION       As Long = &H10D
Private Const WM_INITDIALOG                 As Long = &H110
Private Const WM_INITMENU                   As Long = &H116
Private Const WM_INITMENUPOPUP              As Long = &H117
Private Const WM_KEYDOWN                    As Long = &H100
Private Const WM_KEYFIRST                   As Long = &H100
Private Const WM_KEYLAST                    As Long = &H108
Private Const WM_KEYUP                      As Long = &H101
Private Const WM_KILLFOCUS                  As Long = &H8
Private Const WM_LBUTTONDBLCLK              As Long = &H203
Private Const WM_LBUTTONDOWN                As Long = &H201
Private Const WM_LBUTTONUP                  As Long = &H202
Private Const WM_MBUTTONDBLCLK              As Long = &H209
Private Const WM_MBUTTONDOWN                As Long = &H207
Private Const WM_MBUTTONUP                  As Long = &H208
Private Const WM_MDIACTIVATE                As Long = &H222
Private Const WM_MDICASCADE                 As Long = &H227
Private Const WM_MDICREATE                  As Long = &H220
Private Const WM_MDIDESTROY                 As Long = &H221
Private Const WM_MDIGETACTIVE               As Long = &H229
Private Const WM_MDIICONARRANGE             As Long = &H228
Private Const WM_MDIMAXIMIZE                As Long = &H225
Private Const WM_MDINEXT                    As Long = &H224
Private Const WM_MDIREFRESHMENU             As Long = &H234
Private Const WM_MDIRESTORE                 As Long = &H223
Private Const WM_MDISETMENU                 As Long = &H230
Private Const WM_MDITILE                    As Long = &H226
Private Const WM_MEASUREITEM                As Long = &H2C
Private Const WM_MENUCHAR                   As Long = &H120
Private Const WM_MENUSELECT                 As Long = &H11F
Private Const WM_MOUSEACTIVATE              As Long = &H21
Private Const WM_MOUSEFIRST                 As Long = &H200
Private Const WM_MOUSELAST                  As Long = &H209
Private Const WM_MOUSELEAVE                 As Long = &H2A3
Private Const WM_MOUSEWHEEL                 As Long = &H20A
Private Const WM_MOUSEMOVE                  As Long = &H200
Private Const WM_MOVE                       As Long = &H3
Private Const WM_NEXTDLGCTL                 As Long = &H28
Private Const WM_NULL                       As Long = &H0
Private Const WM_OTHERWINDOWCREATED         As Long = &H42               '  no longer suported
Private Const WM_OTHERWINDOWDESTROYED       As Long = &H43             '  no longer suported
Private Const WM_PAINT                      As Long = &HF
Private Const WM_PAINTCLIPBOARD             As Long = &H309
Private Const WM_PAINTICON                  As Long = &H26
Private Const WM_PALETTECHANGED             As Long = &H311
Private Const WM_PALETTEISCHANGING          As Long = &H310
Private Const WM_PARENTNOTIFY               As Long = &H210
Private Const WM_PASTE                      As Long = &H302
Private Const WM_PENWINFIRST                As Long = &H380
Private Const WM_PENWINLAST                 As Long = &H38F
Private Const WM_POWER                      As Long = &H48
Private Const WM_USER                       As Long = &H400
Private Const WM_PSD_ENVSTAMPRECT           As Long = (WM_USER + 5)
Private Const WM_PSD_FULLPAGERECT           As Long = (WM_USER + 1)
Private Const WM_PSD_GREEKTEXTRECT          As Long = (WM_USER + 4)
Private Const WM_PSD_MARGINRECT             As Long = (WM_USER + 3)
Private Const WM_PSD_MINMARGINRECT          As Long = (WM_USER + 2)
Private Const WM_PSD_PAGESETUPDLG           As Long = (WM_USER)
Private Const WM_PSD_YAFULLPAGERECT         As Long = (WM_USER + 6)
Private Const WM_QUERYDRAGICON              As Long = &H37
Private Const WM_QUERYENDSESSION            As Long = &H11
Private Const WM_QUERYNEWPALETTE            As Long = &H30F
Private Const WM_QUERYOPEN                  As Long = &H13
Private Const WM_QUEUESYNC                  As Long = &H23
Private Const WM_QUIT                       As Long = &H12
Private Const WM_RBUTTONDBLCLK              As Long = &H206
Private Const WM_RBUTTONDOWN                As Long = &H204
Private Const WM_RBUTTONUP                  As Long = &H205
Private Const WM_RENDERALLFORMATS           As Long = &H306
Private Const WM_RENDERFORMAT               As Long = &H305
Private Const WM_SETCURSOR                  As Long = &H20
Private Const WM_SETFOCUS                   As Long = &H7
Private Const WM_SETFONT                    As Long = &H30
Private Const WM_SETHOTKEY                  As Long = &H32
Private Const WM_SETREDRAW                  As Long = &HB
Private Const WM_SETTEXT                    As Long = &HC
Private Const WM_SHOWWINDOW                 As Long = &H18
Private Const WM_SIZE                       As Long = &H5
Private Const WM_SIZECLIPBOARD              As Long = &H30B
Private Const WM_SPOOLERSTATUS              As Long = &H2A
Private Const WM_SYSCHAR                    As Long = &H106
Private Const WM_SYSCOLORCHANGE             As Long = &H15
Private Const WM_SYSCOMMAND                 As Long = &H112
Private Const WM_SYSDEADCHAR                As Long = &H107
Private Const WM_SYSKEYDOWN                 As Long = &H104
Private Const WM_SYSKEYUP                   As Long = &H105
Private Const WM_STYLECHANGED               As Long = &H7D
Private Const WM_TIMECHANGE                 As Long = &H1E
Private Const WM_TIMER                      As Long = &H113
Private Const WM_UNDO                       As Long = &H304
Private Const WM_VKEYTOITEM                 As Long = &H2E
Private Const WM_VSCROLL                    As Long = &H115
Private Const WM_VSCROLLCLIPBOARD           As Long = &H30A
Private Const WM_WINDOWPOSCHANGED           As Long = &H47
Private Const WM_WINDOWPOSCHANGING          As Long = &H46
Private Const WM_WININICHANGE               As Long = &H1A
Private Const WM_CHOOSEFONT_GETLOGFONT      As Long = (WM_USER + 1)
Private Const WM_CHOOSEFONT_SETFLAGS        As Long = (WM_USER + 102)
Private Const WM_CHOOSEFONT_SETLOGFONT      As Long = (WM_USER + 101)
Private Const WM_DDE_FIRST                  As Long = &H3E0
Private Const WM_DDE_ACK                    As Long = (WM_DDE_FIRST + 4)
Private Const WM_DDE_ADVISE                 As Long = (WM_DDE_FIRST + 2)
Private Const WM_DDE_DATA                   As Long = (WM_DDE_FIRST + 5)
Private Const WM_DDE_EXECUTE                As Long = (WM_DDE_FIRST + 8)
Private Const WM_DDE_INITIATE               As Long = (WM_DDE_FIRST)
Private Const WM_DDE_LAST                   As Long = (WM_DDE_FIRST + 8)
Private Const WM_DDE_POKE                   As Long = (WM_DDE_FIRST + 7)
Private Const WM_DDE_REQUEST                As Long = (WM_DDE_FIRST + 6)
Private Const WM_DDE_TERMINATE              As Long = (WM_DDE_FIRST + 1)
Private Const WM_DDE_UNADVISE               As Long = (WM_DDE_FIRST + 3)

Private Const WM_NCACTIVATE                 As Long = &H86
Private Const WM_NCCALCSIZE                 As Long = &H83
Private Const WM_NCCREATE                   As Long = &H81
Private Const WM_NCDESTROY                  As Long = &H82
Private Const WM_NCHITTEST                  As Long = &H84
Private Const WM_NCLBUTTONDBLCLK            As Long = &HA3
Private Const WM_NCLBUTTONDOWN              As Long = &HA1
Private Const WM_NCLBUTTONUP                As Long = &HA2
Private Const WM_NCMBUTTONDBLCLK            As Long = &HA9
Private Const WM_NCMBUTTONDOWN              As Long = &HA7
Private Const WM_NCMBUTTONUP                As Long = &HA8
Private Const WM_NCMOUSEMOVE                As Long = &HA0
Private Const WM_NCPAINT                    As Long = &H85
Private Const WM_NCRBUTTONDBLCLK            As Long = &HA6
Private Const WM_NCRBUTTONDOWN              As Long = &HA4
Private Const WM_NCRBUTTONUP                As Long = &HA5
Private Const WM_NCPOPUPMENU                As Long = &HAE

Private Const WM_CTLCOLOR                   As Long = &H19
Private Const WM_CTLCOLORBTN                As Long = &H135
Private Const WM_CTLCOLORDLG                As Long = &H136
Private Const WM_CTLCOLOREDIT               As Long = &H133
Private Const WM_CTLCOLORLISTBOX            As Long = &H134
Private Const WM_CTLCOLORMSGBOX             As Long = &H132
Private Const WM_CTLCOLORSCROLLBAR          As Long = &H137
Private Const WM_CTLCOLORSTATIC             As Long = &H138

Private Const HDM_FIRST                     As Long = &H1200
Private Const HDM_CLEARFILTER               As Long = (HDM_FIRST + 24)
Private Const HDM_CREATEDRAGIMAGE           As Long = (HDM_FIRST + 16)
Private Const HDM_DELETEITEM                As Long = (HDM_FIRST + 2)
Private Const HDM_EDITFILTER                As Long = (HDM_FIRST + 23)
Private Const HDM_GETBITMAPMARGIN           As Long = (HDM_FIRST + 21)
Private Const HDM_GETIMAGELIST              As Long = (HDM_FIRST + 9)
Private Const HDM_GETITEMA                  As Long = (HDM_FIRST + 3)
Private Const HDM_GETITEMCOUNT              As Long = (HDM_FIRST + 0)
Private Const HDM_GETITEMRECT               As Long = (HDM_FIRST + 7)
Private Const HDM_GETITEMW                  As Long = (HDM_FIRST + 11)
Private Const HDM_GETORDERARRAY             As Long = (HDM_FIRST + 17)
Private Const HDM_HITTEST                   As Long = (HDM_FIRST + 6)
Private Const HDM_INSERTITEMA               As Long = (HDM_FIRST + 1)
Private Const HDM_INSERTITEMW               As Long = (HDM_FIRST + 10)
Private Const HDM_LAYOUT                    As Long = (HDM_FIRST + 5)
Private Const HDM_ORDERTOINDEX              As Long = (HDM_FIRST + 15)
Private Const HDM_SETBITMAPMARGIN           As Long = (HDM_FIRST + 20)
Private Const HDM_SETFILTERCHANGETIMEOUT    As Long = (HDM_FIRST + 22)
Private Const HDM_SETHOTDIVIDER             As Long = (HDM_FIRST + 19)
Private Const HDM_SETIMAGELIST              As Long = (HDM_FIRST + 8)
Private Const HDM_SETITEMA                  As Long = (HDM_FIRST + 4)
Private Const HDM_SETITEMW                  As Long = (HDM_FIRST + 12)
Private Const HDM_SETORDERARRAY             As Long = (HDM_FIRST + 18)
Private Const HDM_SETUNICODEFORMAT          As Long = &H2005
Private Const HDM_GETUNICODEFORMAT          As Long = &H2006

Private Const HDI_BITMAP                    As Long = &H10
Private Const HDI_DI_SETITEM                As Long = &H40
Private Const HDI_FILTER                    As Long = &H100
Private Const HDI_FORMAT                    As Long = &H4
Private Const HDI_WIDTH                     As Long = &H1
Private Const HDI_HEIGHT                    As Long = HDI_WIDTH
Private Const HDI_HIDDEN                    As Long = (&H1)
Private Const HDI_IMAGE                     As Long = &H20
Private Const HDI_LPARAM                    As Long = &H8
Private Const HDI_ORDER                     As Long = &H80
Private Const HDI_TEXT                      As Long = &H2

Private Const MK_LBUTTON                    As Long = &H1
Private Const MK_MBUTTON                    As Long = &H10
Private Const MK_RBUTTON                    As Long = &H2

Private Const WS_BORDER                     As Long = &H800000
Private Const WS_VSCROLL                    As Long = &H200000
Private Const WS_HSCROLL                    As Long = &H100000
Private Const WS_EX_CLIENTEDGE              As Long = &H200&

Private Const SM_CXVSCROLL                  As Long = &H2
Private Const SM_CYVSCROLL                  As Long = &H14
Private Const SM_CXHSCROLL                  As Long = &H15
Private Const SM_CYHSCROLL                  As Long = &H3
Private Const SM_CXDLGFRAME                 As Long = &H7
Private Const SM_CYDLGFRAME                 As Long = &H8
Private Const SM_CXCHECKBOX                 As Long = &H47
Private Const SM_CYCHECKBOX                 As Long = &H48

Private Const CB_SHOWDROPDOWN               As Long = &H14F
Private Const CB_GETDROPPEDSTATE            As Long = &H157

Private Const PBM_GETPOS                    As Long = (WM_USER + 8)
Private Const PBM_SETBARCOLOR               As Long = (WM_USER + 9)
Private Const PBS_SMOOTH                    As Long = &H1
Private Const PBS_VERTICAL                  As Long = &H4

Private Const BM_GETCHECK                   As Long = &HF0
Private Const BM_SETCHECK                   As Long = &HF1
Private Const BM_GETSTATE                   As Long = &HF2
Private Const BM_SETSTYLE                   As Long = &HF4

Private Const BS_NULL                       As Long = 1
Private Const BS_3STATE                     As Long = &H5&
Private Const BS_AUTO3STATE                 As Long = &H6&
Private Const BS_AUTOCHECKBOX               As Long = &H3&
Private Const BS_AUTORADIOBUTTON            As Long = &H9&
Private Const BS_CHECKBOX                   As Long = &H2&
Private Const BS_DEFPUSHBUTTON              As Long = &H1&
Private Const BS_DIBPATTERN                 As Long = 5
Private Const BS_DIBPATTERN8X8              As Long = 8
Private Const BS_DIBPATTERNPT               As Long = 6
Private Const BS_GROUPBOX                   As Long = &H7&
Private Const BS_HATCHED                    As Long = 2
Private Const BS_HOLLOW                     As Long = BS_NULL
Private Const BS_INDEXED                    As Long = 4
Private Const BS_LEFTTEXT                   As Long = &H20&
Private Const BS_OWNERDRAW                  As Long = &HB&
Private Const BS_PATTERN                    As Long = 3
Private Const BS_PATTERN8X8                 As Long = 7
Private Const BS_PUSHBUTTON                 As Long = &H0&
Private Const BS_RADIOBUTTON                As Long = &H4&
Private Const BS_SOLID                      As Long = 0
Private Const BS_USERBUTTON                 As Long = &H8&

Private Const LBS_OWNERDRAWVARIABLE = &H20&
Private Const CBS_OWNERDRAWVARIABLE = &H20&

Private Const ODT_BUTTON = 4
Private Const ODT_COMBOBOX = 3
Private Const ODT_HEADER = 100
Private Const ODT_LISTBOX = 2
Private Const ODT_LISTVIEW = 102
Private Const ODT_MENU = 1
Private Const ODT_STATIC = 5
Private Const ODT_TAB = 101

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
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
Private Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Function CreateHalftonePalette Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function SelectPalette Lib "gdi32" (ByVal hDC As Long, ByVal hPalette As Long, ByVal bForceBackground As Long) As Long
Private Declare Function RealizePalette Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Private Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, lColorRef As Long) As Long

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function IsWindowEnabled Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function IsWindowUnicode Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function BeginPaint Lib "user32" (ByVal hwnd As Long, lpPaint As PAINTSTRUCT) As Long
Private Declare Function EndPaint Lib "user32" (ByVal hwnd As Long, lpPaint As PAINTSTRUCT) As Long
Private Declare Function TrackMouseEvent Lib "user32.dll" (ByRef lpEventTrack As TRACKMOUSEEVENTTYPE) As Long ' Win98 or later
Private Declare Function TrackMouseEvent2 Lib "comctl32.dll" Alias "_TrackMouseEvent" (ByRef lpEventTrack As TRACKMOUSEEVENTTYPE) As Long ' Win95 w/ IE 3.0
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function RedrawWindow Lib "user32" (ByVal hwnd As Long, lprcUpdate As Any, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long

Private Declare Function CreateDCAsNull Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, lpDeviceName As Any, lpOutput As Any, lpInitData As Any) As Long
Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Any) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private 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
Private Declare Function StretchBlt Lib "gdi32" (ByVal hDC 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function AlphaBlend Lib "msimg32" (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 widthSrc As Long, ByVal heightSrc As Long, ByVal blendFunct As Long) As Boolean
Private Declare Function GetTextColor Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hDC As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function GetBkColor Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hDC As Long, ByVal nBkMode As Long) As Long
Private Declare Function DrawFocusRect Lib "user32" (ByVal hDC As Long, lpRect As RECT) As Long
Private Declare Function GetFocus Lib "user32" () As Long
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function FrameRect Lib "user32" (ByVal hDC As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hDC As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private 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
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT, ByVal bErase As Long) As Long
Private Declare Function RoundRect Lib "gdi32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long

Private m_Init              As Boolean  '保存是否已经初始化
Private m_hBtnSrcDC         As Long
Private m_hCbbSrcDC         As Long
Private m_hCkbSrcDC         As Long
Private m_hOpbSrcDC         As Long
Private m_hHdbSrcDC         As Long
Private m_bTrackHandler32   As Boolean
Private m_SubclassCount     As Long     '保存子类化的个数，以便在销毁所有窗口和按钮之后可以释放资源

Public Function Attach(ByVal hwnd As Long) As Long
    If m_Init = False Then  '如果没有初始化，则初始化
        m_Init = True
        m_bTrackHandler32 = IsFunctionSupported("TrackMouseEvent", "User32")
        Call pInit
    End If
    Attach = pAttach(hwnd)
End Function

Public Function Detach(ByVal hwnd As Long) As Long
    Detach = pDetach(hwnd)
End Function

Private Function pAttach(ByVal hwnd As Long) As Long
If hwnd = 0 Then Exit Function
    If GetProp(hwnd, "PROCADDR") Then Exit Function
    Dim sClassName  As String
    sClassName = LCase(pGetClassName(hwnd))
    Select Case sClassName
        '=====================================================================================
        Case "#32770", "thunderformdc", "thunderrt6formdc", "form"
            Call EnumChildWindows(hwnd, AddressOf pEnumChildProc, ByVal 0&)
           
        '=====================================================================================
        Case "thundercommandbutton", "thunderrt6commandbutton", "button"
            Dim I           As Long
            Dim m_hDC       As Long
            Dim m_mDC(3)    As Long
            Dim m_BMP(3)    As Long
            Dim m_wRect     As RECTW
            Dim m_dwStyle   As Long
            m_hDC = GetWindowDC(hwnd)
            pGetWindowRectW hwnd, m_wRect
            For I = 0 To 3
                m_mDC(I) = CreateCompatibleDC(m_hDC)
                m_BMP(I) = CreateCompatibleBitmap(m_hDC, m_wRect.Width, m_wRect.Height)
                DeleteObject SelectObject(m_mDC(I), m_BMP(I))
                SetProp hwnd, "HDC" & CStr(I), m_mDC(I)
                SetProp hwnd, "BMP" & CStr(I), m_BMP(I)
            Next
            Call pDrawMemDC(hwnd)
            ReleaseDC hwnd, m_hDC
            m_dwStyle = GetWindowLong(hwnd, GWL_STYLE)
            If (m_dwStyle And BS_CHECKBOX) Or (m_dwStyle And BS_RADIOBUTTON) Then
            Else
                SendMessage hwnd, BM_SETSTYLE, BS_OWNERDRAW, ByVal True
            End If
            SetProp hwnd, "OLDSTYLE", m_dwStyle         '保存按钮旧的风格,以便再取消皮肤的时候恢复原来的风格
            SetProp hwnd, "MOUSEFLAG", 0
            SetProp hwnd, "TIMERID", 0
            SetProp hwnd, "OLDSTATE", IIf(IsWindowEnabled(hwnd), 0, 3)
            SetProp hwnd, "ALPHALEVEL", 0
            SetWindowRgn hwnd, CreateRoundRectRgn(0, 0, m_wRect.Width + 1, m_wRect.Height + 1, 3, 3), True
           
        '=====================================================================================
        Case "thundercombobox", "thunderrt6combobox", "combo", "combobox", "thunderdrivelistbox", "thunderrt6drivelistbox", _
             "thundercheckbox", "thunderrt6checkbox", "thunderoptionbutton", "thunderrt6optionbutton"
            SetProp hwnd, "MOUSEFLAG", 0
            SetProp hwnd, "OLDSTATE", 0
       
        '=====================================================================================
        Case "progressbar20wndclass", "progressbarwndclass"
            'Call pGetWindowRectW(hWnd, m_wRect)
            'SetWindowRgn hWnd, CreateRoundRectRgn(0, 0, m_wRect.Width + 1, m_wRect.Height + 1, 3, 3), False
       
        '=====================================================================================
        Case "msvb_lib_header", "sysheader32"
            SetProp hwnd, "MOUSEFLAG", 0
            SetProp hwnd, "HDINDEX", -1
            SetProp hwnd, "HMINDEX", -1
           
        '=====================================================================================
        Case Else
   
    End Select
    m_SubclassCount = m_SubclassCount + 1
    SetProp hwnd, "PROCADDR", SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
    SendMessage hwnd, WM_NCPAINT, 1&, 0&
    RedrawWindow hwnd, ByVal 0&, ByVal 0&, &H1 Or &H2
    pAttach = 1
End Function

一篇写不开了   见下一篇