home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / ucBrowse_-20887810282007.psc / Controls / ucBrowse.ctl
Text File  |  2007-10-28  |  74KB  |  1,247 lines
  1. VERSION 5.00
  2. Begin VB.UserControl ucBrowse 
  3.    Appearance      =   0  'Flat
  4.    AutoRedraw      =   -1  'True
  5.    BackColor       =   &H80000005&
  6.    ClientHeight    =   3600
  7.    ClientLeft      =   0
  8.    ClientTop       =   0
  9.    ClientWidth     =   4800
  10.    Picture         =   "ucBrowse.ctx":0000
  11.    ScaleHeight     =   240
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   320
  14.    ToolboxBitmap   =   "ucBrowse.ctx":1A632
  15. End
  16. Attribute VB_Name = "ucBrowse"
  17. Attribute VB_GlobalNameSpace = False
  18. Attribute VB_Creatable = True
  19. Attribute VB_PredeclaredId = False
  20. Attribute VB_Exposed = False
  21. '+  File Description:
  22. '       ucBrowse - SelfSubclassed System Browse For Folder UserControl
  23. '
  24. '   Product Name:
  25. '       ucBrowse.ctl
  26. '
  27. '   Compatability:
  28. '       Windows: 98(?), ME(?), NT, 2000, XP
  29. '
  30. '   Software Developed by:
  31. '       Paul R. Territo, Ph.D
  32. '
  33. '   Based on the following On-Line Articles
  34. '       (Paul Caton - Self-Subclassser)
  35. '           http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=54117&lngWId=1
  36. '       (MrBoBo - System Treeview Thievery)
  37. '           http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=40007&lngWId=1
  38. '       (Randy Birch - IsWinXP)
  39. '           http://vbnet.mvps.org/code/system/getversionex.htm
  40. '       (Dieter Otter - GetCurrentThemeName)
  41. '           http://www.vbarchiv.net/archiv/tipp_805.html
  42. '       (Randy Birch / Brad Martinez - TreeView CheckBoxes)
  43. '           http://vbnet.mvps.org/index.html?code/comctl/tvcheckbox.htm
  44. '       (Randy Birch - TreeView Special Effects)
  45. '           http://vbnet.mvps.org/code/comctl/tveffects.htm
  46. '       (Randy Birch - Special Folders)
  47. '           http://vbnet.mvps.org/index.html?code/callback/browsecallbackcdrom.htm
  48. '
  49. '   Legal Copyright & Trademarks:
  50. '       Copyright ⌐ 2006-2007, by Paul R. Territo, Ph.D, All Rights Reserved Worldwide
  51. '       Trademark Ö 2006-2007, by Paul R. Territo, Ph.D, All Rights Reserved Worldwide
  52. '
  53. '   Comments:
  54. '       No claims or warranties are expressed or implied as to accuracy or fitness
  55. '       for use of this software. Paul R. Territo, Ph.D shall not be liable
  56. '       for any incidental or consequential damages suffered by any use of
  57. '       this  software. This software is owned by Paul R. Territo, Ph.D and is
  58. '       free for use in accordance with the terms of the License Agreement
  59. '       in the accompanying the documentation.
  60. '
  61. '   Contact Information:
  62. '       For Technical Assistance:
  63. '       Email: pwterrito@insightbb.com
  64. '
  65. '-  Modification(s) History:
  66. '       14Jul06 - Initial TestHarness and UserControl finished
  67. '       12Oct07 - Added additonal cleanup routines to allow for dynamic
  68. '                 root changing
  69. '               - Added Reset routine to reset the control
  70. '               - Added additional error checking for shutdown to prevent reloads
  71. '                 which cause the control to appear to hang (actually does not
  72. '                 hang, but the focus has been set back to the hidden BFF window)
  73. '               - Added CoTaskMemFree API to allow for freeing of BFF Pointer
  74. '       16Oct07 - Added HasButtons property and associated window style properties
  75. '               - Added HideSelection property to fix focus managment issues pointed out by Carles P.V.
  76. '               - Added IsWin2K to determine if unicode is available
  77. '               - Added SHBrowseForFolderW and SHGetPathFromIDListW for Unicode Support
  78. '       28Oct07 - Added IsFolder method to prevent incorrect qualifying the files
  79. '                 passed back by QualifyPath method....thanks to Ruturaj for catching this!!
  80. '               - Added IsFile method (Logical opposite of IsFolder).
  81. '
  82. '
  83. '   Force Declarations
  84. Option Explicit
  85.  
  86. '   Build Date & Time: 10/28/2007 8:05:13 PM
  87. Const Major As Long = 1
  88. Const Minor As Long = 0
  89. Const Revision As Long = 50
  90. Const DateTime As String = "10/28/2007 8:05:13 PM"
  91.  
  92. Private Type OSVERSIONINFO
  93.     OSVSize         As Long             'size, in bytes, of this data structure
  94.     dwVerMajor      As Long             'ie NT 3.51, dwVerMajor = 3; NT 4.0, dwVerMajor = 4.
  95.     dwVerMinor      As Long             'ie NT 3.51, dwVerMinor = 51; NT 4.0, dwVerMinor= 0.
  96.     dwBuildNumber   As Long             'NT: build number of the OS
  97.                                         'Win9x: build number of the OS in low-order word.
  98.                                         '       High-order word contains major & minor ver nos.
  99.     PlatformID      As Long             'Identifies the operating system platform.
  100.     szCSDVersion    As String * 128     'NT: string, such as "Service Pack 3"
  101.                                         'Win9x: string providing arbitrary additional information
  102. End Type
  103.  
  104. Private Const VER_PLATFORM_WIN32_NT = 2
  105.  
  106. Private Const BIF_STATUSTEXT = &H4&
  107. Private Const BIF_RETURNONLYFSDIRS = 1
  108. Private Const MAX_PATH = 260
  109. Private Const WM_USER = &H400
  110. Private Const BFFM_INITIALIZED = 1
  111. Private Const BFFM_SELCHANGED = 2
  112. Private Const BFFM_SETSELECTION = (WM_USER + 102)
  113. Private Const WM_MOVE = &H3
  114. Private Const LMEM_FIXED = &H0
  115. Private Const LMEM_ZEROINIT = &H40
  116. Private Const LPTR = (LMEM_FIXED Or LMEM_ZEROINIT)
  117.  
  118. Private Type RECT
  119.     Left As Long
  120.     Top As Long
  121.     Right As Long
  122.     Bottom As Long
  123. End Type
  124.  
  125. 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
  126. Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
  127. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  128. Private Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long
  129. Private Declare Function EnableWindow Lib "user32" (ByVal hWnd As Long, ByVal fEnable As Long) As Long
  130. Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  131. Private Declare Function FrameRect Lib "user32" (ByVal hDC As Long, lpRect As RECT, ByVal hBrush As Long) As Long
  132. Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
  133. Private Declare Function GetCurrentThemeName Lib "uxtheme.dll" (ByVal pszThemeFileName As String, ByVal dwMaxNameChars As Integer, ByVal pszColorBuff As String, ByVal cchMaxColorChars As Integer, ByVal pszSizeBuff As String, ByVal cchMaxSizeChars As Integer) As Long
  134. Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
  135. Private Declare Function GetDesktopWindow Lib "user32" () As Long
  136. Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As Any) As Long
  137. Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
  138. Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  139. Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
  140. Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
  141. Private Declare Function LocalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal uBytes As Long) As Long
  142. Private Declare Function lStrCat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
  143. Private Declare Function MoveWindow Lib "user32" (ByVal hWnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
  144. Private Declare Function OleTranslateColor Lib "OLEPRO32.DLL" (ByVal OLE_COLOR As Long, ByVal HPALETTE As Long, pccolorref As Long) As Long
  145. Private Declare Function PathIsDirectory Lib "shlwapi" Alias "PathIsDirectoryA" (ByVal pszPath As String) As Long
  146. Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
  147. Private Declare Function PutFocus Lib "user32" Alias "SetFocus" (ByVal hWnd As Long) As Long
  148. Private 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
  149. Private Declare Function SetBkColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
  150. Private Declare Function SetFocus Lib "user32" (ByVal hWnd As Long) As Long
  151. Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
  152. Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  153. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  154. Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BROWSEINFO) As Long
  155. Private Declare Function SHBrowseForFolderW Lib "shell32" (lpbi As BROWSEINFO) As Long
  156. Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
  157. Private Declare Function SHGetPathFromIDListW Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
  158. Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
  159. Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
  160. Private Declare Sub 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)
  161.  
  162. Private Const GW_NEXT = 2
  163. Private Const GW_CHILD = 5
  164. Private Const WM_CLOSE = &H10
  165.  
  166. '   Window Constants
  167. Private Const GWL_STYLE             As Long = (-16)
  168. Private Const GWL_EXSTYLE           As Long = (-20)
  169. Private Const WH_CALLWNDPROC        As Long = 4
  170. Private Const WS_BORDER             As Long = &H800000
  171. Private Const WS_EX_CLIENTEDGE      As Long = &H200
  172. Private Const WS_EX_STATICEDGE      As Long = &H20000
  173. Private Const SWP_NOMOVE            As Long = &H2
  174. Private Const SWP_NOSIZE            As Long = &H1
  175. Private Const SWP_FRAMECHANGED      As Long = &H20
  176. Private Const SWP_NOACTIVATE        As Long = &H10
  177. Private Const SWP_NOZORDER          As Long = &H4
  178. Private Const SWP_DRAWFRAME         As Long = SWP_FRAMECHANGED
  179. Private Const SWP_FLAGS             As Long = SWP_NOZORDER Or SWP_NOSIZE Or SWP_NOMOVE Or SWP_DRAWFRAME
  180.  
  181. '   Standard TreeView Message Bits
  182. '(http://windowssdk.msdn.microsoft.com/en-us/library/ms650019.aspx)
  183. Private Const TV_FIRST              As Long = &H1100
  184. Private Const TVM_GETNEXTITEM       As Long = (TV_FIRST + 10)
  185. Private Const TVM_GETITEM           As Long = (TV_FIRST + 12)
  186. Private Const TVM_SETITEM           As Long = (TV_FIRST + 13)
  187. Private Const TVM_SETBKCOLOR        As Long = (TV_FIRST + 29)
  188. Private Const TVM_SETTEXTCOLOR      As Long = (TV_FIRST + 30)
  189. Private Const TVM_GETBKCOLOR        As Long = (TV_FIRST + 31)
  190. Private Const TVM_GETTEXTCOLOR      As Long = (TV_FIRST + 32)
  191.  
  192. Private Const TVS_CHECKBOXES        As Long = &H100
  193. Private Const TVS_DISABLEDRAGDROP   As Long = &H10
  194. Private Const TVS_EDITLABELS        As Long = &H8
  195. Private Const TVS_FULLROWSELECT     As Long = &H1000
  196. Private Const TVS_HASBUTTONS        As Long = &H1
  197. Private Const TVS_HASLINES          As Long = &H2
  198. Private Const TVS_INFOTIP           As Long = &H800
  199. Private Const TVS_LINESATROOT       As Long = &H4
  200. Private Const TVS_NOHSCROLL         As Long = &H8000
  201. Private Const TVS_NONEVENHEIGHT     As Long = &H4000
  202. Private Const TVS_NOSCROLL          As Long = &H2000
  203. Private Const TVS_NOTOOLTIPS        As Long = &H80
  204. Private Const TVS_SHOWSELALWAYS     As Long = &H20
  205. Private Const TVS_SINGLEEXPAND      As Long = &H400
  206. Private Const TVS_TRACKSELECT       As Long = &H200
  207.  
  208.  
  209. '   Special Folder Flags
  210. Private Const CSIDL_DESKTOP = &H0
  211. Private Const CSIDL_INTERNET = &H1
  212. Private Const CSIDL_PROGRAMS = &H2
  213. Private Const CSIDL_CONTROLS = &H3
  214. Private Const CSIDL_PRINTERS = &H4
  215. Private Const CSIDL_PERSONAL = &H5
  216. Private Const CSIDL_FAVORITES = &H6
  217. Private Const CSIDL_STARTUP = &H7
  218. Private Const CSIDL_RECENT = &H8
  219. Private Const CSIDL_SENDTO = &H9
  220. Private Const CSIDL_BITBUCKET = &HA
  221. Private Const CSIDL_STARTMENU = &HB
  222. Private Const CSIDL_MYDOCUMENTS = &HC
  223. Private Const CSIDL_MYMUSIC = &HD
  224. Private Const CSIDL_MYVIDEO = &HE
  225. Private Const CSIDL_DESKTOPDIRECTORY = &H10
  226. Private Const CSIDL_DRIVES = &H11
  227. Private Const CSIDL_NETWORK = &H12
  228. Private Const CSIDL_NETHOOD = &H13
  229. Private Const CSIDL_FONTS = &H14
  230. Private Const CSIDL_TEMPLATES = &H15
  231. Private Const CSIDL_COMMON_STARTMENU = &H16
  232. Private Const CSIDL_COMMON_PROGRAMS = &H17
  233. Private Const CSIDL_COMMON_STARTUP = &H18
  234. Private Const CSIDL_COMMON_DESKTOPDIRECTORY = &H19
  235. Private Const CSIDL_APPDATA = &H1A
  236. Private Const CSIDL_PRINTHOOD = &H1B
  237. Private Const CSIDL_LOCAL_APPDATA = &H1C
  238. Private Const CSIDL_ALTSTARTUP = &H1D
  239. Private Const CSIDL_COMMON_ALTSTARTUP = &H1E
  240. Private Const CSIDL_COMMON_FAVORITES = &H1F
  241. Private Const CSIDL_INTERNET_CACHE = &H20
  242. Private Const CSIDL_COOKIES = &H21
  243. Private Const CSIDL_HISTORY = &H22
  244. Private Const CSIDL_COMMON_APPDATA = &H23
  245. Private Const CSIDL_WINDOWS = &H24
  246. Private Const CSIDL_SYSTEM = &H25
  247. Private Const CSIDL_PROGRAM_FILES = &H26
  248. Private Const CSIDL_MYPICTURES = &H27
  249. Private Const CSIDL_PROFILE = &H28
  250. Private Const CSIDL_SYSTEMX86 = &H29
  251. Private Const CSIDL_PROGRAM_FILESX86 = &H2A
  252. Private Const CSIDL_PROGRAM_FILES_COMMON = &H2B
  253. Private Const CSIDL_PROGRAM_FILES_COMMONX86 = &H2C
  254. Private Const CSIDL_COMMON_TEMPLATES = &H2D
  255. Private Const CSIDL_COMMON_DOCUMENTS = &H2E
  256. Private Const CSIDL_COMMON_ADMINTOOLS = &H2F
  257. Private Const CSIDL_ADMINTOOLS = &H30
  258. Private Const CSIDL_CONNECTIONS = &H31
  259. Private Const CSIDL_COMMON_MUSIC = &H35
  260. Private Const CSIDL_COMMON_PICTURES = &H36
  261. Private Const CSIDL_COMMON_VIDEO = &H37
  262. Private Const CSIDL_RESOURCES = &H38
  263. Private Const CSIDL_RESOURCES_LOCALIZED = &H39
  264. Private Const CSIDL_COMMON_OEM_LINKS = &H3A
  265. Private Const CSIDL_CDBURN_AREA = &H3B
  266. Private Const CSIDL_COMPUTERSNEARME = &H3D
  267. Private Const CSIDL_FLAG_PER_USER_INIT = &H800
  268. Private Const CSIDL_FLAG_NO_ALIAS = &H1000
  269. Private Const CSIDL_FLAG_DONT_VERIFY = &H4000
  270. Private Const CSIDL_FLAG_CREATE = &H8000
  271. Private Const CSIDL_FLAG_MASK = &HFF00
  272.  
  273. Private Type BROWSEINFO
  274.     hwndOwner      As Long
  275.     pIDLRoot       As Long
  276.     pszDisplayName As Long
  277.     lpszTitle      As Long
  278.     ulFlags        As ubFolderDialogFlags
  279.     lpfnCallback   As Long
  280.     lParam         As Long
  281.     iImage         As Long
  282. End Type
  283.  
  284. Public Enum ubFolderDialogFlags
  285.     ReturnOnlyFSDirs = &H1
  286.     DontGoBelowDomain = &H2
  287.     StatusText = &H4
  288.     ReturnFSAncestors = &H8
  289.     EditBox = &H10
  290.     Validate = &H20
  291.     NewDialogStyle = &H40
  292.     UseNewUI = (NewDialogStyle Or EditBox)
  293.     BrowseIncludeURLs = &H80
  294.     UAHInt = &H100
  295.     NoneWFolderButton = &H200
  296.     NoTranslateTargets = &H400
  297.     BrowseForComputer = &H1000
  298.     BrowseForPrinter = &H2000
  299.     BrowseIncludeFiles = &H4000
  300.     Shareable = &H8000
  301.     ShowFolder_Default = ReturnOnlyFSDirs Or StatusText Or BrowseForComputer
  302. End Enum
  303. #If False Then
  304.     Const ReturnOnlyFSDirs = &H1
  305.     Const DontGoBelowDomain = &H2
  306.     Const StatusText = &H4
  307.     Const ReturnFSAncestors = &H8
  308.     Const EditBox = &H10
  309.     Const Validate = &H20
  310.     Const NewDialogStyle = &H40
  311.     Const UseNewUI = (NewDialogStyle Or EditBox)
  312.     Const BrowseIncludeURLs = &H80
  313.     Const UAHInt = &H100
  314.     Const NoneWFolderButton = &H200
  315.     Const NoTranslateTargets = &H400
  316.     Const BrowseForComputer = &H1000
  317.     Const BrowseForPrinter = &H2000
  318.     Const BrowseIncludeFiles = &H4000
  319.     Const Shareable = &H8000
  320.     Const ShowFolder_Default = ReturnOnlyFSDirs Or StatusText Or BrowseForComputer
  321. #End If
  322.  
  323. Public Enum ubAppearanceEnum
  324.     [ubFlat] = &H0
  325.     [ub3D] = &H1
  326. End Enum
  327. #If False Then
  328.     Const ubFlat = &H0
  329.     Const ub3D = &H1
  330. #End If
  331.  
  332. Public Enum ucSpecialFoldersEnum
  333.     AdminTools = CSIDL_ADMINTOOLS
  334.     AltStartUp = CSIDL_ALTSTARTUP
  335.     ApplicationData = CSIDL_APPDATA
  336.     CDBurnArea = CSIDL_CDBURN_AREA
  337.     CommonAdminTools = CSIDL_COMMON_ADMINTOOLS
  338.     CommonAltStartUp = CSIDL_COMMON_ALTSTARTUP
  339.     CommonAppData = CSIDL_COMMON_APPDATA
  340.     CommonDesktopDirectory = CSIDL_COMMON_DESKTOPDIRECTORY
  341.     CommonFavorites = CSIDL_COMMON_FAVORITES
  342.     CommonMyDocuments = CSIDL_COMMON_DOCUMENTS
  343.     CommonMyMusic = CSIDL_COMMON_MUSIC
  344.     CommonMyPictures = CSIDL_COMMON_PICTURES
  345.     CommonMyVideo = CSIDL_COMMON_VIDEO
  346.     CommonProgramFiles = CSIDL_PROGRAM_FILES_COMMON
  347.     CommonPrograms = CSIDL_COMMON_PROGRAMS
  348.     CommonStartMenu = CSIDL_COMMON_STARTMENU
  349.     CommonStartUp = CSIDL_COMMON_STARTUP
  350.     CommonTemplates = CSIDL_COMMON_TEMPLATES
  351.     ComputersNearMe = CSIDL_COMPUTERSNEARME
  352.     Connections = CSIDL_CONNECTIONS
  353.     ControlPanel = CSIDL_CONTROLS
  354.     DeskTop = CSIDL_DESKTOP
  355.     DesktopDirectory = CSIDL_DESKTOPDIRECTORY
  356.     Favorites = CSIDL_FAVORITES
  357.     Fonts = CSIDL_FONTS
  358.     Internet = CSIDL_INTERNET
  359.     InternetCache = CSIDL_INTERNET_CACHE
  360.     InternetCookies = CSIDL_COOKIES
  361.     InternetHistory = CSIDL_HISTORY
  362.     LocalApplicationData = CSIDL_LOCAL_APPDATA
  363.     LocalizedResources = CSIDL_RESOURCES_LOCALIZED
  364.     MyComputer = CSIDL_DRIVES
  365.     MyDocuments = CSIDL_MYDOCUMENTS
  366.     MyDocumentsFolder = CSIDL_PERSONAL
  367.     MyMusic = CSIDL_MYMUSIC
  368.     MyNetworkPlaces = CSIDL_NETHOOD
  369.     MyPictures = CSIDL_MYPICTURES
  370.     MyVideo = CSIDL_MYVIDEO
  371.     NetworkNeighborhood = CSIDL_NETWORK
  372.     Printers = CSIDL_PRINTERS
  373.     PrintHood = CSIDL_PRINTHOOD
  374.     Profile = CSIDL_PROFILE
  375.     Programs = CSIDL_PROGRAMS
  376.     ProgramsFiles = CSIDL_PROGRAM_FILES
  377.     Recent = CSIDL_RECENT
  378.     RecycleBin = CSIDL_BITBUCKET
  379.     SendTo = CSIDL_SENDTO
  380.     StartMenu = CSIDL_STARTMENU
  381.     StartUp = CSIDL_STARTUP
  382.     System = CSIDL_SYSTEM
  383.     SystemResources = CSIDL_RESOURCES
  384.     Templates = CSIDL_TEMPLATES
  385.     Windows = CSIDL_WINDOWS
  386. End Enum
  387. #If False Then
  388.     Const AdminTools = CSIDL_ADMINTOOLS
  389.     Const AltStartUp = CSIDL_ALTSTARTUP
  390.     Const ApplicationData = CSIDL_APPDATA
  391.     Const CDBurnArea = CSIDL_CDBURN_AREA
  392.     Const CommonAdminTools = CSIDL_COMMON_ADMINTOOLS
  393.     Const CommonAltStartUp = CSIDL_COMMON_ALTSTARTUP
  394.     Const CommonAppData = CSIDL_COMMON_APPDATA
  395.     Const CommonDesktopDirectory = CSIDL_COMMON_DESKTOPDIRECTORY
  396.     Const CommonFavorites = CSIDL_COMMON_FAVORITES
  397.     Const CommonMyDocuments = CSIDL_COMMON_DOCUMENTS
  398.     Const CommonMyMusic = CSIDL_COMMON_MUSIC
  399.     Const CommonMyPictures = CSIDL_COMMON_PICTURES
  400.     Const CommonMyVideo = CSIDL_COMMON_VIDEO
  401.     Const CommonProgramFiles = CSIDL_PROGRAM_FILES_COMMON
  402.     Const CommonPrograms = CSIDL_COMMON_PROGRAMS
  403.     Const CommonStartMenu = CSIDL_COMMON_STARTMENU
  404.     Const CommonStartUp = CSIDL_COMMON_STARTUP
  405.     Const CommonTemplates = CSIDL_COMMON_TEMPLATES
  406.     Const ComputersNearMe = CSIDL_COMPUTERSNEARME
  407.     Const Connections = CSIDL_CONNECTIONS
  408.     Const ControlPanel = CSIDL_CONTROLS
  409.     Const DeskTop = CSIDL_DESKTOP
  410.     Const DesktopDirectory = CSIDL_DESKTOPDIRECTORY
  411.     Const Favorites = CSIDL_FAVORITES
  412.     Const Fonts = CSIDL_FONTS
  413.     Const Internet = CSIDL_INTERNET
  414.     Const InternetCache = CSIDL_INTERNET_CACHE
  415.     Const InternetCookies = CSIDL_COOKIES
  416.     Const InternetHistory = CSIDL_HISTORY
  417.     Const LocalApplicationData = CSIDL_LOCAL_APPDATA
  418.     Const LocalizedResources = CSIDL_RESOURCES_LOCALIZED
  419.     Const MyComputer = CSIDL_DRIVES
  420.     Const MyDocuments = CSIDL_MYDOCUMENTS
  421.     Const MyDocumentsFolder = CSIDL_PERSONAL
  422.     Const MyMusic = CSIDL_MYMUSIC
  423.     Const MyNetworkPlaces = CSIDL_NETHOOD
  424.     Const MyPictures = CSIDL_MYPICTURES
  425.     Const MyVideo = CSIDL_MYVIDEO
  426.     Const NetworkNeighborhood = CSIDL_NETWORK
  427.     Const Printers = CSIDL_PRINTERS
  428.     Const PrintHood = CSIDL_PRINTHOOD
  429.     Const Profile = CSIDL_PROFILE
  430.     Const Programs = CSIDL_PROGRAMS
  431.     Const ProgramsFiles = CSIDL_PROGRAM_FILES
  432.     Const Recent = CSIDL_RECENT
  433.     Const RecycleBin = CSIDL_BITBUCKET
  434.     Const SendTo = CSIDL_SENDTO
  435.     Const StartMenu = CSIDL_STARTMENU
  436.     Const StartUp = CSIDL_STARTUP
  437.     Const System = CSIDL_SYSTEM
  438.     Const SystemResources = CSIDL_RESOURCES
  439.     Const Templates = CSIDL_TEMPLATES
  440.     Const Windows = CSIDL_WINDOWS
  441. #End If
  442.  
  443. Public Enum ubThemeEnum
  444.     [ubAuto] = &H0
  445.     [ubClassic] = &H1
  446.     [ubBlue] = &H2
  447.     [ubHomeStead] = &H3
  448.     [ubMetallic] = &H4
  449.     [ubNone] = &H5
  450. End Enum
  451. #If False Then
  452.     Const ubAuto = &H0
  453.     Const ubClassic = &H1
  454.     Const ubBlue = &H2
  455.     Const ubHomeStead = &H3
  456.     Const ubMetallic = &H4
  457.     Const ubNone = &H4
  458. #End If
  459.  
  460. '   Private variables
  461. Private bInternal As Boolean
  462. Private bPathChanged As Boolean
  463. Private m_Appearance As ubAppearanceEnum
  464. Private m_CancelButtonWindow As Long
  465. Private m_CheckBoxes As Boolean
  466. Private m_DialogWindow As Long
  467. Private m_Enabled As Boolean
  468. Private m_FolderFlags As ubFolderDialogFlags
  469. Private m_FullRowSelect As Boolean
  470. Private m_HasButtons As Boolean
  471. Private m_HasLines As Boolean
  472. Private m_HideSelection As Boolean
  473. Private m_HotTracking As Boolean
  474. Private m_Path As String
  475. Private m_Root As ucSpecialFoldersEnum
  476. Private m_SysTreeWindow As Long
  477. Private m_Theme As ubThemeEnum
  478.  
  479. Private WithEvents SDIHost As Form
  480. Attribute SDIHost.VB_VarHelpID = -1
  481. Private WithEvents MDIHost As MDIForm
  482. Attribute MDIHost.VB_VarHelpID = -1
  483.  
  484. '==================================================================================================
  485. ' ucSubclass - A template UserControl for control authors that require self-subclassing without ANY
  486. '              external dependencies. IDE safe.
  487. '
  488. ' Paul_Caton@hotmail.com
  489. ' Copyright free, use and abuse as you see fit.
  490. '
  491. ' v1.0.0000 20040525 First cut.....................................................................
  492. ' v1.1.0000 20040602 Multi-subclassing version.....................................................
  493. ' v1.1.0001 20040604 Optimized the subclass code...................................................
  494. ' v1.1.0002 20040607 Substituted byte arrays for strings for the code buffers......................
  495. ' v1.1.0003 20040618 Re-patch when adding extra hWnds..............................................
  496. ' v1.1.0004 20040619 Optimized to death version....................................................
  497. ' v1.1.0005 20040620 Use allocated memory for code buffers, no need to re-patch....................
  498. ' v1.1.0006 20040628 Better protection in zIdx, improved comments..................................
  499. ' v1.1.0007 20040629 Fixed InIDE patching oops.....................................................
  500. ' v1.1.0008 20040910 Fixed bug in UserControl_Terminate, zSubclass_Proc procedure hidden...........
  501. '==================================================================================================
  502. 'Subclasser declarations
  503.  
  504. Public Event MouseEnter()
  505. Public Event MouseLeave()
  506. Public Event Status(ByVal sStatus As String)
  507. Public Event PathChange(ByVal sPath As String)
  508.  
  509. Private Const WM_ENABLE                 As Long = &HA
  510. Private Const WM_EXITSIZEMOVE           As Long = &H232
  511. Private Const WM_LBUTTONDOWN            As Long = &H201
  512. Private Const WM_LBUTTONUP              As Long = &H202
  513. Private Const WM_MOUSELEAVE             As Long = &H2A3
  514. Private Const WM_MOUSEMOVE              As Long = &H200
  515. Private Const WM_MOVING                 As Long = &H216
  516. Private Const WM_RBUTTONDBLCLK          As Long = &H206
  517. Private Const WM_RBUTTONDOWN            As Long = &H204
  518. Private Const WM_SIZING                 As Long = &H214
  519. Private Const WM_SYSCOLORCHANGE         As Long = &H15
  520. Private Const WM_THEMECHANGED           As Long = &H31A
  521. 'Private Const WM_USER                   As Long = &H400
  522.  
  523.  
  524. Private Enum TRACKMOUSEEVENT_FLAGS
  525.     TME_HOVER = &H1&
  526.     TME_LEAVE = &H2&
  527.     TME_QUERY = &H40000000
  528.     TME_CANCEL = &H80000000
  529. End Enum
  530.  
  531. Private Type TRACKMOUSEEVENT_STRUCT
  532.     cbSize                             As Long
  533.     dwFlags                            As TRACKMOUSEEVENT_FLAGS
  534.     hwndTrack                          As Long
  535.     dwHoverTime                        As Long
  536. End Type
  537.  
  538. Private bTrack                       As Boolean
  539. Private bTrackUser32                 As Boolean
  540. Private bInCtrl                      As Boolean
  541. Private bSubClass                    As Boolean
  542.  
  543. Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
  544. Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lpLibFileName As String) As Long
  545. Private Declare Function TrackMouseEvent Lib "user32" (lpEventTrack As TRACKMOUSEEVENT_STRUCT) As Long
  546. Private Declare Function TrackMouseEventComCtl Lib "Comctl32" Alias "_TrackMouseEvent" (lpEventTrack As TRACKMOUSEEVENT_STRUCT) As Long
  547.  
  548. Private Enum eMsgWhen
  549.     MSG_AFTER = 1                                                                   'Message calls back after the original (previous) WndProc
  550.     MSG_BEFORE = 2                                                                  'Message calls back before the original (previous) WndProc
  551.     MSG_BEFORE_AND_AFTER = MSG_AFTER Or MSG_BEFORE                                  'Message calls back before and after the original (previous) WndProc
  552. End Enum
  553.  
  554. Private Const ALL_MESSAGES           As Long = -1                                   'All messages added or deleted
  555. Private Const GMEM_FIXED             As Long = 0                                    'Fixed memory GlobalAlloc flag
  556. Private Const GWL_WNDPROC            As Long = -4                                   'Get/SetWindow offset to the WndProc procedure address
  557. Private Const PATCH_04               As Long = 88                                   'Table B (before) address patch offset
  558. Private Const PATCH_05               As Long = 93                                   'Table B (before) entry count patch offset
  559. Private Const PATCH_08               As Long = 132                                  'Table A (after) address patch offset
  560. Private Const PATCH_09               As Long = 137                                  'Table A (after) entry count patch offset
  561.  
  562. Private Type tSubData                                                               'Subclass data type
  563.     hWnd                               As Long                                      'Handle of the window being subclassed
  564.     nAddrSub                           As Long                                      'The address of our new WndProc (allocated memory).
  565.     nAddrOrig                          As Long                                      'The address of the pre-existing WndProc
  566.     nMsgCntA                           As Long                                      'Msg after table entry count
  567.     nMsgCntB                           As Long                                      'Msg before table entry count
  568.     aMsgTblA()                         As Long                                      'Msg after table array
  569.     aMsgTblB()                         As Long                                      'Msg Before table array
  570. End Type
  571.  
  572. Private sc_aSubData()                As tSubData                                    'Subclass data array
  573.  
  574. Private Declare Sub RtlMoveMemory Lib "kernel32" (Destination As Any, Source As Any, ByVal Length As Long)
  575. Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long
  576. Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
  577. Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
  578. Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
  579. Private Declare Function SetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  580.  
  581. '======================================================================================================
  582. 'Subclass handler - MUST be the first Public routine in this file. That includes public properties also
  583. Public Sub zSubclass_Proc(ByVal bBefore As Boolean, ByRef bHandled As Boolean, ByRef lReturn As Long, ByRef lng_hWnd As Long, ByRef uMsg As Long, ByRef wParam As Long, ByRef lParam As Long)
  584.     'Parameters:
  585.         'bBefore  - Indicates whether the the message is being processed before or after the default handler - only really needed if a message is set to callback both before & after.
  586.         'bHandled - Set this variable to True in a 'before' callback to prevent the message being subsequently processed by the default handler... and if set, an 'after' callback
  587.         'lReturn  - Set this variable as per your intentions and requirements, see the MSDN documentation for each individual message value.
  588.         'hWnd     - The window handle
  589.         'uMsg     - The message number
  590.         'wParam   - Message related data
  591.         'lParam   - Message related data
  592.     'Notes:
  593.         'If you really know what you're doing, it's possible to change the values of the
  594.         'hWnd, uMsg, wParam and lParam parameters in a 'before' callback so that different
  595.         'values get passed to the default handler.. and optionaly, the 'after' callback
  596.     Dim lpIDList As Long
  597.     Dim lRet As Long
  598.     Dim sBuffer As String
  599.     Dim hWndA As Long
  600.     Dim ClassWindow As String * 14
  601.     Dim ClassCaption As String * 100
  602.     Dim lOffset As Long
  603.     
  604.     '   See if the Path has been set via property but it did not take effect because
  605.     '   the DialogWindow was not created yet.....this can occure if the control is set
  606.     '   at runtime, but the host object is created but not visible yet! If this is the
  607.     '   case the m_DialogWindow = 0 and bPathChanged = False....if we are setting the
  608.     '   path at runtime, but the control and host are visible then bPathChanged = True
  609.     If (m_DialogWindow) And (bPathChanged = False) And (Len(m_Path) > 0) And (m_Path <> "\") Then
  610. '        Call SendMessage(m_DialogWindow, BFFM_SETSELECTION, 1, m_Path)
  611. '        bPathChanged = True
  612.     End If
  613.     
  614.     Select Case uMsg
  615.         Case BFFM_INITIALIZED
  616.             m_DialogWindow = lng_hWnd 'Handle of BrowseForFolder dialog
  617.             'Move the whole  BrowseForFolder dialog off screen
  618.             Call MoveWindow(m_DialogWindow, -Screen.Width, 0, 480, 480, True)
  619.             'Set it's initial path
  620.             Call SendMessage(m_DialogWindow, BFFM_SETSELECTION, 1, m_Path)
  621.             'Enumerate child windows
  622.             hWndA = GetWindow(lng_hWnd, GW_CHILD)
  623.             Do While hWndA <> 0
  624.                 GetClassName hWndA, ClassWindow, 14
  625.                 'Found a button
  626.                 If Left$(ClassWindow, 6) = "Button" Then
  627.                     GetWindowText hWndA, ClassCaption, 100
  628.                     '   If it's the Cancel button, remember it's
  629.                     '   handle so we can press it later
  630.                     If UCase(Left(ClassCaption, 6)) = "CANCEL" Then
  631.                         m_CancelButtonWindow = hWndA
  632.                     End If
  633.                 End If
  634.                 '   Here's what we're really after - it's Treeview!
  635.                 If Left(ClassWindow, 13) = "SysTreeView32" Then
  636.                     m_SysTreeWindow = hWndA
  637.                 End If
  638.                 hWndA = GetWindow(hWndA, GW_NEXT)
  639.             Loop
  640.             If m_SysTreeWindow <> 0 Then
  641.                 '   Steal the Treeview for our own use
  642.                 Call GrabSysTreeView
  643.                 '   Make the Window Flat so we can handle the
  644.                 '   Window Style Locally
  645.                 SetWindowStyle m_SysTreeWindow, ubFlat
  646.                 
  647.                 '   Now Sublass the RightMouseClick to kill the
  648.                 '   context menus
  649.                 Call Subclass_Start(m_SysTreeWindow)
  650.                 Call Subclass_AddMsg(m_SysTreeWindow, WM_RBUTTONDOWN, MSG_BEFORE_AND_AFTER)
  651.                 '   Now Refresh things
  652.                 Refresh
  653.             Else
  654.                 '   Close the Window to prevent hangs
  655.                 CloseUp
  656.                 '   Opps, we can not find the SystemTreeView
  657.                 Debug.Assert False
  658.             End If
  659.             RaiseEvent Status("SystemTreeView Initalized")
  660.             
  661.         Case BFFM_SELCHANGED
  662.             'Path has changed - better tell our form
  663.             sBuffer = Space$(MAX_PATH)
  664.             If Not IsWin2K Then
  665.                 lRet = SHGetPathFromIDList(ByVal wParam, ByVal sBuffer)
  666.             Else
  667.                 lRet = SHGetPathFromIDListW(ByVal wParam, ByVal sBuffer)
  668.             End If
  669.             If lRet Then
  670.                  'Trim off the null chars ending the path
  671.                  'and display the returned folder
  672.                  lOffset = InStr(sBuffer, Chr$(0))
  673.                  m_Path = QualifyPath(Left$(sBuffer, lOffset - 1))
  674.             Else
  675.                  m_Path = ""
  676.             End If
  677.             RaiseEvent PathChange(m_Path)
  678.             
  679.         Case WM_RBUTTONDOWN
  680.             If bBefore Then
  681.                 '   Supress the Right MouseClick for the SysTreeWindow
  682.                 '   This will eat the uMsg and prevent the popup window
  683.                 '   so we can show our own....
  684.                 bHandled = True
  685.                 lReturn = 0
  686.             Else
  687.             
  688.             End If
  689.             
  690.         Case WM_MOVE
  691.             TaskbarHide
  692.             
  693.         Case WM_CLOSE
  694.             CloseUp
  695.             
  696.     End Select
  697.     
  698. End Sub
  699.  
  700. '   Determine if the passed function is supported
  701. Private Function IsFunctionExported(ByVal sFunction As String, ByVal sModule As String) As Boolean
  702.     Dim hmod        As Long
  703.     Dim bLibLoaded  As Boolean
  704.  
  705.     hmod = GetModuleHandleA(sModule)
  706.  
  707.     If hmod = 0 Then
  708.         hmod = LoadLibraryA(sModule)
  709.         If hmod Then
  710.             bLibLoaded = True
  711.         End If
  712.     End If
  713.  
  714.     If hmod Then
  715.         If GetProcAddress(hmod, sFunction) Then
  716.             IsFunctionExported = True
  717.         End If
  718.     End If
  719.     If bLibLoaded Then
  720.         Call FreeLibrary(hmod)
  721.     End If
  722. End Function
  723.  
  724. '======================================================================================================
  725. 'Subclass code - The programmer may call any of the following Subclass_??? routines
  726.  
  727.     'Add a message to the table of those that will invoke a callback. You should Subclass_Subclass first and then add the messages
  728. Private Sub Subclass_AddMsg(ByVal lng_hWnd As Long, ByVal uMsg As Long, Optional ByVal When As eMsgWhen = MSG_AFTER)
  729.     'Parameters:
  730.         'lng_hWnd  - The handle of the window for which the uMsg is to be added to the callback table
  731.         'uMsg      - The message number that will invoke a callback. NB Can also be ALL_MESSAGES, ie all messages will callback
  732.         'When      - Whether the msg is to callback before, after or both with respect to the the default (previous) handler
  733.     With sc_aSubData(zIdx(lng_hWnd))
  734.         If When And eMsgWhen.MSG_BEFORE Then
  735.             Call zAddMsg(uMsg, .aMsgTblB, .nMsgCntB, eMsgWhen.MSG_BEFORE, .nAddrSub)
  736.         End If
  737.         If When And eMsgWhen.MSG_AFTER Then
  738.             Call zAddMsg(uMsg, .aMsgTblA, .nMsgCntA, eMsgWhen.MSG_AFTER, .nAddrSub)
  739.         End If
  740.     End With
  741. End Sub
  742.  
  743. 'Delete a message from the table of those that will invoke a callback.
  744. Private Sub Subclass_DelMsg(ByVal lng_hWnd As Long, ByVal uMsg As Long, Optional ByVal When As eMsgWhen = MSG_AFTER)
  745.     'Parameters:
  746.     'lng_hWnd  - The handle of the window for which the uMsg is to be removed from the callback table
  747.     'uMsg      - The message number that will be removed from the callback table. NB Can also be ALL_MESSAGES, ie all messages will callback
  748.     'When      - Whether the msg is to be removed from the before, after or both callback tables
  749.     With sc_aSubData(zIdx(lng_hWnd))
  750.         If When And eMsgWhen.MSG_BEFORE Then
  751.             Call zDelMsg(uMsg, .aMsgTblB, .nMsgCntB, eMsgWhen.MSG_BEFORE, .nAddrSub)
  752.         End If
  753.         If When And eMsgWhen.MSG_AFTER Then
  754.             Call zDelMsg(uMsg, .aMsgTblA, .nMsgCntA, eMsgWhen.MSG_AFTER, .nAddrSub)
  755.         End If
  756.     End With
  757. End Sub
  758.  
  759. 'Return whether we're running in the IDE.
  760. Private Function Subclass_InIDE() As Boolean
  761.     Debug.Assert zSetTrue(Subclass_InIDE)
  762. End Function
  763.  
  764. 'Start subclassing the passed window handle
  765. Private Function Subclass_Start(ByVal lng_hWnd As Long) As Long
  766.     'Parameters:
  767.     'lng_hWnd  - The handle of the window to be subclassed
  768.     'Returns;
  769.     'The sc_aSubData() index
  770.     Const CODE_LEN              As Long = 204                                       'Length of the machine code in bytes
  771.     Const FUNC_CWP              As String = "CallWindowProcA"                       'We use CallWindowProc to call the original WndProc
  772.     Const FUNC_EBM              As String = "EbMode"                                'VBA's EbMode function allows the machine code thunk to know if the IDE has stopped or is on a breakpoint
  773.     Const FUNC_SWL              As String = "SetWindowLongA"                        'SetWindowLongA allows the cSubclasser machine code thunk to unsubclass the subclasser itself if it detects via the EbMode function that the IDE has stopped
  774.     Const MOD_USER              As String = "user32"                                'Location of the SetWindowLongA & CallWindowProc functions
  775.     Const MOD_VBA5              As String = "vba5"                                  'Location of the EbMode function if running VB5
  776.     Const MOD_VBA6              As String = "vba6"                                  'Location of the EbMode function if running VB6
  777.     Const PATCH_01              As Long = 18                                        'Code buffer offset to the location of the relative address to EbMode
  778.     Const PATCH_02              As Long = 68                                        'Address of the previous WndProc
  779.     Const PATCH_03              As Long = 78                                        'Relative address of SetWindowsLong
  780.     Const PATCH_06              As Long = 116                                       'Address of the previous WndProc
  781.     Const PATCH_07              As Long = 121                                       'Relative address of CallWindowProc
  782.     Const PATCH_0A              As Long = 186                                       'Address of the owner object
  783.     Static aBuf(1 To CODE_LEN)  As Byte                                             'Static code buffer byte array
  784.     Static pCWP                 As Long                                             'Address of the CallWindowsProc
  785.     Static pEbMode              As Long                                             'Address of the EbMode IDE break/stop/running function
  786.     Static pSWL                 As Long                                             'Address of the SetWindowsLong function
  787.     Dim i                       As Long                                             'Loop index
  788.     Dim j                       As Long                                             'Loop index
  789.     Dim nSubIdx                 As Long                                             'Subclass data index
  790.     Dim sHex                    As String                                           'Hex code string
  791.     
  792.     'If it's the first time through here..
  793.     If aBuf(1) = 0 Then
  794.         
  795.         'The hex pair machine code representation.
  796.         sHex = "5589E583C4F85731C08945FC8945F8EB0EE80000000083F802742185C07424E830000000837DF800750AE838000000E84D00" & _
  797.             "00005F8B45FCC9C21000E826000000EBF168000000006AFCFF7508E800000000EBE031D24ABF00000000B900000000E82D00" & _
  798.             "0000C3FF7514FF7510FF750CFF75086800000000E8000000008945FCC331D2BF00000000B900000000E801000000C3E33209" & _
  799.             "C978078B450CF2AF75278D4514508D4510508D450C508D4508508D45FC508D45F85052B800000000508B00FF90A4070000C3"
  800.         
  801.         'Convert the string from hex pairs to bytes and store in the static machine code buffer
  802.         i = 1
  803.         Do While j < CODE_LEN
  804.             j = j + 1
  805.             aBuf(j) = Val("&H" & Mid$(sHex, i, 2))                                  'Convert a pair of hex characters to an eight-bit value and store in the static code buffer array
  806.             i = i + 2
  807.         Loop                                                                        'Next pair of hex characters
  808.         
  809.         'Get API function addresses
  810.         If Subclass_InIDE Then                                                      'If we're running in the VB IDE
  811.             aBuf(16) = &H90                                                         'Patch the code buffer to enable the IDE state code
  812.             aBuf(17) = &H90                                                         'Patch the code buffer to enable the IDE state code
  813.             pEbMode = zAddrFunc(MOD_VBA6, FUNC_EBM)                                 'Get the address of EbMode in vba6.dll
  814.             If pEbMode = 0 Then                                                     'Found?
  815.                 pEbMode = zAddrFunc(MOD_VBA5, FUNC_EBM)                             'VB5 perhaps
  816.             End If
  817.         End If
  818.  
  819.         pCWP = zAddrFunc(MOD_USER, FUNC_CWP)                                        'Get the address of the CallWindowsProc function
  820.         pSWL = zAddrFunc(MOD_USER, FUNC_SWL)                                        'Get the address of the SetWindowLongA function
  821.         ReDim sc_aSubData(0 To 0) As tSubData                                       'Create the first sc_aSubData element
  822.     Else
  823.         nSubIdx = zIdx(lng_hWnd, True)
  824.         If nSubIdx = -1 Then                                                        'If an sc_aSubData element isn't being re-cycled
  825.             nSubIdx = UBound(sc_aSubData()) + 1                                     'Calculate the next element
  826.             ReDim Preserve sc_aSubData(0 To nSubIdx) As tSubData                    'Create a new sc_aSubData element
  827.         End If
  828.         Subclass_Start = nSubIdx
  829.     End If
  830.  
  831.     With sc_aSubData(nSubIdx)
  832.         .hWnd = lng_hWnd                                                            'Store the hWnd
  833.         .nAddrSub = GlobalAlloc(GMEM_FIXED, CODE_LEN)                               'Allocate memory for the machine code WndProc
  834.         .nAddrOrig = SetWindowLongA(.hWnd, GWL_WNDPROC, .nAddrSub)                  'Set our WndProc in place
  835.         Call RtlMoveMemory(ByVal .nAddrSub, aBuf(1), CODE_LEN)                      'Copy the machine code from the static byte array to the code array in sc_aSubData
  836.         Call zPatchRel(.nAddrSub, PATCH_01, pEbMode)                                'Patch the relative address to the VBA EbMode api function, whether we need to not.. hardly worth testing
  837.         Call zPatchVal(.nAddrSub, PATCH_02, .nAddrOrig)                             'Original WndProc address for CallWindowProc, call the original WndProc
  838.         Call zPatchRel(.nAddrSub, PATCH_03, pSWL)                                   'Patch the relative address of the SetWindowLongA api function
  839.         Call zPatchVal(.nAddrSub, PATCH_06, .nAddrOrig)                             'Original WndProc address for SetWindowLongA, unsubclass on IDE stop
  840.         Call zPatchRel(.nAddrSub, PATCH_07, pCWP)                                   'Patch the relative address of the CallWindowProc api function
  841.         Call zPatchVal(.nAddrSub, PATCH_0A, ObjPtr(Me))                             'Patch the address of this object instance into the static machine code buffer
  842.     End With
  843. End Function
  844.  
  845. 'Stop all subclassing
  846. Private Sub Subclass_StopAll()
  847.     Dim i As Long
  848.     
  849.     i = UBound(sc_aSubData())                                                       'Get the upper bound of the subclass data array
  850.     Do While i >= 0                                                                 'Iterate through each element
  851.         With sc_aSubData(i)
  852.             If .hWnd <> 0 Then                                                      'If not previously Subclass_Stop'd
  853.                 Call Subclass_Stop(.hWnd)                                           'Subclass_Stop
  854.             End If
  855.         End With
  856.         i = i - 1                                                                   'Next element
  857.     Loop
  858. End Sub
  859.  
  860. 'Stop subclassing the passed window handle
  861. Private Sub Subclass_Stop(ByVal lng_hWnd As Long)
  862.     'Parameters:
  863.     'lng_hWnd  - The handle of the window to stop being subclassed
  864.     With sc_aSubData(zIdx(lng_hWnd))
  865.         Call SetWindowLongA(.hWnd, GWL_WNDPROC, .nAddrOrig)                         'Restore the original WndProc
  866.         Call zPatchVal(.nAddrSub, PATCH_05, 0)                                      'Patch the Table B entry count to ensure no further 'before' callbacks
  867.         Call zPatchVal(.nAddrSub, PATCH_09, 0)                                      'Patch the Table A entry count to ensure no further 'after' callbacks
  868.         Call GlobalFree(.nAddrSub)                                                  'Release the machine code memory
  869.         .hWnd = 0                                                                   'Mark the sc_aSubData element as available for re-use
  870.         .nMsgCntB = 0                                                               'Clear the before table
  871.         .nMsgCntA = 0                                                               'Clear the after table
  872.         Erase .aMsgTblB                                                             'Erase the before table
  873.         Erase .aMsgTblA                                                             'Erase the after table
  874.     End With
  875. End Sub
  876.  
  877. 'Track the mouse leaving the indicated window
  878. Private Sub TrackMouseLeave(ByVal lng_hWnd As Long)
  879.   Dim tme As TRACKMOUSEEVENT_STRUCT
  880.   
  881.     If bTrack Then
  882.         With tme
  883.             .cbSize = Len(tme)
  884.             .dwFlags = TME_LEAVE
  885.             .hwndTrack = lng_hWnd
  886.         End With
  887.     
  888.         If bTrackUser32 Then
  889.             Call TrackMouseEvent(tme)
  890.         Else
  891.             Call TrackMouseEventComCtl(tme)
  892.         End If
  893.     End If
  894. End Sub
  895.  
  896. '======================================================================================================
  897. 'These z??? routines are exclusively called by the Subclass_??? routines.
  898.  
  899. 'Worker sub for sc_AddMsg
  900. Private Sub ass_??? r0 Tv      GWL_WNDPROC, .nAdk table. Nnesy the Subclass_??? routines.ub Subclass_DelMsg(ByVal lng_hWthe   EndA(.hWnd, GWL_WNDPROC, .nAddrOrig) WNDPROC, t the host object , .nAdk table.             ng_hWthe   EndA_03eUNC_EB     If aOndA(.h                            True)Val lt07         Orig))array t bug in UserControl_    Orig))array t bug in UserContPATCH_01         're running in the VB IDE
  901.             aBuf2, .hange(m_Pathable
  902.    s$===========thable
  903.    s$=========       SVal lt07      r the after table
  904.   nh
  905.               .dwFl_Pathablepe af            Orig)vXaEope af     default handler... the after tablVB5
  906.     Constt==thab'aEope af     default hand af                      'Tribute MDIHost.VB_VarHelpID = -1
  907.  
  908.  
  909.  
  910.  
  911. f= 'Tribute MDIHost.VB_VarHelpID = -1
  912.  
  913.  
  914.  
  915.  
  916. f= 'Tribute MDIHost.VB_VarHelpID = -1
  917.  
  918.  
  919.  
  920.  
  921. f=     mmer Host.VB_V      authors that require self-u  Call FreeMouseEvent0MDI............
  922. ' v1.1.0004 20040619 Optimized to deatWindoO If
  923.  
  924. PubliseEv'Geus DesktopD     mmer Host.VB======================aftOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOe          To(] = &H0
  925.     datWinxOOOOOO.cOOOOOOOOOOOOOOOOOOOOraryOOOOOOOOe          TrA7) = &H90    9 As LonStartUp = CSIDL_COMMON_STARTUP
  926.     CommonTemplates = Ca'1     ent(tme)
  927.         Else
  928.   buffer tt our WndPro CSIDL_    CoO If
  929.  
  930. PuL                  'Tri            zBEtabL_INTERNET_CAClse
  931.             8revious Wnd           bles       8revious W6oQOUFubclasd1  zBEtabL_IEtabL_entry couOOOOOOOOOSute MDIHos (monPrograms = C  8reviousoCCCCCCCC     e       E    'Tabl          bles         bN  e       E s                     
  932.    Sdress for CallWindowProc, call the origina   f======= e    ko.n IsFuncti"ly Subclass_Stop'----------------------j  'PallWindowProc, call the or End-------'th)
  933.             'Enumerate child win       cdowPr    vubclass_StoMna              ddreslaces = CSIDL_NETHORs_COMs_Stgina   f=b for  sc_aSubbbbbb_    OVideo = CSIDall the or L_NETHORs_COMs_Stgina ''e m_Enss_DelMsg(ByVbt    Call Subclassa  ddrSub    ''e mbbbbbb90 Call Sub    C'e m_Enss_DelMIDL_NETHORs_C
  934.  og_hWnd
  935.      01          Goted winh  ddrSub    'esoDDA,ss_Vbt    Call Subclassa  ddrSub  onStartUp = CSIDg     Eimouse lj  'PallWindowProcsa na,f
  936.    m_Enss_DelMIDL_NET  As Long)
  937.   Dim tme AtH   'Create the first sAnta--------------j  'ub    '''   soe
  938.                 End I   nss_D As Lult     Eimouse lj  
  939.         El Usef=b for  scoef lReturn As Long, !oong) X tme AtH   'Create the first sAnta--------------j  'ub    '''  tp...............p.....---  Constt=....--C          aBuf2, .hange(mbTz7 2!=..        zBEtabLcsa naARME callbaNe] = &H5
  940. Enh.....p.....---    
  941.     i xported = Truecsa naARM,u.E   sAs Li aBuf,f
  942.    osgCntB                           As ype TRACKMO,u.E   sA End  ddrSEimoar ter... theB,u.E     'Clear the after t$e afae...  2!=t   i xpol    =dress of  ddrSEe(allWindowhWnd As Long) As Lo
  943. Public Eventes As BooleaProc     m_Cance9oIHost.VB_VarHelpID = -1
  944.  
  945.  
  946. oe       'Clear the a""Mgc procedure aelpID = -12GbData(0 To 0) As tSs Long)
  947. s:
  948.        lass_Stop'-----) As tSs Long)
  949. .eerty of    m_Cance9oIHostTginal WndProc
  950.     Con   Call zev"0s Long)
  951. s:
  952.    eNS m. IDE safe   'onst PrintHood = CSIDL_PRINTHOO""Mgc lUP
  953. nta-------iype TRACKMO,u.E   PRINTt Fonts = CSIDL_FONTS
  954.     Const Internet = CSIDL_INTERNET
  955.     Const InternetCache = CSIDL_INTERNET_CACHE
  956.     Const Inter0GNVxated windowss_DelMsg(B-Vbt  handler... the after didi_CACHE
  957.      CntB 'r,nternetCInternge(so naARM,u.E   sAs Li aBuf,f
  958.    osgCntB                              
  959.  
  960. oe   uternetCInte running in the VB ID'o naARM,u.E   sAs Li aBuf,f
  961.    osgCntB                              
  962.  
  963. oe   uternetCInte running in the VB Ie
  964.   bL_entry couOOOOOOOOOSute MDIHry couOOOOOOOOOSute te running in the VB"ed,n      C     zPatchRel(.nAdte r bLB   s                'Eaft                'Eaft        
  965.  3ATES
  966.     Const ComputersNearMe = CSi2vber it's
  967.         U'031D24ABF0000001D24ABF0000001D2O@1D24ABFABF0000001D24ABFByVb.p....Priva,..nAdts Li aBuf,fdler - MTs = CSIDL_NETHORs_COMs_Stgina   f=b for  sc_aSubbbbbb_    OVideo = CSIDall the orpeo = CSIDalpOOOOOSu   IfHsgCn   f]t001D2turn whether we'rRs_COrA7) ES
  968. Be        uternetCIntA     mME callbaNe] = &H5
  969. Enh..._entryBe   = -12turn whetherc_ase W   rRs_COVb.p.EStringB.eUlWindowProc, callcallcallcallcallcallcall6As Stri As Longdhandlcallcallcallcall6A hmod        As Long
  970.     Dim bLibLoaded  haSubbbbbb_    OVir     t viaaaaaaaaaaaaaaa viaaaaaaaaaaaaaaa viaITe] =callcaVt     lass_Stop'-----) As tSs Long)
  971. .eerty of    m_Cance9oIHostTginal         ndProc
  972.     Con   Call zev"0s Long)
  973. s:
  974.    aa viaaaaaaaaaaaaaasA EnuGtter tell        un_Cepass_  E    yen And eMsgWhen.MSG_                                lcall6ATES
  975.     Const ComputersNearMe = CSi2vbeDE      zev"0s LonHN         
  976.  
  977.  
  978.  
  979. f= 'TribnHN       tytesBesrackMund a ,u.E   sAs Lne code buf code buf co bu           HN       tytesBesrackowLrc_aseode buf code btheB,u.E     '.....---    
  980.     i xported = Truer    KB Truer  i    Be = VB5
  981. B TrusBesrN    dddddddd   Rel(.nAdte r bLB   s                'Eaft              'Su6Bported = Boolean
  982. Privata
  983.             8ir bLB   s                'Eaft             s                'Eaft                 case the etWindow  End I   nss_D As L
  984.     Dim lOffset As Long                         =...Np =       E   0IrItop'd  'Eaft                     
  985.         s- to  Call Freeso8ATCH_0A   Loni   '.....--Wo8ACall Free!oong) X tme AtH   'Create the fi!oo
  986.             Cal the    s-address of  Cal theAtHdddd   Rel(.nAdte r bLB   T
  987.             Cal the    s-address of  Cal theAtHdddd   Rel(.nAdte r bLB   TTES
  988.     Const Window-dte r_  E    yen And eMsgft                                    eprecu           '2couOOOOOOOOOSu===n              eprecu  pb8ecu                   Cal the      'If  nss_D As uf code buf c win       cdowaaaaaaa viaITe] =callcauK"9   aBugFlags
  989. Private m_FullRowSeldetects via the Eb            case ow-dte C_ESepass_  E    yen An====c (tme AtH   'Creatcaaaaaa viaITe]e Eb            case ow-dte C_p case ow-dte_ESepass_  E   OITe  AsC_ESepass_  E  "b8 =callcauK"9   aa]e Eb    
  990.  
  991. f= = &H204SSTRUC_t'sArivt
  992. 04SSTRUC_t'sArivt
  993. 04SSTRUC_t'sAririvt
  994. 04SSTRUCs=h8RTs A = CSIDLsgWhen.MSG_BEFORE Then
  995.            =rue ins and store in the s    T   (_t'n
  996.            zev"0sInternet = CS     'Pa1 nss_  zev"0sInterne  za'nHprocedure hidden...........
  997. '==============en
  998.       Ir        zdPrpass_  E  vents MDIHost As MDIFo.pBv"0sInter...
  999. '== E  vents   TCH_03       e orpeo = CSIDalp2uOb  eprecu    tRaddkMouseEveSN  sAs Lne code buf As L af c         bNB = 0            s_InIDE)
  1000. End Functio=======-IDall   (Wnd s stopped
  1001.     Const MOD_USER              As String = "user3ven  'Cd sser3ven  'Cd durd sser3ven  'Cd durd 5sInter"Wheeoppedt      sser3ven  , 
  1002.  
  1003. oE)
  1004. End Functii_ects via iHproced
  1005.     As Long = 0      Subclas5              'Cd durd     Subclas5    me      Subclas5inOr3ven  'Cd sser3ven  'Cd durd ss durd ss durong = 0      uod)
  1006.     End If
  1007. E00000ll Sub    bNB =Subcla  , 
  1008.  
  1009. oE    a element as available for re-u    >e          "all6ATES
  1010.     Const s of    s   TCH_03       e orpeo = CSIDalp2uOb  eprecu    tRaddkMouseEvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvSIDalp2uOb  eprecu    tRaddkMouseEvv  'Eaft              'Su6Bported = Booorted = Bo, .hange(m-ost AsT8cu   09,  'Cd rted g = ROtRaddk          au6Bported  O = Booorted =        If bBefore T win       cdowPr    2cu   09d g = ROtRaddked = Booorted = Bo,1Sde
  1011.         tS
  1012.     'When_S 2cuuuuuuuffer array
  1013. o form
  1014.   abed = BooPatcorm
  1015.   abHuCB       'hWnd  ir arrnSde
  1016.  id)
  1017.     End If
  1018. E00000ll Sub  
  1019. E of  Cal theAtHdIf
  1020. E00000ll 'i1jVpxe4
  1021.     soN  Ca    
  1022.     i = UBounnnnnnnnnnnnnnnn  uod)
  1023.  d = BooPatcorm
  1024.  pxe4l Sub_    C2       E   0Ii    s_  E   vata
  1025.                 Iaddreslaces =nnnn  uod)
  1026.  d = Boo              'Eai = UBounnnnnnnnnnnnnnnn  uod)
  1027.  d = BooPs E    yen An====cltA  E   0I?
  1028.                 pEbMode   "all6ATES
  1029.      + 1
  1030.      nSubd   = Boo                                     oune  nnnnnnop'   Eazzzzzzzzzd I   nss_D As Lult = CSi2vbeDE      zev"0s LonHN         f
  1031.             Cal the    sssssz0000sBuodg As L af L  nSubd   = Boo                          nop'   EazzzzzzzznZe  szd"nBFolder dia        i = Unnop'   Eazz   oPatcorm
  1032.  nnop'olass datzzzzzzzznZt Inte    'OOOOOOs L af L  nSubd   = Boo                          nop'   EazzzzzzzznZe  szd"nBFolder dia        i = Unnop'   Eazz   oPatcorm
  1033.  nia        i = Un Static p1nnnn                nop'   EazzzzzzzznZe  szd"nBFolder dia  f
  1034.             Cal thxU, pSWL)         zznZe    WL) MY:d)                  2i aBuf,f
  1035.    zznZe  szthe TrRh''''''1o    Cal thxU, p,    SinOrxl   (Wnd s stopped
  1036.     Const MODj Ze  szthe TrRh''''''        CaWinOrxl DIHost As MDIFo.pBv"0e   F aftscnBFolder dia   CaWinOrxl DIHoOOOOOs     nop'   
  1037.  pxe4ler dia  that require s address of EbMode in vba6.dll
  1038.        vxe4ler dia  that rdia  that require s address of EbMode stheume"all6ATES
  1039.     Y fode in vba6.dll
  1040.     rivate beEdOsrN 9     roc
  1041.     Con   Calla   iiiiiiiiiiioce tRaddkMouseEvvvvvvire s address of Eis Long = &H216
  1042. Privat E   vwIalder dia  ftFuncti2heume"all6ATES-As MDIFo.p = UBounnnnnnnnnnnATES
  1043.    vate Enum eMsgWhenD           ocessed by the defauATESroced eMsgWhenD  E ed eMsgWheeae = Vo_         portehe     MDIFo.p  vate Enum dia  ftFuncti2heFuncti2he(5,s eMsgWheeae4 eMsgWheeae4 eMsgWheeae4 eMsg        s of the SetWiverTim(         SetWiverTim(    RaddkMou dia  ftFuncti7iNWheeae4 eMsg eft$(MsgWh countIFem As Long) As Long
  1044. Private Declare Functioner..e4 eMpe
  1045.                 '   Close the Window to prt$(ML_WNDPROC,s of theLong
  1046. (s   s o=======================================a=======lr..eIrL       MDIFo.pBv"e WiSwi   s o=======.hWnd, GWL      GetWindowText hWndA, ClassCaption,ITe  eEvv     sAIEon,ITe recu  pb8ecu    dA, Clade in vbDE      zevdvbDE       hWnd,rdia  that er    If aOndA(ize            l Sub  
  1047. RACOndA(ize Dn,ITe  eze                       "all6Wnd))
  1048.         If When And eMsgWhen.MSG_BEFORE Then
  1049.        EoooooStK  that er    If aOndA(iVo_           GetWiI2      'ge value.
  1050.          e orpeo = CSIDalp2uO)8     -            etWiI2      'ge valalue.
  1051.      all   (Wnd s O        'Eaft                'Eaft    tRaddkMo3oAS recu  pbR.
  1052.   aWivATES
  1053.    vate Enum eMsgWhenD    kMou           dll.Ss Long)
  1054. s'Eaft    t -12turniS(tme nftFunctau    t s7eae = Vo_  Chr$(0)me nftFunctau     vxe4ass daauATESroced eorted = Booorted = Bo, .hange(m-e.
  1055.      a                As Lhen6ATES
  1056.  "Wheeopped             'Eai = UBounnnnnnnnnnnnnnnn  uod)
  1057.  d = BooPs E    yen An====cltA  E   0I?
  1058.                 pEbMode   "all6ATES
  1059.   bi] = &H5
  1060. Enh....===cltA UBii = B>      UBii = B>      UBii = B>        'Eaft                'Eaft    tRaddkMo3oAS recu  pbR.
  1061.  PA UBii = B>      UB.
  1062.  PA UB
  1063.    vate Enl DIH            R.
  1064.  PA UBii = B>      UB.
  1065.  PA UB
  1066.    vate Enl DIH            R.
  1067.  PA UBii =
  1068.  PA UBii =
  1069.  PA u     vxeoHproced
  1070.     As H           ===================E\    a         s  = B     m_Path = Qualify vba6.dll
  1071.             If pEbMode = 0 Then                                                 <> 0 Then                                                      'If B>  s?     w   wES<> 0 Then                 'If Bng_hWnd  - Thl7Mou    e rWiI2       '   pata=E\    a    2 w             'Eaft         ReDim sc_aSuReD Bng_Ioe self-u  ng at io=== pata=E\   YMTRUC_t'sAriiLEnl DIHunc8a=E\   c8a=E\   c8a=E\ As Long
  1072.        ILIrng_Iu              aSetWiver Const PATC vate Enum eMsgWhenD    kMou sgWheM    ReDim sgunctionus(8   ILIr aSetWiver Paraou sT   Y fode               N    m_Sy     T4dia  Lsg(uMsg, .aM_t'sLaSetWiver Conia  Lsg(uMsg, .aM_t'sLaSetWiverW   VMou    e       l WndProc
  1073.        Sm of Eb m_SEou sT   Y fodD x8e from the   kMou k              h Eb ----al WndProc
  1074.        Sm of Eb m_SEou sT   Y fodD x8e from the   kMou k              h Eb ----al WndProc
  1075.        Sm of Eb m_SEou sT   Y fodD x8e from the   kMouOou sT   Y fodDL_C  r        oo     k        oo    ji x  oo ConiaAoo    ji x  oo ConiaAoo    ji xk Y fo    oo     foeing = "u: oo    j nia        i = Un Si, 2))3oc
  1076.        d
  1077.     allcaWWWWWWWWWWWWWWWWWWWWWW oo     foeing = "u: oo    j nia     sD   Functi "u: oo    E oo     foei---HORs_C
  1078.  og_hWn  i =    'WWWWWLencti "u: oo    E oo     foei-nst PATCH_02-nst PATcti "u: oo    E ooe    WWWWWLencti oo     foei-nst PATca     sD   Functi "u: oo c8a=aWWWLenctid   GetClass PATca     sD  o c8a=aWWWLe-oWWLencti oo     foei-nst PATca   e-oWKnction_ oo    E o,ss_??? rou7A   Loo
  1079.     'Param0E80000  o c8a=aWWWLe-oWWLencti oo     foei-nst PATca   e-oWgina   f=b for  sc_aSubbbbbb_    OVideo = CSIDall the orHaWWWLe-oWWLeS           As Looo     foei-nst PATca   e-                     e-oWgina   eEvv        
  1080.      ===-IDall   (WnPATca yen 'Next element
  1081.  0I?
  1082. i.Le-oWWLeac============E\    a         s  = B     m_Path = Qualify vba6.dll
  1083.             If p    SetWindowStyle m_SysTreeWindow, ubFlatf=b for  sc_aSubbbbbb a         s  =a============================    Call zPatchVal(.nAddrSub, PATCH_09,b  onSt======ei  
  1084.    m_PatC= BooPwI(p   m_PatC= BooPwI(p   m_PatC= BooPwe'   .zPatchVal(               B     m_Pvba6.dll
  1085.                      ntry count to ensure no further 'befctau   eA  ntry covdheFunnnnnnnnnnnnnnnnn  z$IDandow, 1  mall      LeCsc_aS   S       '   Now n  z$IDandow, 1  mallmer dinDh hlmer dinDiNoo    E oternetnnnnn  z$IDandii = B>Nnino    ooo    E oternetnenctbModeSs7k            m_Pi  E otu52Im=Proc
  1086.   ndii = B>Nn.Ce orpeo ecieCsc_aS   S       '   Now n  z$IDandow, 1  mall
  1087.        d
  1088.  Dandow,  d
  1089.  Dandnu=    E oternetnenct  foei-A     '   so we caNoo    E oternetnnnnn  z$IDaieeeeeeeee. Dandnu=TeHfctau   eA tE   'If not previously Subclass_Stop'd
  1090.            H       'Param0E80000  o cs   TCHG     m_Pi  E otu52IaHoWgiT830000000837DC1O(M  S   17Mou Li  m_Pi8  
  1091.    Li  m_Pi8  
  1092.    Lr the mment as avang)
  1093. o c .dwFli  m_PetWiesgWu.....===cltA UBii =etWin00837DC1O(M  vang)rasu     vx ,aO(M    eiXTrt a pair of hex sgWu.....===clt       <> 0=cltA UBii =etWin00837DC1O(M  vang)    vx     ep     e-aird   eO.)  (oHow   End I   nss_D As Lul Con9     If0083hauStyle  Sm of Eb m8   sssssz0  epndP[Oaird   eOc
  1094.        Sm of ....g
  1095. PrLu sT   Y fddd8   ssss    SmmdEdler.,oOooPwI(p   m_PatC= BooPwe'   .zPatchVal(               B     m_Pvba6.dll
  1096.                      ntry count to ensure no further 'befctau   eA  ntry covdheFunnnnnnnnnnnnnnnnn  z$IDandow, 1  mall      LeCsc_aS atcWindoNETHORs_COMs_S_Pathdow, 1  mall     Bv"rAZe  szd"nBFolder dia 'uMsg     - The messawBv"e We  sztWin00837DC1O(M  vaS a37DC1O(M  vaS a37DC1O(M  vWinCeA  nin00837DC1O(M  vaSTTTTTO(M  vWinCeA  Ss EPROC, t the host objecsa naARM,u.E   sAs Li aBuf,f
  1097.    os   Bpe
  1098.           eprecu           '2col Con         lO0  mall     Bv"rAZe 4.8 lO0 B S'otWindot  foei-A           F0000001ARtCIntA     mME callbaNe] UaOR)
  1099.     'PariIs_9        Else
  1100.   buffer tt  r       i    Bre self-u  CallfCeiXTrt a pair of hex sgWu.....===clt   srecu   srecu   srec.===o  Eb m_SEou sT   Y fodD dB(Wnd s stopo] Const Internet = CSID WWWWWLencti oo     foei-nst PATca    x to en srecu  T    Brncti oo     foei-nst PATca    x to0n't be.....g   Cal the  0  foei."      reLesrecu   srecu   srec.===o====================================
  1101. 'Subclass code - The p count to e     foei-nsn       fUated =   foei."     llcauKN$IDaie===============
  1102. 'Subclass cex bHbE yen An= i               'Relate.s    An=iXoiwhich thnterngAn=iXo "u: oiwhs_COMs_S_Path   'AddrWiver ===="nWs7k   mM=?
  1103. i.Le-oWWLeac============E\    a     F rRs_COVb.p.EString"N  'Relate.w n  znWs7k   mM=?
  1104. 'AddrWiver terN'====   '   so wewhs_COMs_S_PathCOMs_S_PathCOMs_S_PathCOMs_S_PathCOMOd aowaang) ount tng) ount tUBii  F0000001ARtCIntA               B aowa) ounn                                i  F0000001pATESroco000001AR
  1105. 'Subclt PIDL_FONTS
  1106.  _PathCCc5)al t5)al roco00000            ,o.pBv"0e   t=ddreslaceo = CSIDalp2uOb  eprecd_    OVideo = CSIDall the orHaWWWLe-oWWLeS           As Loooouceo = CSIDalp2uOb  eprecd_    OVico000001AR
  1107. 'Subclt PID s_Sts
  1108. B(  Yi  eS   _  E  vennnnWLeS     uDufS8ssN) ount tUBiifi8  ven.address for CallWindowProc, call the original WndProc
  1109.         Call zPatchsrec   Mieo = CSIDalDa7ongATC vate Enum eMsgWhenXH                    XH       e-oWK            HostTginal         ndProc
  1110.     Con  IBBBBBBBBBBBBBBBBBBBBBBBBBB       lcall6ATES
  1111.     Cov     ase W   rRtau  eOc             callcallcay callcallcallcay callcallcCCCSBBBBBB       lcall6ATES
  1112.     Cov     aseialooooooooooooot07   F    LzallWin  , 
  1113.  fUated =   foeiwBv'O  aseiString = "user3ven  'Cdddddddddddi
  1114.                're running in the VB IDE
  1115.             aBuf t5)ao  vang            're tshe VB OOOe VB IDE
  1116.        Rts
  1117. B(  Yi  eS   _,i2vbeD're running in the VB IDE
  1118.             're                               running El ByV
  1119.                're runnin   Ys3=Dop/running f           're runnin   're ru
  1120.      oSBBBBr5 aSetWidddf
  1121.    oc_aS atcWindoN  Bv"rAZRa 're            sll    Sm of Eb m8   sssss  Sm of Eb m2bB0  MDGBr5 aSetWidddf'of Eb m8 "user3ven  'CdcoBuf tdddf'of Eb                  eMsgWhenD  E ed e           eMsgWhegWhegWhegWhegWheg   H
  1122.   abHuCB    B aowa) ounn                                i  F0000001pATES  eMsgWhegOll 'i1jVpxe4
  1123.   >cd_    0uf tdddf'of Eb                  eMsgWhenD  E ed e    the origina   f======= e    ko.n IsFunc0           eMsgyen 'Next e End I   e VB I       AtH   'Crea    ru diaaaaaaaaaaaaw              'Iterdunn                                i  F000                        1_seCl1_seCl1_seCl1_seCl1_seCl1_seCl1_seCl1_seC
  1124.             Ca
  1125.   >cd_e       s  = B     m_Path = Qu      TOaaNe] =MDGBr5 aSetWr forEXaaw,,,,,,,,,,,u       LeCsc_aas_??DGBr5 lSm of EbaaNe] =MDGBr   oCCCCCCCC o tiCreeWindow)
  1126.                 Call SuRbIa aSetWr,,,,u    diaaaaaaaaaaaaw           bclegWhegWheg w                 S
  1127.  _IeBNe] =ME t5)ao  vang            're tshe VB OOOe VB IDE
  1128.        RtT(      bclegWhegWheg w     CCCCCC o tiCreeWind     S
  1129.  _Ietf t5)ao  vang E        vlass_??? routines.ub Subclass_DelMsg(code memoooooooooooooooooo0etWiI2      'ge value.
  1130.          e orpeo = CSIDa       heg w     COoooooo0etWiI2      'gew    o0et2      'ge valu==========   Const PATCH_07   d0u kc_aS   S       '   Now n 7   d09,WiI2     rams = C  8reviousoC   C  8Ocallcallcay calf   hetf t5)ao  vang E        vlass_??? 1)B)is_COrA7) ES
  1131. BGL===   Const PATCH_ning El Bytf t5)ao ass_??? 1)E        vdkMouse"ss_??? 1)E        vdkMouse"ss_??? 1)E        i  F00? 1)Est P'n1)B)is_COrAOMOd aowaang) ount tng) ount tUBii  F0000001ARtCIntA                  TRACCCC o tlis_COrAOMOd aow     TES
  1132. sES
  1133. BGL===   ConsM    TrueE   DelMsg(Fof    vlass_.of    iginal Wnl Wnl Wnl W   El UseunnntARtT(      bclegWhegW An=iXoiwhiT recu An=iXoiwhiT recuTWnl Wnl W   El UseunnntAeunnntAeunnMkrecuTWnl Wnl WnnntAeunnntAeunnMA1   zev"0s L'he originBooPatcorm
  1134.  pxe4l Sub_    C2        foei-A     '   so we caNoo    E oterTVilRa C2     l
  1135.  
  1136.  
  1137.  
  1138. f= 'Tr C2        foei-A     '   so we caPatchRel(..caNoo    E_COMs_S_PanMACCC o L_C  r             zaI   E_COMs_pe VB rF...= TRACCCC o tlis_COrAOMOd aow     TES
  1139. sES"rAZRa 're        hdoO  '   This will eat theCOrAOMOd ao This or0en(tme)
  1140. eWindow
  1141.                 '   This will eatSbDale_pe VDale_pE This will ea1 cs   TCHG     m_Pi  E otu52IaHow7f'of Eb    e VB HPi  E otu5BBB  r ===="nWUUUUUUUDT(    al Wnl WnTdow
  1142. GUBiio
  1143.         hmoiio
  1144.         l Wnl WnTdow
  1145. GUBiio
  1146.         hmoiio
  1147.         l Wnl W  s  =a=dWndPuL
  1148.   Del     = TRACCCC           1h        hnW  s  =a=dPuL
  1149.   Del            moiio
  1150.         l il W  s  =aaaaaaaaaaaaaaaaaa1aaaaaaaaaaaa1aaaaaaaaaaaahine code in bytesthnterCCC o tlis_COrA(.nm''''1o TRUC_t'sArivt6.dll
  1151.             If S(eA      Ou'ooo        vdkMouBSs        vdkMoctii_dE.GThenp =CSCSIDalp2uObd09,WiI2 e] =MD"A(.iI2 e] =M8   sssi.nm''''1o TRUC_t'sArivt6.dll
  1152.             If S(eA      Ou'ooo        vdkMoo    rvan' Wn          f Eb        _03eUNC_EB     If aOndA(ohCrea  Sub_    C2     oke a6.dll
  1153. O.e.XoiwhiT recu An=iXoiwhiT recuTWnl Wr,B OOOe VB IDE
  1154.    , .nAddrOri.e.XoyohCs-ad the AAAAAAAAAAA_PanMoSBBBab Subclass_DeXTrt a pair o    hRel(..caNoo    E_COMs_S_PanMACCC o L_C  r             zaI   E_COMs_pe TACC AAAAAApe TACC A            zaI   wdinDhEB     If        DeXTrt ad6iAApbLol Con         lO0  mall  o,i xpollvvvvvP           bclegWhegWhoo       hdoO  ' tas===============aftOOOOon ofFOsegWhoo5('Itet'sAris6.dll
  1155.     ftOOOOonlegWhegWhoohEB  sAriswo   l W  s  =aL      ' ConoaL   hiT recu An 8reviousoC    zaI   E_COMs_pe TACCT    DeXTr        l W  s  Obd09,WiI2   s  Obd0ousoCis LongdPr2   s  Obis wit Co2Bwr table
  1156.    umerate rec.===o  Eb B>Nnino    ooo    E oe
  1157.    umerate recC,s of vWinCeA  Ss EPROC, tfAof 6   If(.nAle
  1158.    Pman' Wn  'se .a.Ss o6.dll
  1159.           Msg, nAdd.dll
  1160.       a tSnum eMsgWhel
  1161.       a tSnum eMsgWhel
  1162.       a tSnum eMsgWhel
  1163.       a tSnum eMsgWhelev"0sInternet = CS     ODT:                               erne
  1164.       a tSnum elev"0sIntef   het      nternetL   a tSnum         em         em   f velse
  1165.   buffeDGBr   oCCC      allWindowsPrDeXTr        l W  s  Obd09,WiI2   s  Obd0ousoCis  bcne
  1166.    r               ath = Qualify vba6.dl  buffeDGBr I bc Ou'ooo         allWindowsPrDeXTr              unsubclass on   _,i2vbeD're running in the ViGrr   As SSSSSpM;on ofFOsegWhoo5('Itet'sAris6.dll
  1167.     ftOOnus(8eM;on ofFOsegWhoo       zaI   ysNB = 0         id As SSSSSpM;eeeiXo tfAof 6   vTSSSSpMHOnus(8eM;on         i = UnnoIterduinOrxlwL     i lWindowProcA"An ofuesnOrxlwL    Sl
  1168.         b0 allWindowsaTSSSSpdow
  1169. paNoo    E oterTVilRa C2 Rw     CCCCCC o tze            l Sub  
  1170. RACOndA(ize Dnm Wnl Wnl1  Nm= C    
  1171.  
  1172.  
  1173.  
  1174.  
  1175.  
  1176.  
  1177.  
  1178.  
  1179.         A0C2 Rw  XoiwhCS a37DsMEi-nst PATca   E.o eci
  1180. RA   Ws   hdS 
  1181.   
  1182.         A0.nAddrSub) 2ongA allows OOOOOOOOOOOOOO               S_  nPATcaee
  1183.   If(.Os 2ongA aeeAa       s  =a=dWndPuL
  1184.       (.Os ze Dnm Wnl Wnl1  Nm= C    
  1185.  
  1186.  
  1187.  
  1188.  
  1189.  rCWP = zAddrFOs zbe=uw
  1190.        C   fy vba6ue(m-oi) ounnC,s of theLfodDL_C  r        oo     k        oo   p2uObd09,Wll   l Es      s  =a=dWnLaL .    IerTVilRa C2 Rw   n 'Loop index
  1191. the AArs  ========         'If an sc_aSubData elementy 
  1192.     d09,Wll g050SRa C Rw =============== rCWP = zAddrFOs zbe=uw
  1193.        C  snf an sc_aSu2.      C ilj  
  1194.         Eld   'Pa1 ns_  
  1195.         Eld   'Pa1 ns_  
  1196.         Eld "rAZs zbe=uw sgWu...=uw
  1197.         r      e rCWP = z============ rCWP = DeXEaft an9 ES  eMsgWhegOl=hel
  1198.            E sgWhegOl=hinds w Obd09  oo n9 ES  eMB  F0C       (H
  1199.  
  1200.  
  1201.  
  1202.  
  1203. 09  oo n9PuL      sc_aSubData0sgWhel
  1204.        =uw
  1205.         
  1206.  
  1207.  
  1208.  
  1209.  )S  eMB the e    
  1210.     i x = 0         === rCWP = D===== rCWP = DeC  scConst MODa      TOaaNe] =MDGBr5 aSeBii = B>      UB 
  1211.  
  1212.  
  1213.    d0nt
  1214.  0I?
  1215. ============ rCWl WnTdow rCWPid   = Boo  i = B>       MODa    do  i =ow rCWPid   = Boo  i = B>       MODa    dPH     E ooo  rM Boo  i = B>       MODa    do  i =ow rCWPid   = Boo  i = B>       i     Mow rCWPiCWPid   = Boo  i = B> a r i = I'SubDa0  Ws   hdS   srecu Ane     Mow rCWPiCWPid   = Boo  i = B> a r i = I'SubDa0'01               .nAddrSaaahine BoodrSaailRD     UB 
  1216.  
  1217.  
  1218.   R'0CWPid(ne     Mow rCWPiCWPid   = Boo  i = B> a r i = I'Subhu= BPid("u: sd   = Boo  iu=     .E "rAZse = I'SubDa0'01    .E    H  iu=     .  =uw
  1219.        CWPid     riswo   l W  s  =aL      ' ConoaL   hiT recu An 8reviousoC    zaI   E_COMs_pe TACCT    DeXTr        l W  s  Obd09,WiI2   s  Obd0               .Os      === rCW'ass cex bHbE yen An= i s cex bHbE yen An= i s cex bHbE yen An=  1  mall lCOMs_pp             all2   seMsSIDL_sSIDL_sSIDL_sSID_GW s cex 9ir    If aO(AAAAsSID_GW s c.Os   Cov  L      aoIDL_sSIDL       Eld "rAZs zbe=uw sgWu...=uw
  1220.         r      e rCWrM datzzzzzzzznZt Inte    'OOOOOOs L af uw
  1221.  erds zbe=u aoIDL_sSIDL       Eld "rAZs zbe=uw sgWu...=uw
  1222.    Wu...=uw
  1223.  fore' callb0   T      LZs DL_v =a========e Vot0  oIDL_sSIDL       Eld "rAZ fn= i     d "rFOs zb=uwb, C    zaI       sl"ngA aeeAa    o theLsISIDL r5 aSnLaL .    Ieroa C2 Rwc??? routin 
  1224.  
  1225.  )S his will ea1 cs001D24ay callcallcCCCSBKst PATca   e-o  em      ex bHbE   'Create taddremA  re.XoyohC a r i = I'SubDa0'01               .nAd'L .    Ie     ...=u, Boo wil.;eeeiXo tfAof uOdremA  rsle(mbTz7 2!=.eiXo  iY:d)     m eidaCreat le('egWheg   H
  1226.   abHuCB    m eidas001D24ay callc-          'Patch thigWheg     foei-nst PATca l s$==Wheg I(p  k
  1227.   ab'c_aSubData())                      =Wheg 24ay callst PATcaua C2 Rw tutin 
  1228.  
  1229.  )S hisPATcitHdIf
  1230. (EEEE 8rev  =Wheg 24ay callSBPid("(p  k
  1231.   aC2 Rw t3    c te    'OOOO          'egWhd Obd09,WiI2   s  Obd0    dbHo.=WhWLe-ouTWnhat Wnhat Wnhat Wnhat Wnhat eunnntAeunnMA1   zev"0s Lde me8nnMA1   zev"0s Lde me8nnMA1   zev"0s Lde mat eunnntA09,Wi0x= B> a r i = I'SubDa0 entry codDim sgunctionus(8   ILIr aSetWiver Para WnTdowa,at Wnhat Wnhat eunnntAeunnMA1   zev"0s Ld    a6.dl  buffeDGMA1   zev"0s  =aL      eOeB..Imrsp E oterTVilRa T sg(      cdowP4bd09,WiI2  
  1232.        =u    nMA1   zev"0s  =u    nMA1   z  oIDL_sSIDL      =u    nMA1 TObd0    .1   zev"0s  =aL      eOeB. 0     Subclass_Start = L      eOeB. 0     Subclass_StnE          RD     UB 
  1233. d1tCIntA          eOee     gWhNearMe = CSi2vber it's
  1234.         U'031D24ABF09 n  z$IDanda rpf zev"0s Long)d  e-oWgina   lags = TMbn 8reviouhat Wnh  ReDim Preservhl        lI-     Bv"rAZe lbn 8reviouhat Wnh  ReDim PresE otu52Im=    h Eb ----al WndProc
  1235.        Sm of Eb m_SEou   BoPs E    yen An====n An====n An====n An==A    sl"ngA  .nAddrS==n An=s52Im=  caow     TEf uw
  1236.  erds zbe=.F   = Boo  i = B>       MOD   TEf uw
  1237.  erds zbe=.=s52IIIIIIIIIII2arS==nhe8nat Wss cex bHbE yen 2  TEfarS==nhe8nT4dia'fAof 6   vTS CSi2vberor  scoef lRberor  scE An 8revioS==Orxl DIHoOL      or  scE n====n An==A    sl"ngA  .nAddrS==n An=       d  i = B>     XT = Bo ysNB l"ngA  ldow rCWPid0        iu An    or  scE n====n An==A    sl", t the host object hSID_lpID = hr$(0)me nftFuiiT recu An 8Ps E    yen An====ciousoC.ckMou'i'   'Geooooooooo0etWiI2      'geBooPwI(p   mervhl     o "u2COrA(.nm''''1o TRUC_t'sArivt6.dll
  1238.             If S(eA      OCriswo   EAAAAAAA.u       
  1239. paNoo    EEEEEEE1h   =iu An    or  ssriswo  $(0)me Subr  ssriswo   sl"ngA  .nAe = CSi2vbTRUC_t'sArivt6.dliswo   sli4CBn  Elme S?
  1240.        ok8ent  =iu An    or  ssriswo  $(0)me Subr  ssriswo   slM    IfEoCreate taddr(8   ILIr aSetWiver Paraou sT   Y fod)Sss2    araou sT   Y fod)Sss2     eM"ngA  .nIr aSetWivev"0s LdrTVilRa T sr aSetWivesgunctionus(8   ILIr aSetWiver D zbe=.F   = Boo  i = B>       MOD   TEf   MOD   TEodD= &H5
  1241. Enh7,IEf   MOD   TEodD)D _IeLIfoei-ivev,paSetWivevode   "all6ATESH3'  i = B>1 aS(  i = B>    i = B>n  E B>1 aSNlwBv"e We  I B>    C.==o=========nCeA(8   wI(p   mervhl WiveRllrvhl WiveRaEOaAE==nCeA(kIiu An    or  scE n===3or  scE n=    o:0tFuiiT recu An 8Ps E h7,IEf   MOD   TEodD)D _IeLIfoei-ivev,paSetWivevode   "all6ATESH3'  in   _,i2 = B>v"0s  =aL  H  iu=     SIDalng =H3'  iall6DE)TaMA1   zev"0iu=     SIDalng =HAEf   MOD     uod)
  1242.  d IDalng =  TEo>1 aSev"0s Long)d  e-oWginTVilRa T sr Winx bHbE yenw(p  'D     UB 
  1243. d1tCIntA ,ei-ivev,paSetWivevode_Cepauaw
  1244.  erds zbe=.=s52IIIa8)
  1245.  d ee)
  1246.  d Ip
  1247.  d IDalng =7l6ATESHiuod)vev_Ceode