home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / BAS_Module18049510142004.psc / ModuleMania / AlertErr.bas next >
Encoding:
BASIC Source File  |  2004-10-06  |  28.4 KB  |  719 lines

  1. Attribute VB_Name = "AlertErr"
  2. ' _____________________________________________________________________
  3. '  AlertError module - alerting errors when they occur.           -⌐Rd-
  4. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  5. ' This module determines if this process is running within an instance
  6. ' of the VB Development Environment, or within a stand-alone executable.
  7. '
  8. ' The error philosophy is simple:
  9. '          - handle errors conveniently during development.
  10. '          - log errors to a file when running as an executable.
  11. '
  12. ' It is recommended to NOT SUPPRESS ERRORS, but to deal with errors
  13. ' within the procedure where the error occurs, helping debugging and
  14. ' assertion to happen THERE! Don't suppress, Validate! But don't get
  15. ' me wrong - every procedure should have an error handler:
  16. '
  17. '    If InAnExe Then On Error GoTo ErrHandler
  18. '
  19. ' The single advantage over conventional error raising is the automatic
  20. ' disabling of exception raising/unexpected errors when the program is
  21. ' in your end-users space.
  22. '
  23. ' Now having said that, it must also be said that this module is very
  24. ' good for logging on the run, (automatically to the most convenient
  25. ' location), and so allowing for un-interupted testing with run record.
  26. '
  27. ' This module can *best pick* the log path for all running environments
  28. ' including when running as a compiled ActiveX component in/out of IDE.
  29. ' _____________________________________________________________________
  30. '
  31. ' InitError
  32. ' »»»»»»»»»
  33. ' Optionally call InitError within an initialization event.
  34. ' Otherwise, it will be called on the first access to properties
  35. ' or procedures in the module.
  36. '
  37. ' InitError assigns to these public read-only properties:
  38. '
  39. '     hWndVBE - Set to the VB IDE window handle (hWnd), or zero.
  40. '     InVBIde - Set to True if running in the VB IDE, or False
  41. '               if running as an EXE.
  42. '     InAnExe - Set to True if running as an EXE, or False if
  43. '               running in the VB IDE.
  44. '     ExeSpec - Specifies the path and filename of the executable.
  45. '     LogPath - Specifies the default log path used for logging.
  46. ' Environment - Enumeration identifying the running environment.
  47. '
  48. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  49. '
  50. ' AlertError
  51. ' »»»»»»»»»»
  52. ' Input:
  53. '   ProcName  - A String description to identify the module
  54. '               and routine where the error occured.
  55. '   AlertMode - Specifies the error mode when in the IDE.
  56. '   ExtraInfo - This optional argument can be used to alert
  57. '               you to extra info about the error, such as
  58. '               argument and variable values, etc.
  59. ' Output:
  60. '   The AlertError sub-routine outputs one of the following:
  61. '
  62. '   If it is running in the VB IDE
  63. ' MessageBox  - Displays a MsgBox with error description.
  64. ' LogToFile   - Beeps and appends to log file in the log path.
  65. ' DebugPrint  - Beeps and prints desc to debug window (default).
  66. ' BeepOnly    - Beeps only.
  67. ' Custom      - Situational. Specially formatted message boxes?
  68. '               That's why this is a module!
  69. '
  70. '   If in an executable
  71. ' LogToFile   - Beeps and appends to log file in the log path.
  72. '
  73. ' AlertMsg
  74. ' »»»»»»»»
  75. ' The AlertMsg sub can be used to alert you to events of interest
  76. ' without interrupting execution, and is handy for tracking event
  77. ' sequence. AlertMsg uses the same path as the error log when
  78. ' writing to a file, but also takes an optional path parameter.
  79. ' ______________________________________________________________
  80. '
  81. ' Example code
  82. ' »»»»»»»»»»»»
  83. ' Call InitError:
  84. ' ___________
  85. '  InitError
  86. ' »»»»»»»»»»»
  87. ' You can use ...
  88. ' __________________________________________
  89. '  If InAnExe Then On Error GoTo ErrHandler
  90. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  91. ' This allows you to proof your code as you develop, adding
  92. ' assertions and error handling as needed. Add assertions
  93. ' before the above conditional. Then add error handlers to
  94. ' deal with possible 'expected' errors, maybe using Resume.
  95. '
  96. ' The following code creates a special case as needed.
  97. ' A CommonDialog is a good example.
  98. ' __________________________________________
  99. '  On Error GoTo ErrHandler
  100. '  ' code that could cause 'expected' error
  101. '  If InAnExe Then On Error GoTo ErrHandler
  102. '  ' more code that could raise errors
  103. ' ErrHandler:
  104. '  If Err.Number = 'expected' Then
  105. '      ' error is handled
  106. '      Resume ' or Resume Next
  107. '  ElseIf Err Then
  108. '      AlertError sProc
  109. '  End If
  110. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  111. ' This allows you to identify and handle possible scenarios
  112. ' ('expected' errors), but raises 'unexpected' errors right
  113. ' where they occur. If an 'unexpected' error occurs when the
  114. ' project is compiled the error will be logged.
  115. '
  116. ' In some cases you need to remove 'If InAnExe Then' and revert
  117. ' to a less immediate solution. A Callback comes to mind:
  118. ' __________________________________________
  119. '  On Error GoTo ErrHandler
  120. '  ' call-back code
  121. ' ErrHandler:
  122. '  sProc = Me.Name & ".CallbackFunc"
  123. '  If Err Then
  124. '      AlertError sProc, DebugPrint, "lParam = " & lParam
  125. '  End If
  126. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  127. ' Details
  128. ' »»»»»»»
  129. ' The hWndVBE property is set to the VB IDE window handle, which
  130. ' is handy when more than one instance of the IDE is running.
  131. '
  132. ' When running in a compiled executable the ExeSpec property
  133. ' specifies the path and file name of the parent executable, but
  134. ' when in the IDE it contains the path and name of the VB exe.
  135. '
  136. ' By default, the log file is written to the path obtained from
  137. ' ExeSpec only when in an exe, and the App.Path property is used
  138. ' in the IDE. This default path used for logging is available as
  139. ' the read-only LogPath property.
  140. '
  141. ' If you are using this module in a compiled ActiveX component
  142. ' running in another client project *as a compiled executable*
  143. ' the ExeSpec property will identify the app path of the client,
  144. ' and the App.Path property will specify the location of your
  145. ' component. In this case the ExeSpec path is used by default.
  146. ' This proves much more useful when debugging the client exe.
  147. '
  148. ' If you are using this module in an ActiveX component running
  149. ' in another client project *in the IDE* the ExeSpec property
  150. ' will specify the path of the VB exe, and the App.Path property
  151. ' will specify the location of your component (not the App.Path
  152. ' property of the client project). In this case your components
  153. ' App.Path property is used by default.
  154. '
  155. ' You can over-ride the default log path by passing an optional
  156. ' path parameter to InitError to be used as the log path. If
  157. ' you do specify the log path it will be used in all running
  158. ' environments, not just in the IDE (can be reset, see below).
  159. '
  160. ' Remember, according to this philosophy, your component could
  161. ' still use 'If InAnExe Then On Error GoTo ErrHandler' which will
  162. ' raise errors to the client during their development process for
  163. ' invalid arguments and other assertions (data types, ranges, etc).
  164. ' Using assertions and raising errors in the IDE = clean code!
  165. '
  166. ' The log file is named App.EXEName & "_Error.log" for error
  167. ' logging, and App.EXEName & "_Msg.log" for AlertMsg. You can
  168. ' optionally specify the name (without extension) to be used in
  169. ' place of App.EXEName when calling InitError.
  170. '
  171. ' Note - if it's a component then AlertError and AlertMsg will
  172. ' always log to file - printing to Debug window is not available
  173. ' and a message box would be inappropriate.
  174. '
  175. ' Note - InitError can be re-called to specify another log path
  176. ' (without re-testing the running environment), and omitting the
  177. ' sLogPath parameter will reset the log path according the logic
  178. ' as described above. Clear as mud?
  179. ' __________________________________________________________
  180.  
  181. Public Enum eAlertMode
  182.     DebugPrint
  183.     LogToFile
  184.     MessageBox
  185.     BeepOnly
  186.     Custom
  187. End Enum
  188.  
  189. Public Enum eEnvironment
  190.     EnvironIDE = 1         ' Project in the IDE
  191.     EnvironCompiled = 2    ' Compiled executable
  192.     EnvironCompiledIDE = 3 ' Compiled component in IDE
  193. End Enum
  194.  
  195. Private Declare Function EnumThreadWindows Lib "user32" (ByVal dwThreadId As Long, ByVal lpEnumFunc As Long, ByRef lParam As Long) As Long
  196. Private Declare Function GetWindowClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nBufLen As Long) As Long
  197. Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
  198. Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
  199. Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
  200. Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
  201. Private Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long ' ⌐Rd
  202. Private Declare Function GetModuleHandleZ Lib "kernel32" Alias "GetModuleHandleA" (ByVal hNull As Long) As Long
  203. Private Declare Function GetLongPathName Lib "kernel32" Alias "GetLongPathNameA" (ByVal lpszShortPath As String, ByVal lpszLongPath As String, ByVal cchBuffer As Long) As Long
  204.  
  205. ' Now includes the full GetClientSpec module code and supports vb5/6
  206.  
  207. Private Const GWL_HINSTANCE = (-6)
  208. Private Const MAX_PATH As Long = 260
  209.  
  210. Private maVBIDEs() As Long
  211.  
  212. Private mhWndVBE As Long
  213. Private mInVBIDE As Boolean
  214. Private mInAnExe As Boolean
  215. Private mExeSpec As String
  216.  
  217. Private mLogPath As String
  218. Private mExePath As String
  219. Private mEXEName As String
  220. Private mfInit As Boolean
  221.  
  222. Private mEnviron As eEnvironment
  223.  
  224. Option Explicit
  225.  
  226. ' ___________________________________________________________
  227. ' PUBLIC SUB: InitError - First property access calls here
  228. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  229. ' Assigns globals: VBIDE hWnd or zero, run mode props set.
  230. '
  231. ' You can over-ride the default log path by passing the optional
  232. ' path parameter to be used as the log path. If you do specify the
  233. ' log path it will be used in all running environments, not just
  234. ' in the IDE, but can be reset on the run at any time.
  235. '
  236. ' The log file is named App.EXEName & "_Error.log" for error
  237. ' logging, and App.EXEName & "_Msg.log" for AlertMsg. You can
  238. ' optionally specify the name (without extension) to be used in
  239. ' place of App.EXEName.
  240. '
  241. ' InitError can be re-called to specify another log path without
  242. ' re-testing the running environment, and omitting the log path
  243. ' parameter will reset the log path to best pick for environment.
  244. '
  245. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  246. Public Sub InitError(Optional sLogPath As String, Optional sNameNoExt As String)
  247. Attribute InitError.VB_Description = "Initialization sub; sets public read-only properties hWndVBE, InVBIde, InAnExe, ExeSpec and LogPath."
  248.    On Error GoTo Fail
  249.    If (mfInit = False) Then
  250.       mfInit = True 'Set Props first time
  251.       mhWndVBE = GetVBIdeHandle 'VBE instance
  252.       mExeSpec = GetLongPath(GetClientSpec) 'Full spec and exe
  253.       mExePath = RTrimChr(mExeSpec) 'Full path to exe
  254.       mInVBIDE = RunningInIDE 'End Set Props
  255.  
  256.       If mInVBIDE Then
  257.          mEnviron = EnvironIDE 'In IDE
  258.  
  259.       ElseIf (mhWndVBE = 0) Then
  260.          mEnviron = EnvironCompiled
  261.          mInAnExe = True 'In An Exe
  262.  
  263.       Else
  264.          'Debug.Assert (App.StartMode = vbSModeAutomation)
  265.          mEnviron = EnvironCompiledIDE
  266.          mInVBIDE = True 'In Component in IDE
  267.       End If
  268.    End If
  269.  
  270.    If LenB(sNameNoExt) = 0 Then
  271.       mEXEName = App.EXEName
  272.    Else
  273.       mEXEName = sNameNoExt
  274.    End If
  275.  
  276.    If LenB(sLogPath) <> 0 Then
  277.       If LenB(Dir$(sLogPath, vbDirectory)) <> 0 Then
  278.          ' Remove trailing backslash if present
  279.          If (Right$(sLogPath, 1) = "\") Then
  280.             mLogPath = RTrimChr(GetLongPath(sLogPath))
  281.          Else
  282.             mLogPath = GetLongPath(sLogPath)
  283.          End If
  284.       Else
  285.          Beep 'err.raise invalid path!
  286.          GoTo 33
  287.       End If
  288.    Else
  289. 33    If (mInAnExe) Then
  290.          mLogPath = mExePath
  291.       Else
  292.          mLogPath = GetLongPath(App.Path)
  293.       End If
  294.    End If
  295. Fail:
  296. End Sub
  297.  
  298. ' ___________________________________________________________
  299. ' PUBLIC SUB: AlertError - Logs automatically when in an Exe
  300. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  301. ' The ProcName argument can be used to name the module and
  302. ' procedure where the error occured.
  303. '
  304. ' When in the IDE this sub handles errors according to the
  305. ' AlertMode argument, which defaults to DebugPrint if omitted.
  306. ' If in an executable it automatically defaults to logging.
  307. '
  308. ' The optional ExtraInfo argument can be used to alert you
  309. ' to pertinent information about the error, such as argument
  310. ' and variable values, and other state data.
  311. '
  312. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  313. Public Sub AlertError(ProcName As String, Optional ByVal AlertMode As eAlertMode = DebugPrint, Optional ExtraInfo As String)
  314. Attribute AlertError.VB_Description = "When in the IDE handles errors according to the optional AlertMode argument, which defaults to DebugPrint if omitted. If in an executable it automatically defaults to logging."
  315.     Dim Num As Long, Src As String, Desc As String
  316.  
  317.     Num = Err.Number
  318.     Src = Err.Source
  319.     If (Erl <> 0) Then
  320.         Desc = "Error on line " & Erl & vbCrLf & Err.Description
  321.     Else
  322.         Desc = Err.Description
  323.     End If
  324.  
  325.     If LenB(ExtraInfo) <> 0 Then Desc = Desc & vbCrLf & ExtraInfo
  326.  
  327.     On Error GoTo Fail
  328.     If mfInit Then Else InitError
  329.  
  330.     If (mInAnExe) Then
  331.         AlertMode = LogToFile
  332.     ElseIf (App.StartMode = vbSModeAutomation) Then
  333.         ' If a compiled ActiveX component in another
  334.         ' vb project then must log to file
  335.         AlertMode = LogToFile
  336.     End If
  337.  
  338.     Select Case AlertMode
  339.             Case MessageBox
  340.                 MsgBox ProcName & " error!" & vbCr & vbCr & _
  341.                        "Error #" & Num & " - " & Desc, _
  342.                        vbExclamation, "Error #" & Num
  343.  
  344.             Case DebugPrint
  345.                 Debug.Print " ------- "; Format(Now, "h:nn:ss"); " -------"
  346.                 Debug.Print ProcName; " error!"
  347.                 Debug.Print "Error #"; Num; " - "; Desc
  348.                 Debug.Print "                       * * * * * ERROR * * * * *"
  349.                                          Beep
  350.             Case LogToFile
  351.                 Dim i As Integer: i = FreeFile()
  352.                 Open mLogPath & "\" & mEXEName & "_Error.log" For Append Shared As #i
  353.                     Print #i, Src; " error log ";
  354.                     Print #i, Format(Now, "h:nn:ss am/pm mmmm d, yyyy")
  355.                     Print #i, ProcName; " error!"
  356.                     Print #i, "Error #"; Num; " - "; Desc
  357.                     Print #i, " * * * * * * * * * * * * * * * * * * *"
  358.                 Close #i
  359.                                             Beep
  360.             Case BeepOnly
  361.                 ' Beep me only
  362.                                               Beep
  363.             Case Else
  364.                 ' Do nothing. Specially formatted messages?
  365.     End Select
  366. Fail:
  367. End Sub
  368.  
  369. ' ___________________________________________________________
  370. ' PUBLIC SUB: AlertMsg - Logs automatically when in an Exe
  371. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  372. ' This sub can be used to alert you to pertinent information
  373. ' about the the running app without interrupting execution.
  374. '
  375. ' When in the IDE this sub handles messages according to the
  376. ' AlertMode argument, which defaults to DebugPrint if omitted.
  377. ' If in an executable it automatically writes to a log file.
  378. '
  379. ' The log file path can be over-ridden by the optional path
  380. ' parameter.
  381. '
  382. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  383. Public Sub AlertMsg(Msg As String, Optional ByVal AlertMode As eAlertMode = DebugPrint, Optional sLogPath As String, Optional SuppressBeep As Boolean)
  384. Attribute AlertMsg.VB_Description = "When in the IDE handles messages according to the optional AlertMode argument, which defaults to DebugPrint if omitted. If in an executable it automatically defaults to logging."
  385.     On Error GoTo Fail
  386.     If mfInit Then Else InitError
  387.     If (mInAnExe) Then
  388.         AlertMode = LogToFile
  389.     ElseIf (App.StartMode = vbSModeAutomation) Then
  390.         ' If a compiled ActiveX component in another
  391.         ' vb project then must log to file
  392.         AlertMode = LogToFile
  393.     End If
  394.     Dim sFile As String
  395.     If LenB(sLogPath) <> 0 Then
  396.       If LenB(Dir$(sLogPath, vbDirectory)) <> 0 Then
  397.          ' Add trailing backslash if missing
  398.          If (Right$(sLogPath, 1) <> "\") Then
  399.             sFile = sLogPath & "\" & mEXEName
  400.          Else
  401.             sFile = sLogPath & mEXEName
  402.          End If
  403.       Else
  404.          Beep 'err.raise invalid path!
  405.          GoTo 333
  406.       End If
  407.     Else
  408. 333     sFile = mLogPath & "\" & mEXEName
  409.     End If
  410.     Select Case AlertMode
  411.             Case MessageBox
  412.                 MsgBox Msg, vbInformation, " Message..."
  413.  
  414.             Case DebugPrint
  415.                 Debug.Print " ------- "; Format(Now, "h:nn:ss"); " -------"
  416.                 Debug.Print Msg
  417.                 Debug.Print "                       * * * * * MSG * * * * *"
  418.                              If SuppressBeep Then Else Beep
  419.             Case LogToFile
  420.                 Dim i As Integer: i = FreeFile()
  421.                 Open sFile & "_Msg.log" For Append Shared As #i
  422.                     Print #i, Format(Now, "h:nn:ss am/pm mmmm d, yyyy")
  423.                     Print #i, Msg
  424.                     Print #i, " * * * * * * * * * * * * * * * * * * *"
  425.                 Close #i
  426.                              If SuppressBeep Then Else Beep
  427.             Case BeepOnly
  428.                              If SuppressBeep Then Else Beep
  429.             Case Else
  430.                 ' Do nothing. Specially formatted messages?
  431.     End Select
  432. Fail:
  433. End Sub
  434.  
  435. ' ___________________________________________________________
  436. ' PUBLIC PROPERTY: Environment
  437. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  438. ' Property to easily identify the running environment.
  439. '
  440. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  441. Public Property Get Environment() As eEnvironment
  442.     If mfInit Then Else InitError
  443.     Environment = mEnviron
  444. End Property
  445.  
  446. ' ___________________________________________________________
  447. ' PUBLIC PROPERTY: hWndVBE
  448. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  449. ' Set to the VB IDE window handle (hWnd), or zero.
  450. '
  451. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  452. Property Get hWndVBE() As Long
  453. Attribute hWndVBE.VB_Description = "Set to the VB IDE window handle (hWnd), or zero if running as an executable."
  454.    If mfInit Then Else InitError
  455.    hWndVBE = mhWndVBE
  456. End Property
  457.  
  458. ' ___________________________________________________________
  459. ' PUBLIC PROPERTY: InVBIde
  460. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  461. ' Set to True if running in the VB IDE, or False
  462. ' if running as an EXE.
  463. '
  464. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  465. Property Get InVBIde() As Boolean
  466. Attribute InVBIde.VB_Description = "Set to True if running in the VB IDE, or False if running as an EXE."
  467.     If mfInit Then Else InitError
  468.     InVBIde = mInVBIDE
  469. End Property
  470.  
  471. ' ___________________________________________________________
  472. ' PUBLIC PROPERTY: InAnExe
  473. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  474. ' Set to True if running as an EXE, or False if
  475. ' running in the VB IDE.
  476. '
  477. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  478. Property Get InAnExe() As Boolean
  479. Attribute InAnExe.VB_Description = "Set to True if running as an EXE, or False if running in the VB IDE."
  480.     If mfInit Then Else InitError
  481.     InAnExe = mInAnExe
  482. End Property
  483.  
  484. ' ___________________________________________________________
  485. ' PUBLIC PROPERTY: ExeSpec
  486. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  487. ' Specifies the path and filename of the executable.
  488. '
  489. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  490. Property Get ExeSpec() As String
  491. Attribute ExeSpec.VB_Description = "Specifies the path and filename of the executable."
  492.     If mfInit Then Else InitError
  493.     ExeSpec = mExeSpec
  494. End Property
  495.  
  496. ' ___________________________________________________________
  497. ' PUBLIC PROPERTY: LogPath
  498. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  499. ' Specifies the default log path used for logging.
  500. '
  501. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  502. Property Get LogPath() As String
  503. Attribute LogPath.VB_Description = "Specifies the default log path used for logging."
  504.     If mfInit Then Else InitError
  505.     LogPath = mLogPath
  506. End Property
  507.  
  508. ' ___________________________________________________________
  509. ' PRIVATE FUNCTION: RunningInIDE                        -⌐Rd-
  510. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  511. ' This function determines if this process is running within
  512. ' an instance of the VB Development Environment, or within a
  513. ' stand-alone executable.
  514. '
  515. ' If running as a stand-alone executable the RunningInIDE
  516. ' function simply returns False, otherwise it calls the
  517. ' DebugOnly support function to set the IDE flag to True.
  518. '
  519. ' Components should use public InVBIde (and InAnExe) instead.
  520. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  521. Private Function RunningInIDE() As Boolean
  522.     Debug.Assert True Xor DebugOnly(RunningInIDE)
  523. End Function
  524.  
  525. Private Function DebugOnly(fInIDE As Boolean) As Boolean
  526.     fInIDE = True
  527. End Function
  528.  
  529. ' ___________________________________________________________
  530. ' PRIVATE FUNCTION: GetVBIdeHandle                      -⌐Rd-
  531. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  532. ' If running within an instance of the VB IDE GetVBIdeHandle
  533. ' returns the window handle (hWnd) of the Main VB window.
  534. '
  535. ' If running as a stand-alone executable the GetVBIdeHandle
  536. ' function returns zero.
  537. '
  538. ' Returns: VB's window handle (hWnd), zero otherwise.
  539. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  540. Private Function GetVBIdeHandle() As Long
  541.     On Error GoTo ErrHandler
  542.     Dim rc As Long, nVBIDEs As Long
  543.  
  544.     ' Search all current thread windows for the VB IDE main window
  545.     rc = EnumThreadWindows(GetCurrentThreadId, AddressOf CallBackIDE, nVBIDEs)
  546.  
  547.     ' If the IDE is running
  548.     If (nVBIDEs) Then
  549.         Dim VBProcessID As Long, MeProcessID As Long, Idx As Long
  550.  
  551.         ' Get this components's Process ID
  552.         MeProcessID = GetCurrentProcessId
  553.  
  554.         For Idx = 1 To nVBIDEs
  555.             ' Get VB's Process ID
  556.             rc = GetWindowThreadProcessId(maVBIDEs(Idx), VBProcessID)
  557.  
  558.             ' If running in the same process
  559.             If (VBProcessID = MeProcessID) Then
  560.                 GetVBIdeHandle = maVBIDEs(Idx) ' ⌐Rd
  561.                 Exit Function
  562.             End If
  563.         Next Idx
  564.     End If
  565. ErrHandler:
  566. End Function
  567.  
  568. ' ___________________________________________________________
  569. ' PRIVATE FUNCTION: CallBackIDE                         -⌐Rd-
  570. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  571. ' This is a support function for the GetVBIdeHandle function.
  572. '
  573. ' This is a Call-Back function called by the EnumThreadWindows
  574. ' API function (used in GetVBIdeHandle above).
  575. '
  576. ' It receives the handle of each window, and if the handle is
  577. ' the Main VB IDE window it is added to the maVBIDEs array.
  578. '
  579. ' Assigns ByRef: The lCount parameter indicating the number
  580. '          of VB IDE's currently running, zero otherwise.
  581. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  582. Private Function CallBackIDE(ByVal hWnd As Long, ByRef lCount As Long) As Long
  583.     On Error GoTo ErrHandler
  584.     ' Default to Enum the next window
  585.     CallBackIDE = 1
  586.     ' If it's a VB IDE instance
  587.     If (GetClassName(hWnd) = "IDEOwner") Then
  588.         lCount = lCount + 1
  589.         ReDim Preserve maVBIDEs(1 To lCount) As Long
  590.         ' Record the window handle
  591.         maVBIDEs(lCount) = hWnd
  592.     End If
  593.     Exit Function
  594. ErrHandler:
  595.     ' On error cancel callback
  596.     CallBackIDE = 0
  597. End Function
  598.  
  599. ' ___________________________________________________________
  600. ' PRIVATE FUNCTION: GetClassName                        -⌐Rd-
  601. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  602. ' This is a support function for the CallBackIDE function.
  603. '
  604. ' This function returns the class name of the window whose
  605. ' handle is passed as the hWnd argument.
  606. '
  607. ' Returns: The window's class name.
  608. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  609. Private Function GetClassName(ByVal hWnd As Long) As String
  610.     On Error GoTo ErrHandler
  611.     GetClassName = "unknown"
  612.     Dim ClassName As String, BufLength As Long
  613.     ' Allow ample length for the class name
  614.     BufLength = MAX_PATH
  615.     ClassName = String$(BufLength, vbNullChar)
  616.  
  617.     If (GetWindowClassName(hWnd, ClassName, BufLength)) Then
  618.         GetClassName = TrimNull(ClassName)
  619.     End If
  620. ErrHandler:
  621. End Function
  622.  
  623. ' ___________________________________________________________
  624. ' PUBLIC FUNCTION: GetClientSpec                        -⌐Rd-
  625. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  626. ' This is a support function for the InitError sub-routine.
  627. '
  628. ' This function returns the path and name of the file used
  629. ' to create the calling process.
  630. '
  631. ' Returns: A fully-qualified path and name.
  632. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  633. Public Function GetClientSpec() As String
  634.     On Error GoTo ErrHandler
  635.     Dim sModName As String, hInst As Long, rc As Long
  636.     ' Get the application hInstance. By passing NULL, GetModuleHandle
  637.     ' returns a handle to the file used to create the calling process.
  638.     hInst = GetWindowLong(GetModuleHandleZ(0&), GWL_HINSTANCE)
  639.     ' Get the module file name
  640.     sModName = String$(MAX_PATH, vbNullChar)
  641.     rc = GetModuleFileName(hInst, sModName, MAX_PATH)
  642.     GetClientSpec = TrimNull(sModName)
  643. ErrHandler:
  644.     ' Return empty string on error
  645. End Function
  646.  
  647. ' ___________________________________________________________
  648. ' PUBLIC FUNCTION: RTrimChr
  649. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  650. ' This function removes from sFileSpec the first occurrence
  651. ' of the specified character from the right and everything
  652. ' following it, and returns just the path up to but not
  653. ' including the specified character.
  654. '
  655. ' If sChar is omitted it defaults to a backslash.
  656. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  657. Public Function RTrimChr(sFileSpec As String, Optional sChar As String = "\") As String
  658.     On Error GoTo ErrHandler
  659.     Dim iStartPos As Long, iCharPos As Long
  660.  
  661.     ' Default to return sFileSpec
  662.     RTrimChr = sFileSpec
  663.     
  664.     iStartPos = InStr(sFileSpec, sChar)
  665.     If iStartPos = 0 Then Exit Function
  666.     
  667.     iCharPos = Len(sFileSpec) + 1
  668.     Do
  669.        iCharPos = iCharPos - 1
  670.     Loop Until Mid$(sFileSpec, iCharPos, 1) = sChar
  671.  
  672.     ' Extract the path without char and following substring
  673.     RTrimChr = Left$(sFileSpec, iCharPos - 1)
  674. ErrHandler:
  675. End Function
  676.  
  677. ' ___________________________________________________________
  678. ' PUBLIC FUNCTION: TrimNull
  679. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  680. ' This function extracts the string from the null terminated
  681. ' string passed to it.
  682. '
  683. ' Returns: The string of characters up to the first null
  684. '          (ASCII 0) character.
  685. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  686. Public Function TrimNull(sNullTerm As String) As String
  687.     Dim Idx As Integer
  688.     If LenB(sNullTerm) <> 0 Then
  689.         Idx = InStr(sNullTerm, vbNullChar)
  690.         If (Idx <> 0) Then
  691.             TrimNull = Left$(sNullTerm, Idx - 1)
  692.         Else
  693.             TrimNull = Trim$(sNullTerm)
  694.         End If
  695.     End If
  696. End Function
  697.  
  698. ' ___________________________________________________________
  699. ' PUBLIC FUNCTION: GetLongPath
  700. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  701. ' This is a support function for the GetClientSpec function.
  702. '
  703. ' This function returns the long path and name of the file
  704. ' passed to it. Used as a beautifier/clunky 8.3 fix thingy.
  705. '
  706. ' Returns: The full (32 bit) path and name.
  707. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»
  708. Public Function GetLongPath(sShortPath As String) As String
  709.     If (LenB(sShortPath) <> 0) Then
  710.         GetLongPath = Trim$(sShortPath)
  711.         Dim sPath As String, lResult As Long
  712.         sPath = String$(MAX_PATH, vbNullChar)
  713.         lResult = GetLongPathName(GetLongPath, sPath, MAX_PATH)
  714.         If (lResult) Then GetLongPath = TrimNull(sPath)
  715.     End If
  716. End Function
  717. '
  718. ' »»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»    :¢)
  719.