VERSION 1.0 CLASS BEGIN MultiUse = -1 'True Persistable = 0 'NotPersistable DataBindingBehavior = 0 'vbNone DataSourceBehavior = 0 'vbNone MTSTransactionMode = 0 'NotAnMTSObject END Attribute VB_Name = "cWinHelp" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Option Explicit '============================================================================================================= ' ' cWinHelp Class Module ' --------------------- ' ' Created By : Kevin Wilson ' http://www.TheVBZone.com ( The VB Zone ) ' http://www.TheVBZone.net ( The VB Zone .net ) ' ' Last Update : March 20, 2002 ' ' VB Versions : 5.0 / 6.0 ' ' Requires : WINHELP.EXE ( Microsoft Windows Help ) ' ' Description : Windows 95, 98, ME, NT4, 2000, and XP all have a built in WinHelp system (though WinHelp has ' been replaced for the most part by HTML help starting with Win98SE). This class module ' gives you access to about every aspect of the WinHelp system via easy-to-use function calls ' and properties. This allows you to the ability to open your help file (.HLP) in many different ' ways... including standard, search window, popup windows, etc. You can even bring up the ' Windows help file on how to use help (nice feature). ' ' I haven't been able to get the subclassing portion of the WinHelp system to work yet, but ' that may be due to the fact that I didn't test it with a wide variety of help files. ' ' Example Use : ' ' Option Explicit ' Private HELP As cWinHelp ' Private Sub Form_Load() ' Dim lngCtrlIDs(0 To 2) As Long ' Dim lngCtxtIDs(0 To 2) As Long ' Dim strReturn As String ' Dim lngErrNum As Long ' Dim strErrDesc As String ' Dim lngLeft As Long ' Dim lngTop As Long ' Dim lngWidth As Long ' Dim lngHeight As Long ' ' ' Setup test data to pass to the class ' lngCtrlIDs(0) = 1 ' lngCtrlIDs(1) = 2 ' lngCtrlIDs(2) = 3 ' lngCtxtIDs(0) = 1000 ' lngCtxtIDs(1) = 1001 ' lngCtxtIDs(2) = 1002 ' ' ' Setup the class to use ' Set HELP = New cWinHelp ' HELP.CloseHelp ' HELP.CallingHandle = App.hInstance ' HELP.HelpFile = "C:\Windows\Help\MyHelpFile.hlp" ' HELP.CloseHelpOnTerminate = True ' ' ' Handle registration of the help file ' If HELP.HelpFile_GetRegistration(, strReturn, lngErrNum, strErrDesc) = True Then ' If strReturn = "" Then ' If HELP.HelpFile_Register(, "C:\!Upload\", lngErrNum, strErrDesc) = True Then ' Stop ' If HELP.HelpFile_Unregister(, lngErrNum, strErrDesc) = False Then GoSub ShowError ' Else ' GoSub ShowError ' End If ' Else ' Stop ' If HELP.HelpFile_Unregister(, lngErrNum, strErrDesc) = False Then GoSub ShowError ' End If ' Else ' GoSub ShowError ' End If ' ' ' Show the help so that when we mess around with it, it will take effect ' HELP.Refresh ' ' ' Set the positions and defaults for the help file ' lngWidth = 640 ' lngHeight = 480 ' lngLeft = ((Screen.Width / Screen.TwipsPerPixelX) - lngWidth) / 2 ' lngTop = ((Screen.Height / Screen.TwipsPerPixelY) - lngHeight) / 2 ' If HELP.SetWindowPosition(lngLeft, lngTop, lngWidth, lngHeight, SW_HIDE, , lngErrNum, strErrDesc) = False Then GoSub ShowError ' If HELP.SetDefaultContextID(1000, lngErrNum, strErrDesc) = False Then GoSub ShowError ' If HELP.SetPopupPosition(0, 0, lngErrNum, strErrDesc) = False Then GoSub ShowError ' ' ' Display the file "WINHLP32.HLP" (help on help) ' If HELP.HelpOnHelp(lngErrNum, strErrDesc) = False Then GoSub ShowError ' Stop ' ' Show the various components of the help file ' If HELP.ShowHelpTopics(lngErrNum, strErrDesc) = False Then GoSub ShowError ' Stop ' If HELP.ShowHelpTopicsEx("Add;a;New", lngErrNum, strErrDesc) = False Then GoSub ShowError ' Stop ' If HELP.ShowKeyword("Add;a;New", lngErrNum, strErrDesc) = False Then GoSub ShowError ' Stop ' If HELP.ShowMultiKeyword("Add", lngErrNum, strErrDesc) = False Then GoSub ShowError ' Stop ' If HELP.ShowContents(lngErrNum, strErrDesc) = False Then GoSub ShowError ' Stop ' If HELP.ShowContentsEx(lngErrNum, strErrDesc) = False Then GoSub ShowError ' Stop ' If HELP.ShowContext(1004, lngErrNum, strErrDesc) = False Then GoSub ShowError ' Stop ' If HELP.ShowContextMenu(lngCtrlIDs, lngCtxtIDs, lngErrNum, strErrDesc) = False Then GoSub ShowError ' Stop ' If HELP.SetPopupPosition(1, 1, lngErrNum, strErrDesc) = False Then GoSub ShowError ' If HELP.ShowContextPopUp(1000, lngErrNum, strErrDesc) = False Then GoSub ShowError ' Stop ' If HELP.ShowContextPopUp(1000, lngErrNum, strErrDesc) = False Then GoSub ShowError ' Stop ' If HELP.ShowContextWindow(lngCtrlIDs, lngCtxtIDs, lngErrNum, strErrDesc) = False Then GoSub ShowError ' Stop ' If HELP.ExecuteMacro("TESTMACRO;RUNPROG;SHOWABOUT", lngErrNum, strErrDesc) = False Then GoSub ShowError ' Stop ' Unload Me ' Exit Sub 'ShowError: ' MsgBox "The following error occured:" & Chr(13) & Chr(13) & "Error Number = " & CStr(lngErrNum) & Chr(13) & "Error Description = " & strErrDesc, vbOKOnly + vbExclamation, " ERROR" ' Return ' End Sub ' ' Private Sub Form_Unload(Cancel As Integer) ' Set HELP = Nothing ' End Sub ' '============================================================================================================= ' ' LEGAL: ' ' You are free to use this code as long as you keep the above heading information intact and unchanged. Credit ' given where credit is due. Also, it is not required, but it would be appreciated if you would mention ' somewhere in your compiled program that that your program makes use of code written and distributed by ' Kevin Wilson (www.TheVBZone.com). Feel free to link to this code via your web site or articles. ' ' You may NOT take this code and pass it off as your own. You may NOT distribute this code on your own server ' or web site. You may NOT take code created by Kevin Wilson (www.TheVBZone.com) and use it to create products, ' utilities, or applications that directly compete with products, utilities, and applications created by Kevin ' Wilson, TheVBZone.com, or Wilson Media. You may NOT take this code and sell it for profit without first ' obtaining the written consent of the author Kevin Wilson. ' ' These conditions are subject to change at the discretion of the owner Kevin Wilson at any time without ' warning or notice. Copyright© by Kevin Wilson. All rights reserved. ' '============================================================================================================= ' Type - WinHelp (hWnd, FileName, HELP_MULTIKEY, >MULTIKEYHELP<) Private Type MULTIKEYHELP mkSize As Long '// DWORD - Structure size, in bytes. mkKeylist As String * 1 '// TCHAR - Single character that identifies the keyword table to search. szKeyphrase As String '// TCHAR - Null-terminated text string that specifies the keyword to locate in the keyword table. End Type ' Type - WinHelp (hWnd, FileName, HELP_SETWINPOS, >HELPWININFO<) Private Type HELPWININFO wStructSize As Long '// int - Structure size, in bytes. X As Long '// int - X-coordinate of the upper-left corner of the window, in screen coordinates. Y As Long '// int - Y-coordinate of the upper-left corner of the window, in screen coordinates. dX As Long '// int - Window width, in pixels. dY As Long '// int - Window height, in pixels. wMax As Long '// int - How to show the window. This member must be one of the following values: SW_HIDE, SW_MINIMIZE, SW_RESTORE, SW_SHOW, SW_SHOWMAXIMIZED, SW_SHOWMINIMIZED, SW_SHOWMINNOACTIVE, SW_SHOWNA, SW_SHOWNOACTIVATE, SW_SHOWNORMAL rgchMember As String '// TCHAR - Name of the window. To refer to the MAIN window, set this to NULL (vbNullString) End Type ' Enumeration - General Private Enum BOOL TRUE_ = 1 FALSE_ = 0 End Enum ' Enumeration - Registry Keys Public Enum RegistryKeys HKEY_CLASSES_ROOT = &H80000000 HKEY_CURRENT_CONFIG = &H80000005 HKEY_CURRENT_USER = &H80000001 HKEY_LOCAL_MACHINE = &H80000002 HKEY_USERS = &H80000003 HKEY_DYN_DATA = &H80000006 ' Windows 95/98 HKEY_PERFORMANCE_DATA = &H80000004 ' Windows NT/2000 End Enum ' Enumeration - HELPWININFO.wMax Public Enum WindowStates SW_HIDE = 0 ' Hides the window and passes activation to another window. SW_MINIMIZE = 6 ' Minimizes the specified window and activates the top-level window in the z-order. SW_RESTORE = 9 ' Same as SW_SHOWNORMAL. SW_SHOW = 5 ' Activates a window and displays it in its current size and position. SW_SHOWMAXIMIZED = 3 ' Activates the window and displays it as a maximized window. SW_SHOWMINIMIZED = 2 ' Activates the window and displays it as an icon. SW_SHOWMINNOACTIVE = 7 ' Displays the window as an icon. The window that is currently active remains active. SW_SHOWNA = 8 ' Displays the window in its current state. The window that is currently active remains active. SW_SHOWNOACTIVATE = 4 ' Displays a window in its most recent size and position. The window that is currently active remains active. SW_SHOWNORMAL = 1 ' Activates and displays the window. Whether the window is minimized or maximized, Windows restores it to its original size and position. End Enum ' Constants - General Private Const MAX_PATH = 260 Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000 ' Constants - RegSetValueEx(dwType) Private Const REG_NONE = 0 ' No defined value type. Private Const REG_SZ = 1 ' A null-terminated string. It will be a Unicode or ANSI string, depending on whether you use the Unicode or ANSI functions. Private Const REG_EXPAND_SZ = 2 ' A null-terminated string that contains unexpanded references to environment variables (for example, "%PATH%"). It will be a Unicode or ANSI string depending on whether you use the Unicode or ANSI functions. To expand the environment variable references, use the ExpandEnvironmentStrings function. Private Const REG_BINARY = 3 ' Binary data in any form. Private Const REG_DWORD = 4 ' A 32-bit number. Private Const REG_DWORD_LITTLE_ENDIAN = 4 ' A 32-bit number in little-endian format. This is equivalent to REG_DWORD. In little-endian format, a multi-byte value is stored in memory from the lowest byte (the "little end") to the highest byte. For example, the value 0x12345678 is stored as (0x78 0x56 0x34 0x12) in little-endian format. Windows NT/Windows 2000, Windows 95, and Windows 98 are designed to run on little-endian computer architectures. A user may connect to computers that have big-endian architectures, such as some UNIX systems. Private Const REG_DWORD_BIG_ENDIAN = 5 ' A 32-bit number in big-endian format. In big-endian format, a multi-byte value is stored in memory from the highest byte (the "big end") to the lowest byte. For example, the value 0x12345678 is stored as (0x12 0x34 0x56 0x78) in big-endian format. Private Const REG_LINK = 6 ' A Unicode symbolic link. Used internally; applications should not use this type. Private Const REG_MULTI_SZ = 7 ' An array of null-terminated strings, terminated by two null characters. Private Const REG_RESOURCE_LIST = 8 ' A device-driver resource list. Private Const REG_FULL_RESOURCE_DESCRIPTOR = 9 ' Resource list in the hardware description Private Const REG_RESOURCE_REQUIREMENTS_LIST = 10 ' Constants - RegCreateKeyEx(dwOptions) Private Const REG_OPTION_NON_VOLATILE = 0 ' This key is not volatile; this is the default. The information is stored in a file and is preserved when the system is restarted. The RegSaveKey function saves keys that are not volatile. Private Const REG_OPTION_VOLATILE = 1 ' Windows NT/2000 : All keys created by the function are volatile. The information is stored in memory and is not preserved when the corresponding registry hive is unloaded. For HKEY_LOCAL_MACHINE, this occurs when the system is shut down. For registry keys loaded by the RegLoadKey function, this occurs when the corresponding RegUnloadKey is performed. The RegSaveKey function does not save volatile keys. This flag is ignored for keys that already exist. ' Windows 95 : This value is ignored. If REG_OPTION_VOLATILE is specified, the RegCreateKeyEx function creates nonvolatile keys and returns ERROR_SUCCESS. Private Const REG_OPTION_BACKUP_RESTORE = 4 ' Windows NT/2000 : If this flag is set, the function ignores the samDesired parameter and attempts to open the key with the access required to backup or restore the key. If the calling thread has the SE_BACKUP_NAME privilege enabled, the key is opened with ACCESS_SYSTEM_SECURITY and KEY_READ access. If the calling thread has the SE_RESTORE_NAME privilege enabled, the key is opened with ACCESS_SYSTEM_SECURITY and KEY_WRITE access. If both privileges are enabled, the key has the combined accesses for both privileges. ' Constants - RegOpenKeyEx(samDesired) Private Const KEY_CREATE_LINK = 32 ' Permission to create a symbolic link. Private Const KEY_CREATE_SUB_KEY = 4 ' Permission to create subkeys. Private Const KEY_ENUMERATE_SUB_KEYS = 8 ' Permission to enumerate subkeys. Private Const KEY_EXECUTE = 131097 ' Permission for read access. Private Const KEY_NOTIFY = 16 ' Permission for change notification. Private Const KEY_QUERY_VALUE = 1 ' Permission to query subkey data. Private Const KEY_SET_VALUE = 2 ' Permission to set subkey data. Private Const KEY_ALL_ACCESS = 983103 ' Combines the KEY_QUERY_VALUE, KEY_ENUMERATE_SUB_KEYS, KEY_NOTIFY, KEY_CREATE_SUB_KEY, KEY_CREATE_LINK, and KEY_SET_VALUE access rights, plus all the standard access rights except SYNCHRONIZE. Private Const KEY_READ = 131097 ' Combines the STANDARD_RIGHTS_READ, KEY_QUERY_VALUE, KEY_ENUMERATE_SUB_KEYS, and KEY_NOTIFY access rights. Private Const KEY_WRITE = 131078 ' Combines the STANDARD_RIGHTS_WRITE, KEY_SET_VALUE, and KEY_CREATE_SUB_KEY access rights. ' Constants - RegCreateKeyEx(lpdwDisposition) Private Const REG_CREATED_NEW_KEY = &H1 ' The key did not exist and was created. Private Const REG_OPENED_EXISTING_KEY = &H2 ' The key existed and was simply opened without being changed. ' Constants - WinHelp.uCommand Private Const HELP_COMMAND As Long = &H102 ' Executes a Help macro or macro string. ' • Data: Address of a string that specifies the name of the Help macro(s) to run. If the string specifies multiple macro names, the names must be separated by semicolons. You must use the short form of the macro name for some macros because Windows Help does not support the long name. Private Const HELP_CONTENTS As Long = &H3 ' Displays the topic specified by the Contents option in the [OPTIONS] section of the .hpj file. This command is for backward compatibility. New applications should provide a .cnt file and use the HELP_FINDER command. ' • Data: Ignored; set to 0. Private Const HELP_CONTEXT As Long = &H1 ' Displays the topic identified by the specified context identifier defined in the [MAP] section of the .hpj file. ' • Data: Contains the context identifier for the topic. Private Const HELP_CONTEXTMENU As Long = &HA ' Displays the Help menu for the selected window, then displays the topic for the selected control in a pop-up window. ' • Data: Address of an array of double word pairs. The first double word in each pair is the control identifier, and the second is the context identifier for the topic. The array must be terminated by a pair of zeros {0,0}. If you do not want to add Help to a particular control, set its context identifier to -1. Private Const HELP_CONTEXTPOPUP As Long = &H8 ' Displays the topic identified by the specified context identifier defined in the [MAP] section of the .hpj file in a pop-up window. ' • Data: Contains the context identifier for a topic. Private Const HELP_FINDER As Long = &HB ' Displays the Help Topics dialog box. ' • Data: Ignored; set to 0. Private Const HELP_FORCEFILE As Long = &H9 ' Ensures that Windows Help is displaying the correct Help file. If the incorrect Help file is being displayed, Windows Help opens the correct one; otherwise, there is no action. ' • Data: Ignored; set to 0. Private Const HELP_HELPONHELP As Long = &H4 ' Displays help on how to use Windows Help, if the Winhlp32.hlp file is available. ' • Data: Ignored; set to 0. Private Const HELP_INDEX As Long = &H3 ' Displays the topic specified by the Contents option in the [OPTIONS] section of the .hpj file. This command is for backward compatibility. New applications should use the HELP_FINDER command. ' • Data: Ignored; set to 0. Private Const HELP_KEY As Long = &H101 ' Displays the topic in the keyword table that matches the specified keyword, if there is an exact match. If there is more than one match, displays the Index with the topics listed in the Topics Found list box. ' • Data: Address of a keyword string. Multiple keywords must be separated by semicolons. Private Const HELP_MULTIKEY As Long = &H201 ' Displays the topic specified by a keyword in an alternative keyword table. ' • Data: Address of a MULTIKEYHELP structure that specifies a table footnote character and a keyword. Private Const HELP_PARTIALKEY As Long = &H105 ' Displays the topic in the keyword table that matches the specified keyword, if there is an exact match. If there is more than one match, displays the Topics Found dialog box. To display the index without passing a keyword, use a pointer to an empty string. ' • Data: Address of a keyword string. Multiple keywords must be separated by semicolons. Private Const HELP_QUIT As Long = &H2 ' Informs Windows Help that it is no longer needed. If no other applications have asked for help, Windows closes Windows Help. ' • Data: Ignored; set to 0. Private Const HELP_SETCONTENTS As Long = &H5 ' Specifies the Contents topic. Windows Help displays this topic when the user clicks the Contents button if the Help file does not have an associated .cnt file. ' • Data: Contains the context identifier for the Contents topic. Private Const HELP_SETPOPUP_POS As Long = &HD ' Sets the position of the subsequent pop-up window. ' • Data: Contains the position data. Use MAKELONG to concatenate the horizontal and vertical coordinates into a single value. The pop-up window is positioned as if the mouse cursor were at the specified point when the pop-up window was invoked. Private Const HELP_SETWINPOS As Long = &H203 ' Displays the Windows Help window, if it is minimized or in memory, and sets its size and position as specified. ' • Data: Address of a HELPWININFO structure that specifies the size and position of either a primary or secondary Help window. Private Const HELP_TCARD As Long = &H8000 ' Indicates that a command is for a training card instance of Windows Help. Combine this command with other commands using the bitwise OR operator. ' • Data: Depends on the command with which this command is combined. Private Const HELP_WM_HELP As Long = &HC ' Displays the topic for the control identified by the hWndMain parameter in a pop-up window. ' • Data: Address of an array of double word pairs. The first double word in each pair is a control identifier, and the second is a context identifier for a topic. The array must be terminated by a pair of zeros {0,0}. If you do not want to add Help to a particular control, set its context identifier to -1. ' Class Module Constants Private Const ERR_MSG_NUMBER As Long = -1 Private Const ERR_MSG_NO_HANLDE As String = "No calling handle specified to open the help file with" Private Const ERR_MSG_NO_FILE As String = "No help file specified to work with" ' Class Module Property Variables Private p_hWnd As Long Private p_FilePath As String Private p_FileName As String Private p_CloseHelp As Boolean ' Win32 API Declarations Private Declare Sub SetLastError Lib "kernel32.dll" (ByVal dwErrCode As Long) Private Declare Function WinHelp Lib "USER32.DLL" Alias "WinHelpA" (ByVal hWnd As Long, ByVal strFilePath As String, ByVal uCommand As Long, ByRef Data As Any) As BOOL Private Declare Function GetShortPathName Lib "kernel32.dll" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, ByRef phkResult As Long, ByRef lpdwDisposition As Long) As Long Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long Private Declare Function FormatMessage Lib "kernel32.dll" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long Private Declare Function GetLastError Lib "kernel32.dll" () As Long Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Any, ByVal cbData As Long) As Long Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByRef lpData As Any, ByRef lpcbData As Long) As Long Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX Private Sub Class_Initialize() ' Setup default class values p_CloseHelp = True End Sub Private Sub Class_Terminate() ' Close the help file If p_hWnd <> 0 And p_FilePath <> "" Then If p_CloseHelp = True Then Me.CloseHelp End If End If End Sub 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ' Specifies the calling Window or process (Form1.hWnd or App.hInstance) Public Property Get CallingHandle() As Long CallingHandle = p_hWnd End Property Public Property Let CallingHandle(ByVal NewValue As Long) p_hWnd = NewValue End Property ' If set to TRUE, the WinHelp called by this class module will be closed when this class is terminated Public Property Get CloseHelpOnTerminate() As Boolean CloseHelpOnTerminate = p_CloseHelp End Property Public Property Let CloseHelpOnTerminate(ByVal NewValue As Boolean) p_CloseHelp = NewValue End Property ' Specifies the WinHelp file (.HLP) to use Public Property Get HelpFile() As String HelpFile = p_FilePath End Property Public Property Let HelpFile(ByVal NewValue As String) On Error Resume Next Dim strExt As String Dim strName As String Dim strReturn As String ' Clear the previous help file information p_FileName = "" p_FilePath = "" ' Validate the parameters If Trim(NewValue) = "" Then GoTo InvalidFile If UCase(Right(Trim(NewValue), Len(".HLP"))) <> ".HLP" Then GoTo InvalidFile ' If the file specified by "NewValue" isn't found, look in the Windows Registry to see if it's in WinHelp's search path strReturn = Dir(NewValue, vbArchive Or vbHidden Or vbNormal Or vbReadOnly Or vbSystem) If strReturn = "" Then If InStr(1, NewValue, "\", vbTextCompare) > 0 Then GoTo InvalidFile If HelpFile_GetRegistration(NewValue, strReturn) = True Then If strReturn = "" Then GoTo InvalidFile If Right(strReturn, 1) <> "\" Then strReturn = strReturn & "\" NewValue = strReturn & NewValue Else GoTo InvalidFile End If End If ' Make sure the file exists, and if it does, change the LONG name to a SHORT name NewValue = ConvertLong2Short(NewValue) If NewValue = "" Then GoTo InvalidFile ' Get the file name from the path and store both If GetFileExt(NewValue, strName, strExt) = True Then If UCase(Trim(strExt)) <> "HLP" Then GoTo InvalidFile p_FileName = strName & "." & strExt p_FilePath = NewValue Else GoTo InvalidFile End If Exit Property InvalidFile: On Error GoTo 0 Err.Raise ERR_MSG_NUMBER, "cWinHelp.HelpFile [Let]", "The help file was not specified, could not be found, or was invalid" End Property 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ' Closes the current WinHelp document Public Function CloseHelp(Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean Dim lngCommand As Long Dim hWnd As Long Dim strFile As String ' Setup subclassing if required lngCommand = HELP_QUIT Or HELP_TCARD ' Clear the return variables Return_ErrNum = 0 Return_ErrDesc = "" ' Make sure the required properties have been set If p_hWnd <> 0 Then hWnd = p_hWnd If Trim(p_FilePath) = "" Then strFile = vbNullString Else strFile = p_FilePath End If ' Shut down the WinHelp file If WinHelp(hWnd, strFile, lngCommand, ByVal 0) = FALSE_ Then GetLastErr_Msg Err.LastDllError, "WinHelp", Return_ErrNum, Return_ErrDesc, False Else CloseHelp = True End If End Function ' Executes one or more macros passed to this function. If more than one macros are to be run, seperate ' the names of each macro by a semicolon (;). Public Function ExecuteMacro(ByVal strMacroNames As String, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean On Error GoTo ErrorTrap: Dim lngCommand As Long ' Setup subclassing if required lngCommand = HELP_COMMAND Or HELP_TCARD ' Clear the return variables Return_ErrNum = 0 Return_ErrDesc = "" ' Make sure the required properties have been set If p_hWnd = 0 Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_HANLDE Exit Function ElseIf p_FilePath = "" Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_FILE Exit Function End If If Right(strMacroNames, 1) <> Chr(0) Then strMacroNames = strMacroNames & Chr(0) ' Execute the macro(s) If WinHelp(p_hWnd, p_FilePath, lngCommand, ByVal strMacroNames) = FALSE_ Then GetLastErr_Msg Err.LastDllError, "WinHelp", Return_ErrNum, Return_ErrDesc, False Else ExecuteMacro = True End If Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrDesc = Err.Description Err.Clear End Function ' Specifies the Contents topic. Windows Help displays this topic when the user clicks the ' "Contents" button if the Help file does not have an associated .CNT file. Public Function SetDefaultContextID(ByVal lngContextID As Long, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean Dim lngCommand As Long ' Setup subclassing if required lngCommand = HELP_SETCONTENTS Or HELP_TCARD ' Clear the return variables Return_ErrNum = 0 Return_ErrDesc = "" ' Make sure the required properties have been set If p_hWnd = 0 Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_HANLDE Exit Function ElseIf p_FilePath = "" Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_FILE Exit Function End If ' Show the help topics If WinHelp(p_hWnd, p_FilePath, lngCommand, ByVal lngContextID) = FALSE_ Then GetLastErr_Msg Err.LastDllError, "WinHelp", Return_ErrNum, Return_ErrDesc, False Else SetDefaultContextID = True End If End Function ' Sets the position of the subsequent pop-up window. Public Function SetPopupPosition(ByVal intX As Integer, _ ByVal intY As Integer, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean Dim lngValue As Long Dim lngCommand As Long ' Setup subclassing if required lngCommand = HELP_SETPOPUP_POS Or HELP_TCARD ' Clear the return variables Return_ErrNum = 0 Return_ErrDesc = "" ' Make sure the required properties have been set If p_hWnd = 0 Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_HANLDE Exit Function ElseIf p_FilePath = "" Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_FILE Exit Function End If ' Combine the X and Y integers into a LONG value lngValue = MAKELONG(intX, intY) ' Show the help topics If WinHelp(p_hWnd, p_FilePath, lngCommand, ByVal lngValue) = FALSE_ Then GetLastErr_Msg Err.LastDllError, "WinHelp", Return_ErrNum, Return_ErrDesc, False Else SetPopupPosition = True End If End Function ' Displays the Windows Help window, if it is minimized or in memory, and sets its size and ' position as specified. ' NOTE: Left, Top, Width, & Height are all measurements in PIXELS Public Function SetWindowPosition(Optional ByVal lngLeft As Long = 0, _ Optional ByVal lngTop As Long = 0, _ Optional ByVal lngWidth As Long = 800, _ Optional ByVal lngHeight As Long = 600, _ Optional ByVal WindowStates As WindowStates = SW_SHOWNORMAL, _ Optional ByVal WindowName As String = vbNullString, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean Dim WinInfo As HELPWININFO Dim lngCommand As Long ' Setup subclassing if required lngCommand = HELP_SETWINPOS Or HELP_TCARD ' Clear the return variables Return_ErrNum = 0 Return_ErrDesc = "" ' Make sure the required properties have been set If p_hWnd = 0 Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_HANLDE Exit Function ElseIf p_FilePath = "" Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_FILE Exit Function End If ' Modify the MAIN help window If Trim(WindowName) = "" Then WindowName = vbNullString ' Modify a specific window (by name) Else If Right(WindowName, 1) <> Chr(0) Then WindowName = WindowName & Chr(0) End If ' Setup the information to pass to the WinHelp function With WinInfo .wStructSize = Len(WinInfo) .X = lngLeft .Y = lngTop .dX = lngWidth .dY = lngHeight .wMax = WindowStates .rgchMember = WindowName End With ' Show the help topics If WinHelp(p_hWnd, p_FilePath, lngCommand, WinInfo) = FALSE_ Then GetLastErr_Msg Err.LastDllError, "WinHelp", Return_ErrNum, Return_ErrDesc, False Else SetWindowPosition = True End If End Function ' Displays the topic specified by the Contents option in the [OPTIONS] section of the .hpj file. ' This command is for backward compatibility. New applications should use the HELP_FINDER command. Public Function ShowContents(Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean Dim lngCommand As Long ' Setup subclassing if required lngCommand = HELP_INDEX Or HELP_TCARD ' Clear the return variables Return_ErrNum = 0 Return_ErrDesc = "" ' Make sure the required properties have been set If p_hWnd = 0 Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_HANLDE Exit Function ElseIf p_FilePath = "" Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_FILE Exit Function End If ' Show the help topics If WinHelp(p_hWnd, p_FilePath, lngCommand, ByVal 0) = FALSE_ Then GetLastErr_Msg Err.LastDllError, "WinHelp", Return_ErrNum, Return_ErrDesc, False Else ShowContents = True End If End Function ' Displays the topic specified by the Contents option in the [OPTIONS] section of the .hpj file. Public Function ShowContentsEx(Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean Dim lngCommand As Long ' Setup subclassing if required lngCommand = HELP_CONTENTS Or HELP_TCARD ' Clear the return variables Return_ErrNum = 0 Return_ErrDesc = "" ' Make sure the required properties have been set If p_hWnd = 0 Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_HANLDE Exit Function ElseIf p_FilePath = "" Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_FILE Exit Function End If ' Show the help contents If WinHelp(p_hWnd, p_FilePath, lngCommand, ByVal 0) = FALSE_ Then GetLastErr_Msg Err.LastDllError, "WinHelp", Return_ErrNum, Return_ErrDesc, False Else ShowContentsEx = True End If End Function ' Displays the topic identified by the specified context identifier defined in the [MAP] section of the .hpj file. Public Function ShowContext(ByVal lngTopicContextID As Long, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean Dim lngCommand As Long ' Setup subclassing if required lngCommand = HELP_CONTEXT Or HELP_TCARD ' Clear the return variables Return_ErrNum = 0 Return_ErrDesc = "" ' Make sure the required properties have been set If p_hWnd = 0 Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_HANLDE Exit Function ElseIf p_FilePath = "" Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_FILE Exit Function End If ' Show the help context If WinHelp(p_hWnd, p_FilePath, lngCommand, ByVal lngTopicContextID) = FALSE_ Then GetLastErr_Msg Err.LastDllError, "WinHelp", Return_ErrNum, Return_ErrDesc, False Else ShowContext = True End If End Function ' Displays the Help menu for the selected window, then displays the topic for the selected control in a pop-up window. ' If you do not want to add Help to a particular control, set its context identifier to -1. Public Function ShowContextMenu(ByRef lngControlIDs() As Long, _ ByRef lngTopicContextIDs() As Long, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean Dim lngCounter As Long Dim lngIDs() As Long Dim lngIDCount As Long Dim lngCommand As Long ' Setup subclassing if required lngCommand = HELP_CONTEXTMENU Or HELP_TCARD ' Clear the return variables Return_ErrNum = 0 Return_ErrDesc = "" ' Make sure the required properties have been set If p_hWnd = 0 Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_HANLDE Exit Function ElseIf p_FilePath = "" Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_FILE Exit Function ElseIf UBound(lngControlIDs) <> UBound(lngTopicContextIDs) And LBound(lngControlIDs) <> LBound(lngTopicContextIDs) Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = "The number of Control ID's does not match the number of Topic Context ID's" Exit Function End If ' Put the ID's into pairs to pass them to the WinHelp function For lngCounter = LBound(lngControlIDs) To UBound(lngControlIDs) ReDim Preserve lngIDs(0 To lngIDCount + 1) As Long lngIDs(lngIDCount) = lngControlIDs(lngCounter) lngIDs(lngIDCount + 1) = lngTopicContextIDs(lngCounter) lngIDCount = lngIDCount + 2 Next ' Add an "ending pair" to the array (as per documentation) ReDim Preserve lngIDs(0 To lngIDCount + 1) As Long lngIDs(lngIDCount) = 0 lngIDs(lngIDCount + 1) = 0 lngIDCount = lngIDCount + 2 ' Show the help context menu If WinHelp(p_hWnd, p_FilePath, lngCommand, lngIDs(0)) = FALSE_ Then GetLastErr_Msg Err.LastDllError, "WinHelp", Return_ErrNum, Return_ErrDesc, False Else ShowContextMenu = True End If End Function ' Displays the topic identified by the specified context identifier defined in the [MAP] section of the .hpj file in a pop-up window. Public Function ShowContextPopUp(ByVal lngTopicContextID As Long, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean Dim lngCommand As Long ' Setup subclassing if required lngCommand = HELP_CONTEXTPOPUP Or HELP_TCARD ' Clear the return variables Return_ErrNum = 0 Return_ErrDesc = "" ' Make sure the required properties have been set If p_hWnd = 0 Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_HANLDE Exit Function ElseIf p_FilePath = "" Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_FILE Exit Function End If ' Show the help context popup If WinHelp(p_hWnd, p_FilePath, lngCommand, ByVal lngTopicContextID) = FALSE_ Then GetLastErr_Msg Err.LastDllError, "WinHelp", Return_ErrNum, Return_ErrDesc, False Else ShowContextPopUp = True End If End Function ' Displays the topic for the control identified by the hWndMain parameter in a pop-up window. ' If you do not want to add Help to a particular control, set its context identifier to -1. Public Function ShowContextWindow(ByRef lngControlIDs() As Long, _ ByRef lngTopicContextIDs() As Long, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean Dim lngCounter As Long Dim lngIDs() As Long Dim lngIDCount As Long Dim lngCommand As Long ' Setup subclassing if required lngCommand = HELP_WM_HELP Or HELP_TCARD ' Clear the return variables Return_ErrNum = 0 Return_ErrDesc = "" ' Make sure the required properties have been set If p_hWnd = 0 Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_HANLDE Exit Function ElseIf p_FilePath = "" Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_FILE Exit Function ElseIf UBound(lngControlIDs) <> UBound(lngTopicContextIDs) And LBound(lngControlIDs) <> LBound(lngTopicContextIDs) Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = "The number of Control ID's does not match the number of Topic Context ID's" Exit Function End If ' Put the ID's into pairs to pass them to the WinHelp function For lngCounter = LBound(lngControlIDs) To UBound(lngControlIDs) ReDim Preserve lngIDs(0 To lngIDCount + 1) As Long lngIDs(lngIDCount) = lngControlIDs(lngCounter) lngIDs(lngIDCount + 1) = lngTopicContextIDs(lngCounter) lngIDCount = lngIDCount + 2 Next ' Add an "ending pair" to the array (as per documentation) ReDim Preserve lngIDs(0 To lngIDCount + 1) As Long lngIDs(lngIDCount) = 0 lngIDs(lngIDCount + 1) = 0 lngIDCount = lngIDCount + 2 ' Show the help context menu If WinHelp(p_hWnd, p_FilePath, lngCommand, lngIDs(0)) = FALSE_ Then GetLastErr_Msg Err.LastDllError, "WinHelp", Return_ErrNum, Return_ErrDesc, False Else ShowContextWindow = True End If End Function ' Displays the Help Topics dialog box. Public Function ShowHelpTopics(Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean Dim lngCommand As Long ' Setup subclassing if required lngCommand = HELP_FINDER Or HELP_TCARD ' Clear the return variables Return_ErrNum = 0 Return_ErrDesc = "" ' Make sure the required properties have been set If p_hWnd = 0 Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_HANLDE Exit Function ElseIf p_FilePath = "" Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_FILE Exit Function End If ' Show the help topics If WinHelp(p_hWnd, p_FilePath, lngCommand, ByVal 0) = FALSE_ Then GetLastErr_Msg Err.LastDllError, "WinHelp", Return_ErrNum, Return_ErrDesc, False Else ShowHelpTopics = True End If End Function ' Displays the topic in the keyword table that matches the specified keyword, if there is an exact ' match. If there is more than one match or there are no matches, it displays the Topics Found ' dialog box. To display the index without passing a keyword, specify a BLANK string. If more ' than one keyword are to be specified, seperate the them by a semicolon (;). Public Function ShowHelpTopicsEx(Optional ByVal strKeyWords As String, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean Dim lngCommand As Long ' Setup subclassing if required lngCommand = HELP_PARTIALKEY Or HELP_TCARD ' Clear the return variables Return_ErrNum = 0 Return_ErrDesc = "" ' Make sure the required properties have been set If p_hWnd = 0 Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_HANLDE Exit Function ElseIf p_FilePath = "" Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_FILE Exit Function End If If Trim(strKeyWords) = "" Then strKeyWords = vbNullString Else If Right(strKeyWords, 1) <> Chr(0) Then strKeyWords = strKeyWords & Chr(0) End If ' Show the help topics If WinHelp(p_hWnd, p_FilePath, lngCommand, ByVal strKeyWords) = FALSE_ Then GetLastErr_Msg Err.LastDllError, "WinHelp", Return_ErrNum, Return_ErrDesc, False Else ShowHelpTopicsEx = True End If End Function ' Ensures that Windows Help is displaying the correct Help file. If the incorrect Help file ' is being displayed, Windows Help opens the correct one; otherwise, there is no action. Public Function Refresh(Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean Dim lngCommand As Long ' Setup subclassing if required lngCommand = HELP_FORCEFILE Or HELP_TCARD ' Clear the return variables Return_ErrNum = 0 Return_ErrDesc = "" ' Make sure the required properties have been set If p_hWnd = 0 Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_HANLDE Exit Function ElseIf p_FilePath = "" Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_FILE Exit Function End If ' Refresh the help file If WinHelp(p_hWnd, p_FilePath, lngCommand, ByVal 0) = FALSE_ Then GetLastErr_Msg Err.LastDllError, "WinHelp", Return_ErrNum, Return_ErrDesc, False Else Refresh = True End If End Function ' Displays help on how to use Windows Help, if the WINHLP32.HLP file is available. Public Function HelpOnHelp(Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean Dim lngCommand As Long ' Setup subclassing if required lngCommand = HELP_HELPONHELP Or HELP_TCARD ' Clear the return variables Return_ErrNum = 0 Return_ErrDesc = "" ' Show the "help on help" file If WinHelp(p_hWnd, p_FilePath, lngCommand, ByVal 0) = FALSE_ Then GetLastErr_Msg Err.LastDllError, "WinHelp", Return_ErrNum, Return_ErrDesc, False Else HelpOnHelp = True End If End Function ' Displays the topic in the keyword table that matches the specified keyword, if there is an ' exact match. If there is more than one match, displays the Index with the topics listed in ' the Topics Found list box. If more than one keyword are to be specified, seperate the them ' by a semicolon (;). Public Function ShowKeyword(ByVal strKeyWords As String, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean Dim lngCommand As Long ' Setup subclassing if required lngCommand = HELP_KEY Or HELP_TCARD ' Clear the return variables Return_ErrNum = 0 Return_ErrDesc = "" ' Make sure the required properties have been set If p_hWnd = 0 Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_HANLDE Exit Function ElseIf p_FilePath = "" Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_FILE Exit Function End If If Right(strKeyWords, 1) <> Chr(0) Then strKeyWords = strKeyWords & Chr(0) ' Show the help topics If WinHelp(p_hWnd, p_FilePath, lngCommand, ByVal strKeyWords) = FALSE_ Then GetLastErr_Msg Err.LastDllError, "WinHelp", Return_ErrNum, Return_ErrDesc, False Else ShowKeyword = True End If End Function ' Displays the topic specified by a keyword in an alternative keyword table. Public Function ShowMultiKeyword(ByVal strKeyWord As String, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean Dim MultiKey As MULTIKEYHELP Dim lngCommand As Long ' Setup subclassing if required lngCommand = HELP_MULTIKEY Or HELP_TCARD ' Clear the return variables Return_ErrNum = 0 Return_ErrDesc = "" ' Make sure the required properties have been set If p_hWnd = 0 Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_HANLDE Exit Function ElseIf p_FilePath = "" Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_FILE Exit Function End If If strKeyWord = "" Then strKeyWord = vbNullString Else If Right(strKeyWord, 1) <> Chr(0) Then strKeyWord = strKeyWord & Chr(0) End If ' Initialize the structure to use MultiKey.mkSize = Len(MultiKey) MultiKey.mkKeylist = "1" MultiKey.szKeyphrase = strKeyWord ' Show the help topics If WinHelp(p_hWnd, p_FilePath, lngCommand, MultiKey) = FALSE_ Then GetLastErr_Msg Err.LastDllError, "WinHelp", Return_ErrNum, Return_ErrDesc, False Else ShowMultiKeyword = True End If End Function ' This function retrieves the specified help file's (WITHOUT PATH) "search path" from the Windows registry (if it ' has been previously registered). WinHelp "search paths" are stored under the Windows registry key ' "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\Help\" Public Function HelpFile_GetRegistration(Optional ByVal strHelpFile As String, _ Optional ByRef Return_HelpPath As String, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean Dim strKey As String ' Clear the return variables Return_ErrNum = 0 Return_ErrDesc = "" Return_HelpPath = "" ' Make sure the required properties have been set If Trim(p_FileName) = "" And Trim(strHelpFile) = "" Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_FILE Exit Function End If ' Get the key to use strKey = p_FileName If strHelpFile <> "" Then strKey = strHelpFile ' Get the currently registered path for the help file specified HelpFile_GetRegistration = REG_GetString(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\Help", strKey, Return_HelpPath, Return_ErrNum, Return_ErrDesc) ' If the key doesn't exists, return that we got the right information... BLANK If HelpFile_GetRegistration = False And Return_ErrNum = 2 Then Return_ErrNum = 0 Return_ErrDesc = "" Return_HelpPath = "" HelpFile_GetRegistration = True End If End Function ' This function will add the specified help file (WITHOUT PATH) and it's path (WITHOUT FILE NAME) to the WinHelp ' "search path" in the Windows Registry. WinHelp "search paths" are stored under the Windows registry key ' "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\Help\" Public Function HelpFile_Register(Optional ByVal strHelpFile As String, _ Optional ByVal strHelpPath As String, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean Dim strKey As String ' Clear the return variables Return_ErrNum = 0 Return_ErrDesc = "" ' Make sure the required properties have been set If Trim(p_FileName) = "" And Trim(strHelpFile) = "" Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_FILE Exit Function ElseIf Dir(strHelpPath, vbArchive Or vbDirectory Or vbHidden Or vbNormal Or vbReadOnly Or vbSystem) = "" Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = "The help path specified to register does not exist, or is invalid" Exit Function End If ' Get the key to use strKey = p_FileName If strHelpFile <> "" Then strKey = strHelpFile ' Register the specified help file in the Windows registry so that WinHelp can find it. HelpFile_Register = REG_SaveString(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\Help", strKey, strHelpPath, Return_ErrNum, Return_ErrDesc) End Function ' This function removes the specified help file's (WITHOUT PATH) "search path" from the Windows registry (if it ' has been previously registered). WinHelp "search paths" are stored under the Windows registry key ' "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\Help\" Public Function HelpFile_Unregister(Optional ByVal strHelpFile As String, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean Dim strKey As String ' Clear the return variables Return_ErrNum = 0 Return_ErrDesc = "" ' Make sure the required properties have been set If Trim(p_FileName) = "" And Trim(strHelpFile) = "" Then Return_ErrNum = ERR_MSG_NUMBER: Return_ErrDesc = ERR_MSG_NO_FILE Exit Function End If ' Get the key to use strKey = p_FileName If strHelpFile <> "" Then strKey = strHelpFile ' Unregister the specified help file (if it exists) HelpFile_Unregister = REG_DeleteValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\Help", strKey, Return_ErrNum, Return_ErrDesc) ' If the key doesn't exists, return that deleted it correctly If HelpFile_Unregister = False And Return_ErrNum = 2 Then Return_ErrNum = 0 Return_ErrDesc = "" HelpFile_Unregister = True End If End Function 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX '============================================================================================================= ' REG_DeleteValue ' ' Purpose : ' ¯¯¯¯¯¯¯¯¯ ' Function that deletes the specified value under the specified key ' ' Param : Use : ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ' hKey Specifies the main HKEY_?? to look for the specified key ' strKey Path to the key to look in for the specified value ' strValue Name of the value to delete ' Return_ErrNum Optional. If an error occurs, this returns the number. ' Return_ErrDesc Optional. If an error occurs, this returns the description. ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns FALSE if failed. ' ' Sample Use: ' ¯¯¯¯¯¯¯¯¯¯¯ '============================================================================================================= Private Function REG_DeleteValue(ByVal hKey As RegistryKeys, _ ByVal strKey As String, _ ByVal strValue As String, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean On Error GoTo ErrorTrap Dim ReturnValue As Long Dim TheKey As Long ' Clear the return variables Return_ErrNum = 0 Return_ErrDesc = "" ' Get the handle to the registry key specified by the user ReturnValue = RegOpenKeyEx(hKey, strKey, 0, KEY_ALL_ACCESS, TheKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegOpenKeyEx", Return_ErrNum, Return_ErrDesc, False Exit Function End If ' Delete the value ReturnValue = RegDeleteValue(TheKey, strValue) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegDeleteValue", Return_ErrNum, Return_ErrDesc, False GoTo CleanUp End If REG_DeleteValue = True CleanUp: ' Close the opened key If TheKey <> 0 Then ReturnValue = RegCloseKey(TheKey) TheKey = 0 If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegCloseKey", Return_ErrNum, Return_ErrDesc, False End If End If Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrDesc = Err.Description Err.Clear If Return_ErrNum = 0 Or Return_ErrNum = 20 Then Return_ErrNum = 0: Return_ErrDesc = "" Resume Next Else GoTo CleanUp End If End Function '============================================================================================================= ' REG_GetDataType ' ' Purpose : ' ¯¯¯¯¯¯¯¯¯ ' Function that inspects a specified registry Key\Value to see what type of entry it is. ' ' Param : Use : ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ' hKey Specifies the main HKEY_?? to look for the specified key ' strKey Path to the key to look in for the specified value ' strValue Name of the value to get the data type of ' Return_TypeLNG Optional. Returns the data type as a LONG variable ' Return_TypeSTR Optional. Returns the data type as a STRING variable ' Return_DataSize Optional. Returns the size in BYTEs of the data ' Return_ErrNum Optional. If an error occurs, this returns the number. ' Return_ErrDesc Optional. If an error occurs, this returns the description. ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns FALSE if failed. ' ' Sample Use: ' ¯¯¯¯¯¯¯¯¯¯¯ '============================================================================================================= Private Function REG_GetDataType(ByVal hKey As RegistryKeys, _ ByVal strKey As String, _ ByVal strValue As String, _ Optional ByRef Return_TypeLNG As Long, _ Optional ByRef Return_TypeSTR As String, _ Optional ByRef Return_DataSize As Long, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean On Error GoTo ErrorTrap Dim ReturnValue As Long Dim TheKey As Long ' Clear the return variabes Return_DataSize = 0 Return_ErrDesc = "" Return_ErrNum = 0 Return_TypeLNG = 0 Return_TypeSTR = "" ' Get the handle to the registry key specified by the user ReturnValue = RegOpenKeyEx(hKey, strKey, 0, KEY_ALL_ACCESS, TheKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegOpenKeyEx", Return_ErrNum, Return_ErrDesc, False Exit Function End If ' Get the size and type of the data ReturnValue = RegQueryValueEx(TheKey, strValue, 0, Return_TypeLNG, ByVal 0&, Return_DataSize) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegQueryValueEx", Return_ErrNum, Return_ErrDesc, False GoTo CleanUp End If ' Find what type the return was and return a string equivelent for it Select Case Return_TypeLNG Case REG_SZ ' 1 = A null-terminated string. It will be a Unicode or ANSI string, depending on whether you use the Unicode or ANSI functions. Return_TypeSTR = "String" Case REG_BINARY ' 3 = Binary data in any form. Return_TypeSTR = "Binary" Case REG_DWORD ' 4 = A 32-bit number. Return_TypeSTR = "DWORD" Case REG_DWORD_LITTLE_ENDIAN ' 4 = A 32-bit number in little-endian format. This is equivalent to REG_DWORD. In little-endian format, a multi-byte value is stored in memory from the lowest byte (the "little end") to the highest byte. For example, the value 0x12345678 is stored as (0x78 0x56 0x34 0x12) in little-endian format. ' Windows NT/Windows 2000, Windows 95, and Windows 98 are designed to run on little-endian computer architectures. A user may connect to computers that have big-endian architectures, such as some UNIX systems. Return_TypeSTR = "DWORD - Little Endian" Case REG_DWORD_BIG_ENDIAN ' 5 = A 32-bit number in big-endian format. In big-endian format, a multi-byte value is stored in memory from the highest byte (the "big end") to the lowest byte. For example, the value 0x12345678 is stored as (0x12 0x34 0x56 0x78) in big-endian format. Return_TypeSTR = "DWORD - Big Endian" Case REG_EXPAND_SZ ' 2 = A null-terminated string that contains unexpanded references to environment variables (for example, "%PATH%"). It will be a Unicode or ANSI string depending on whether you use the Unicode or ANSI functions. To expand the environment variable references, use the ExpandEnvironmentStrings function. Return_TypeSTR = "Unexpanded references to an environment variable" Case REG_LINK ' 6 = A Unicode symbolic link. Used internally; applications should not use this type. Return_TypeSTR = "Unicode Symbolic Link" Case REG_MULTI_SZ ' 7 = An array of null-terminated strings, terminated by two null characters. Return_TypeSTR = "String Array" Case REG_RESOURCE_LIST ' 8 = A device-driver resource list. Return_TypeSTR = "Device Driver Resource List" Case REG_NONE ' 0 = No defined value type. Return_TypeSTR = "Undefined Type" Case Else Return_TypeSTR = "Unknown Type" End Select REG_GetDataType = True CleanUp: ' Close the opened key If TheKey <> 0 Then ReturnValue = RegCloseKey(TheKey) TheKey = 0 If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegCloseKey", Return_ErrNum, Return_ErrDesc, False End If End If Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrDesc = Err.Description Err.Clear If Return_ErrNum = 0 Or Return_ErrNum = 20 Then Return_ErrNum = 0: Return_ErrDesc = "" Resume Next Else GoTo CleanUp End If End Function '============================================================================================================= ' REG_GetString ' ' Purpose : ' ¯¯¯¯¯¯¯¯¯ ' Function that retrieves a String value from the specified registry entry. ' ' NOTE : ' ¯¯¯¯¯¯¯¯¯ ' If you specify "hKey" and "strKey" parameters and then specify the Value as ' vbNullString, the Key's value, or the "Default" value is returned. ' ' Param : Use : ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ' hKey Specifies the main HKEY_?? to look for the specified key ' strKey Path to the key to look in for the specified value ' strValue Name of the value to retrieve the string data from ' Return_String Returns the string data ' Return_ErrNum Optional. If an error occurs, this returns the number. ' Return_ErrDesc Optional. If an error occurs, this returns the description. ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns FALSE if failed. ' ' Sample Use: ' ¯¯¯¯¯¯¯¯¯¯¯ '============================================================================================================= Private Function REG_GetString(ByVal hKey As RegistryKeys, _ ByVal strKey As String, _ ByVal strValue As String, _ ByRef Return_String As String, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean On Error GoTo ErrorTrap Dim ReturnValue As Long Dim TheKey As Long Dim TheType As Long Dim TheSize As Long ' Clear the return variables Return_String = "" Return_ErrNum = 0 Return_ErrDesc = "" ' Get the handle to the registry key specified by the user ReturnValue = RegOpenKeyEx(hKey, strKey, 0, KEY_ALL_ACCESS, TheKey) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegOpenKeyEx", Return_ErrNum, Return_ErrDesc, False Exit Function End If ' Get the size and type of the data If REG_GetDataType(hKey, strKey, strValue, TheType, , TheSize, Return_ErrNum, Return_ErrDesc) = False Then GoTo CleanUp End If ' Make sure that the specified value holds a string value If TheType <> REG_SZ Then Return_ErrNum = -1 Return_ErrDesc = "Specified Key\Value combination is not a 'String' value." GoTo CleanUp End If ' Initialize the buffer to recieve the string data Return_String = String(MAX_PATH, Chr(0)) ' Get the string value ReturnValue = RegQueryValueEx(TheKey, strValue, 0, TheType, ByVal Return_String, TheSize) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegQueryValueEx", Return_ErrNum, Return_ErrDesc, False GoTo CleanUp End If Return_String = Left(Return_String, InStr(Return_String, Chr(0)) - 1) REG_GetString = True CleanUp: ' Close the opened key If TheKey <> 0 Then ReturnValue = RegCloseKey(TheKey) TheKey = 0 If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegCloseKey", Return_ErrNum, Return_ErrDesc, False End If End If Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrDesc = Err.Description Err.Clear If Return_ErrNum = 0 Or Return_ErrNum = 20 Then Return_ErrNum = 0: Return_ErrDesc = "" Resume Next Else GoTo CleanUp End If End Function '============================================================================================================= ' REG_SaveString ' ' Purpose : ' ¯¯¯¯¯¯¯¯¯ ' Function that saves a STRING value to the registry Key\Value specified. ' ' Param : Use : ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ' hKey Specifies the main HKEY_?? to look for the specified key ' strKey Path to the key to look in for the specified value ' strValue Name of the value to save the string to ' strData The STRING data to save to the value ' Return_ErrNum Optional. If an error occurs, this returns the number. ' Return_ErrDesc Optional. If an error occurs, this returns the description. ' ' Return: ' ¯¯¯¯¯¯¯ ' Returns FALSE if failed. ' ' Sample Use: ' ¯¯¯¯¯¯¯¯¯¯¯ '============================================================================================================= Private Function REG_SaveString(ByVal hKey As RegistryKeys, _ ByVal strKey As String, _ ByVal strValue As String, _ ByVal strData As String, _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String) As Boolean On Error GoTo ErrorTrap Dim ReturnValue As Long Dim TheKey As Long Dim TheDisposition As Long ' Clear the return variables Return_ErrNum = 0 Return_ErrDesc = "" ' If the specified key did not exist before, create it, otherwise open it. ReturnValue = RegCreateKeyEx(hKey, strKey, 0, 0, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0, TheKey, TheDisposition) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegCreateKeyEx", Return_ErrNum, Return_ErrDesc, False Exit Function End If ' ' Test if it was created or opened ' If TheDisposition = REG_CREATED_NEW_KEY Then ' Debug.Print "Created new key" ' ElseIf TheDisposition = REG_OPENED_EXISTING_KEY Then ' Debug.Print "Key already existed" ' End If ' Set the value specified for the key ReturnValue = RegSetValueEx(TheKey, strValue, 0, REG_SZ, ByVal strData, Len(strData)) If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegSetValueEx", Return_ErrNum, Return_ErrDesc, False GoTo CleanUp End If REG_SaveString = True CleanUp: ' Close the opened key If TheKey <> 0 Then ReturnValue = RegCloseKey(TheKey) TheKey = 0 If ReturnValue <> 0 Then GetLastErr_Msg ReturnValue, "RegCloseKey", Return_ErrNum, Return_ErrDesc, False End If End If Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrDesc = Err.Description Err.Clear If Return_ErrNum = 0 Or Return_ErrNum = 20 Then Return_ErrNum = 0: Return_ErrDesc = "" Resume Next Else GoTo CleanUp End If End Function ' Function that takes a 32bit file path and converts it to the 16bit equivelant file path Private Function ConvertLong2Short(ByVal strFullPath As String) As String On Error Resume Next ' Validate parameters strFullPath = Trim(strFullPath) If strFullPath = "" Then Exit Function If Dir(strFullPath, vbArchive Or vbHidden Or vbNormal Or vbReadOnly Or vbSystem) = "" Then Exit Function ' Get the short name from the long name If Right(strFullPath, 1) <> Chr(0) Then strFullPath = strFullPath & Chr(0) ConvertLong2Short = String(1024, Chr(0)) If GetShortPathName(strFullPath, ConvertLong2Short, 1024) = 0 Then ConvertLong2Short = "" Else ConvertLong2Short = UCase(Left(ConvertLong2Short, InStr(ConvertLong2Short, Chr(0)) - 1)) End If End Function ' Function that combines two 16bit numbers to make a 32bit number Private Function MAKELONG(ByVal wHigh As Integer, ByVal wLow As Integer) As Long MAKELONG = Val("&H" & Right("0000" & Hex(wHigh), 4) & Right("0000" & Hex(wLow), 4)) End Function ' Function that extracts the "Low Order" (lower 16bits) of a 32bit number Private Function LOWORD(ByVal dwValue As Long) As Integer LOWORD = Val("&H" & Right("0000" & Hex(dwValue), 4)) End Function ' Function that extracts the "High Order" (upper 16bits) of a 32bit number Private Function HIWORD(ByVal dwValue As Long) As Integer HIWORD = Val("&H" & Left(Right("00000000" & Hex(dwValue), 8), 4)) End Function ' Get the file name and extention Private Function GetFileExt(ByVal strFileName As String, _ Optional ByRef Return_FileName As String, _ Optional ByRef Return_FileExt As String) As Boolean Dim lngCounter As Long Dim strRight As String Dim strLeft As String Dim strString As String Dim blnFoundExt As Boolean ' Clear the return variables Return_FileExt = "" Return_FileName = "" ' Validate parameters If Trim(strFileName) = "" Then Exit Function If InStr(strFileName, ".") <= 0 Then If InStr(strFileName, "\") <= 0 And InStr(strFileName, "/") <= 0 Then Return_FileName = strFileName Return_FileExt = "" GetFileExt = True Exit Function End If End If ' Loop through the file path and parse out the extention and name For lngCounter = 1 To Len(strFileName) strRight = Right(strFileName, lngCounter) strLeft = Left(strRight, 1) If strLeft = "." And blnFoundExt = False Then blnFoundExt = True Return_FileExt = strString strString = "" ElseIf strLeft = "\" Or strLeft = "/" Then Return_FileName = strString GetFileExt = True Exit Function Else strString = strLeft & strString End If Next Return_FileName = strString GetFileExt = True End Function ' Get the error description from Windows Private Function GetLastErr_Msg(Optional ByVal ErrorNumber As Long, _ Optional ByVal LastAPICalled As String = "last", _ Optional ByRef Return_ErrNum As Long, _ Optional ByRef Return_ErrDesc As String, _ Optional ByVal DisplayError As Boolean = False) As Boolean On Error GoTo ErrorTrap Dim ErrMsg As String ' Clear the return variables Return_ErrNum = 0 Return_ErrDesc = "" ' If no error message is specified then check for one If ErrorNumber = 0 Then ErrorNumber = GetLastError If ErrorNumber = 0 Then GetLastErr_Msg = False Exit Function End If End If ' Allocate a buffer for the error description ErrMsg = String(MAX_PATH + 1, 0) ' Get the error description FormatMessage FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, ErrorNumber, 0, ErrMsg, MAX_PATH + 1, 0 ErrMsg = Left(ErrMsg, InStr(ErrMsg, Chr(0)) - 1) If Right(ErrMsg, 1) = Chr(10) Or Right(ErrMsg, 1) = Chr(13) Then ErrMsg = Left(ErrMsg, Len(ErrMsg) - 1) If Right(ErrMsg, 1) = Chr(10) Or Right(ErrMsg, 1) = Chr(13) Then ErrMsg = Left(ErrMsg, Len(ErrMsg) - 1) ' Display the error message If DisplayError = True Then MsgBox "An error occured while calling the " & LastAPICalled & " Windows API function." & Chr(13) & "Below is the error information:" & Chr(13) & Chr(13) & "Error Number = " & CStr(ErrorNumber) & Chr(13) & "Error Description = " & ErrMsg, vbOKOnly + vbExclamation, " Windows API Error" End If ' Return the information Return_ErrNum = ErrorNumber Return_ErrDesc = ErrMsg GetLastErr_Msg = True ' Set the last error to 0 (no error) so next time through it doesn't report the same error twice SetLastError 0 Exit Function ErrorTrap: Return_ErrNum = Err.Number Return_ErrDesc = Err.Description Err.Clear If Return_ErrNum = 0 Or Return_ErrNum = 20 Then Return_ErrNum = 0: Return_ErrDesc = "" Resume Next Else GetLastErr_Msg = True End If End Function 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX '_____________________________________________________________________________________________________________ ' ' WinHelp ' ¯¯¯¯¯¯¯ ' Starts Microsoft® Windows® Help (Winhelp.exe) and passes additional data that indicates the nature of the ' help requested by the application. ' ' BOOL WinHelp( ' HWND hWndMain, ' LPCTSTR lpszHelp, ' UINT uCommand, ' DWORD dwData ' ); ' ' Parameters: ' ¯¯¯¯¯¯¯¯¯¯¯ ' hWndMain ' Handle to the window requesting help. The WinHelp function uses this handle to keep track of which ' applications have requested help. If the uCommand parameter specifies HELP_CONTEXTMENU or HELP_WM_HELP, ' hWndMain identifies the control requesting help. ' ' lpszHelp ' Address of a null-terminated string containing the path, if necessary, and the name of the Help file ' that WinHelp is to display. ' ' The file name can be followed by an angle bracket (>) and the name of a secondary window if the topic ' is to be displayed in a secondary window rather than in the primary window. You must define the name ' of the secondary window in the [WINDOWS] section of the Help project (.hpj) file. ' ' uCommand ' Type of help requested. For a list of possible values and how they affect the value to place in the ' dwData parameter, see the Remarks section. ' ' dwData ' Additional data. The value used depends on the value of the uCommand parameter. For a list of possible ' dwData values, see the Remarks section. ' ' Return Values: ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ' Returns nonzero if successful, or zero otherwise. To retrieve extended error information, call GetLastError. ' ' Remarks ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ' Before closing the window that requested help, the application must call WinHelp with the uCommand ' parameter set to HELP_QUIT. Until all applications have done this, Windows Help will not terminate. ' Note that calling Windows Help with the HELP_QUIT command is not necessary if you used the HELP_CONTEXTPOPUP ' command to start Windows Help. ' ' The following table shows the possible values for the uCommand parameter and the corresponding formats of ' the dwData parameter. ' ' uCommand: Action: dwData: ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ' HELP_COMMAND Executes a Help macro or macro string. Address of a string that specifies the name ' of the Help macro(s) to run. If the string ' specifies multiple macro names, the names ' must be separated by semicolons. You must ' use the short form of the macro name for ' some macros because Windows Help does not ' support the long name. ' ' HELP_CONTENTS Displays the topic specified by the Contents Ignored; set to 0. ' option in the [OPTIONS] section of the .hpj ' file. This command is for backward compati- ' bility. New applications should provide a ' .CNT file and use the HELP_FINDER command. ' ' HELP_CONTEXT Displays the topic identified by the speci- Contains the contextidentifier for the topic. ' fied context identifier defined in the [MAP] ' section of the .hpj file. ' ' HELP_CONTEXTMENU Displays the Help menu for the selected Address of an array of double word pairs. ' window, then displays the topic for the The first double word in each pair is the ' selected control in a pop-up window. control identifier, and the second is the ' context identifier for the topic. The array ' must be terminated by a pair of zeros {0,0}. ' If you do not want to add Help to a particular ' control, set its context identifier to -1. ' ' HELP_CONTEXTPOPUP Displays the topic identified by the Contains the context identifier for a topic. ' specified context identifier defined in the ' [MAP] section of the .hpj file in a pop-up ' window. ' ' HELP_FINDER Displays the Help Topics dialog box. Ignored; set to 0. ' ' HELP_FORCEFILE Ensures that Windows Help is displaying the Ignored; set to 0. ' correct Help file. If the incorrect Help ' file is being displayed, Windows Help opens ' the correct one; otherwise, there is no ' action. ' ' HELP_HELPONHELP Displays help on how to use Windows Help, if Ignored; set to 0. ' the Winhlp32.hlp file is available. ' ' HELP_INDEX Displays the topic specified by the Contents Ignored; set to 0. ' option in the [OPTIONS] section of the .hpj ' file. This command is for backward compati- ' bility. New applications should use the ' HELP_FINDER command. ' ' HELP_KEY Displays the topic in the keyword table that Address of a keyword string. Multiple ' matches the specified keyword, if there is an keywords must be separated by semicolons. ' exact match. If there is more than one match, ' displays the Index with the topics listed in ' the Topics Found list box. ' ' HELP_MULTIKEY Displays the topic specified by a keyword in Address of a MULTIKEYHELP structure that ' an alternative keyword table. specifies a table footnote character and ' a keyword. ' ' HELP_PARTIALKEY Displays the topic in the keyword table that Address of a keyword string. Multiple ' matches the specified keyword, if there is an keywords must be separated by semicolons. ' exact match. If there is more than one match, ' displays the Topics Found dialog box. To ' display the index without passing a keyword, ' use a pointer to an empty string. ' ' HELP_QUIT Informs Windows Help that it is no longer Ignored; set to 0. ' needed. If no other applications have asked ' for help, Windows closes Windows Help. ' ' HELP_SETCONTENTS Specifies the Contents topic. Windows Help Contains the context identifier for the ' displays this topic when the user clicks the Contents topic. ' Contents button if the Help file does not ' have an associated .cnt file. ' ' HELP_SETPOPUP_POS Sets the position of the subsequent pop-up Contains the position data. Use MAKELONG ' window. to concatenate the horizontal and vertical ' coordinates into a single value. The pop-up ' window is positioned as if the mouse cursor ' were at the specified point when the pop-up ' window was invoked. ' ' HELP_SETWINPOS Displays the Windows Help window, if it is Address of a HELPWININFO structure that ' minimized or in memory, and sets its size specifies the size and position of either ' and position as specified. a primary or secondary Help window. ' ' HELP_TCARD Indicates that a command is for a training Depends on the command with which this ' card instance of Windows Help. Combine this command is combined. ' command with other commands using the ' bitwise OR operator. ' ' HELP_WM_HELP Displays the topic for the control identified Address of an array of double word pairs. ' by the hWndMain parameter in a pop-up window. The first double word in each pair is a ' control identifier, and the second is a ' context identifier for a topic. The array ' must be terminated by a pair of zeros {0,0}. ' If you do not want to add Help to a ' particular control, set its context ' identifier to -1. ' ' See Also: ' ¯¯¯¯¯¯¯¯¯ ' HELPWININFO , MULTIKEYHELP ' ' Requirements: ' ¯¯¯¯¯¯¯¯¯¯¯¯¯ ' Windows NT/2000 : Requires Windows NT 3.1 or later ' Windows 95/98/Me: Requires Windows 95 or later ' Header : Declared in Winuser.h ' Import Library : User32.lib '_____________________________________________________________________________________________________________