Results 1 to 1 of 1

Thread: (VB6) Detect Design-time and uncompiled

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Feb 2017
    Posts
    4,995

    (VB6) Detect Design-time and uncompiled

    Code can run at design time if you have UserControls or also you can type a procedure name in the immediate window and run that code.

    This function takes advantage of an error that is raised only at run-time and uses code from this Codebank entry (thanks to the author).

    It detects when the code is running at design time and uncompiled. It is intended to address issues that happen when the code runs in source code at design time, not at design time but compiled (in an OCX or DLL).

    In the demonstration project that is attached it uses an UserControl for easy testing, but the code works without an UserControl and does not rely on the Ambient.UserMode property.

    Code:
    Option Explicit
    
    Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
    Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function GetProp Lib "user32.dll" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
    
    Private mIsUncompiledAndDesignTime As Boolean
    Private mIsUncompiledAndDesignTime_Set As Boolean
    
    Public Function IsUncompiledAndDesignTime() As Boolean
        If Not mIsUncompiledAndDesignTime_Set Then
            Dim iInIDE As Boolean
            
            Debug.Assert MakeTrue(iInIDE)
            If iInIDE Then
                SetIsUncompiledAndDesignTime
            End If
            mIsUncompiledAndDesignTime_Set = True
        End If
        IsUncompiledAndDesignTime = mIsUncompiledAndDesignTime
    End Function
    
    Private Sub SetIsUncompiledAndDesignTime()
        Dim hwndMain As Long
        Dim hProp As Long
        Dim iObjIDE As Object
        Dim iObjVBE As Object
        
        hwndMain = FindWindow("wndclass_desked_gsk", vbNullString)
        If hwndMain <> 0 Then
            hProp = GetProp(hwndMain, "VBAutomation")
            If hProp <> 0 Then
                CopyMemory iObjIDE, hProp, 4&    '= VBIDE.Window
                On Error Resume Next
                Set iObjVBE = iObjIDE.VBE
                mIsUncompiledAndDesignTime = True
                If Err.Number = 70 Then ' run time raises an access denied error
                    mIsUncompiledAndDesignTime = False
                End If
                On Error GoTo 0
                CopyMemory iObjIDE, 0&, 4&
            End If
        End If
    End Sub
        
    Private Function MakeTrue(value As Boolean) As Boolean
        MakeTrue = True
        value = True
    End Function
    Attached Files Attached Files

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width