Quantcast
Channel: VBForums - CodeBank - Visual Basic 6 and earlier
Viewing all articles
Browse latest Browse all 1529

(VB6) Detect Design-time and uncompiled

$
0
0
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

Viewing all articles
Browse latest Browse all 1529

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>