Attribute VB_Name = "basDebugEx"
'-----------------------------------------------------------------------------
'   DebugEx
'       Nothing too fancy, just some debugging functions that let
'       you do asserts and use the VC++ debugging output window
'       when your app is running within the debugger on C++.

'   Copyright © 1999 Trigeminal Software, Inc. All Rights Reserved.
'
'   Use it all you like in your own apps.... but dont put it in print in
'    a book or an article, etc., with your name on it.
'-----------------------------------------------------------------------------
Option Compare Binary
Option Explicit

' constants from winbase.h
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2

' from winbase.h
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function IsDebuggerPresent Lib "kernel32" () As Long
Private Declare Function DebugActiveProcess Lib "kernel32" (ByVal dwProcessId As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Sub DebugBreak Lib "kernel32" ()
Private Declare Sub OutputDebugStringA Lib "kernel32" (ByVal lpOutputString As String)
Private Declare Sub OutputDebugStringW Lib "kernel32" (ByVal lpOutputString As Long)

'-----------------------------------------------------------------------------
'   DebugAssert
'-----------------------------------------------------------------------------
Sub DebugAssert(ByVal fExpression As Variant, Optional stMsg As String = vbNullString)
On Error Resume Next
    If fExpression Then Exit Sub
    Beep
    Select Case DebugMessage("Assertion failed: " & stMsg)
        Case vbRetry
            ' do nothing
        Case vbCancel
            If IsDebuggerPresentC() Then
                ' On NT, in the debugger, so lets break on in!
                Call DebugActiveProcess(GetCurrentProcessId())
                Call DebugBreak
            Else
                Stop
            End If
    End Select
    
End Sub

'-----------------------------------------------------------------------------
'   DebugMessage
'-----------------------------------------------------------------------------
Function DebugMessage(Optional stMessage As String = vbNullString) As VbMsgBoxResult
    ' Put it to the VB debug window (in case we are in the IDE)
    Debug.Print stMessage
        
    ' Put it to the true debugger window (in case we are being
    ' invoked via Visual Studio or somesuch). This is a no-op if
    ' there is no debugger.
    If FUnicodeApis() Then
        Call OutputDebugStringW(StrPtr(stMessage & vbCrLf))
    Else
        Call OutputDebugStringA(stMessage & vbCrLf)
    End If
        
    DebugMessage = MsgBox(stMessage, vbRetryCancel, "TSI Synchronizer ASSERTION FAILURE")
End Function

'----------------------------------------------------------
'   FUnicodeApis
'
'   Returns True if Unicode APIs are supported on this platform
'----------------------------------------------------------
Public Property Get FUnicodeApis() As Boolean
    FUnicodeApis = (GetWinPlatform() And VER_PLATFORM_WIN32_NT) <> 0
End Property

'----------------------------------------------------------
'   GetWinPlatform
'
'   Get the current windows platform.
' ---------------------------------------------------------
Private Function GetWinPlatform() As Long
    Dim osvi As OSVERSIONINFO
    
    osvi.dwOSVersionInfoSize = Len(osvi)
    If GetVersionEx(osvi) <> 0 Then GetWinPlatform = osvi.dwPlatformId
End Function

'-----------------------------------------------------
'   IsDebuggerPresentC
'
'   A wrapper around IsDebuggerPresent to make sure that
'   if we are Win95, where thie function does not exist,
'   we do not throw an error
'-----------------------------------------------------
Public Function IsDebuggerPresentC() As Boolean
On Error Resume Next
    IsDebuggerPresentC = IsDebuggerPresent()
End Function