Code zur Anwendungsentwicklung in Classic Visual Basic

Entwicklungsumgebung oder EXE?

Manchmal ist es notwendig, bestimmte Funktionen beim Ausführen in der Entwicklungsumgebung anders ablaufen zu lassen als in der kompilierten Datei. Mit den folgenden Funktionen kann ermittelt werden, ob die Anwendung kompiliert ausgeführt wird. Die einfachste Möglichkeit, zu ermitteln, ob eine Anwendung bzw. Komponente aus der Entwicklungsumgebung heraus gestartet wurde, ist die folgende:

Private Function RunningInIDE() As Boolean
    On Error Resume Next  
    Debug.Print 1 / 0  
    Compiled = (Err <> 0)
End Function

Bei dieser Methode nützen wir die Tatsache aus, daß der Befehl Debug.Print nicht ausgeführt wird, wenn die Anwendung in kompilierter Form, also nicht aus der Entwicklungsumgebung heraus, ausgeführt wird. Es gibt allerdings noch einige andere Ansätze, die Umgebung der Anwendung zu ermitteln, die im nächsten Listing zu sehen sind.

Etwas störend an der vorigen Methode erscheint, daß ihre Funktion allein auf einem nur beim Debuggen verfügbaren Merkmal basiert. Eine „saubere“ Methode ermittelt das Elternfenster eines Fensters in der Anwendung und prüft, ob es sich dabei um die Entwicklungsumgebung handelt. Der Nachteil liegt auf der Hand: Soll der Ausführungszustand in einer fensterlosen Komponente getestet werden, wie z. B. DLLs oder Benutzersteuerelementen, muß zwecks Prüfung die Fensterzugriffsnummer des die Komponente aufrufenden Fensters mit an die Komponente übergeben werden:

Private Declare Function GetWindow Lib "user32.dll" ( _
    ByVal hWnd As Long, _
    ByVal wCmd As Long _
) As Long

Private Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" ( _
    ByVal hWnd As Long, _
    ByVal lpClassName As String, _
    ByVal nMaxCount As Long _
) As Long

Private Const GW_OWNER As Long = 4&

Private Function IsRunningInIDE() As Boolean
    Dim Buffer As String, hWndParent As Long
    Buffer = Space$(128)
    hWndParent = GetWindow(Me.hWnd, GW_OWNER)
    Call GetClassName(hWndParent, Buffer, Len(Buffer))
    IsRunningInIDE = (Left$(Buffer, 11) = "ThunderMain")
End Function

Die nachfolgende Methode funktioniert gleich wie die erste, also auch in fensterlosen Komponenten; es muß kein Handle an eine fensterlose Komponente übergeben werden. Ein „guter Stil“ ist das allerdings nicht:

Private Function RunningInIDE() As Boolean
    On Error GoTo NotCompiled
    Debug.Print 1 / 0
    Exit Function
NotCompiled:
    RunningInIDE = True
End Function

Eine weitere auf den Debug.*-Befehlen basierende Methode könnte folgendermaßen aussehen:

Private Function DebugMode() As Boolean
    Static Counter As Variant
    If IsEmpty(Counter) Then     ' Erster Aufruf.
        Counter = 1
        Debug.Assert DebugMode Or True
        Counter = Counter - 1
    ElseIf Counter = 1 Then      ' Die Funktion wurde rekursiv aufgerufen.
        Counter = 0
    End If
    DebugMode = Counter
End Function

Mit etwas Geschick kann man noch eine einfachere Methode finden, die auf dem Befehl Debug.Assert aufbaut:

Private m_InIDE As Boolean

Public Property Get InIDE() As Boolean
    Debug.Assert IsInIDE
    InIDE = m_InIDE
End Property

Private Property Get IsInIDE() As Boolean
    m_InIDE = True
    IsInIDE = True
End Property

Private Sub Main()
    Call MsgBox("IDE = " & CStr(InIDE))
End Sub

Ermitteln, ob ein Programm bereits ausgeführt wird

Bei einigen Anwendungen ist es notwendig, beim Start festzustellen, ob die Anwendung bereits in einer Instanz ausgeführt wird. Dazu verwendet man folgenden Code (in Sub Form_Load oder Sub Main).

If App.PrevInstance Then
    Call MsgBox("Die Anwendung wird bereits ausgeführt.")
End If

Gestalten einer benutzerfreundlichen Anwendungsoberfläche

Kopieren von Eigenschaften zugewiesenen Bildern

Sicherlich ist Ihnen das auch schon passiert: Sie haben eine PictureBox, in der sich ein Bild befindet, aber leider die dazu passende Bitmapdatei nicht mehr. Visual Basic speichert binäre Daten in sogenannten Stapeldateien mit der Dateinamenserweiterung .frx. Aus denen können die Grafiken nicht mehr mit einfachen Mitteln extrahiert werden.

Suchen Sie die Picture-Eigenschaft im Eigenschaftenfenster. Auf der rechten Seite steht dann die Bezeichnung für das Bildformat (also z. B. (Bitmap) oder (Symbol)). Wenn Sie die Einfügemarke auf diese Bezeichnung setzen und Strg+C drücken, wird das Bild in der Zwischenablage kopiert. Dabei wird auch das jeweilige Format beibehalten, d. h., ein Metafile wird auch als Metafile in die Zwischenablage übertragen. Das funktioniert mit allen Steuerelementen, die eine Picture-Eigenschaft besitzen. Übrigens können auf diese Weise nicht nur Bilder kopiert, sondern auch ausgeschnitten (Strg+X) und eingefügt (Strg+V) werden. Windows 95 bietet für die Zwischenablagefunktionen auch ein Kontextmenü an. Dieses kann auch im Eigenschaftenfenster aktiviert werden, kopiert allerdings nur die Bezeichnung als Text in die Zwischenablage.

Registrieren von ActiveX-Komponenten mittels API-Aufruf

ActiveX-Steuerelemente müssen am Rechner registriert werden, bevor sie in Anwendungen eingesetzt werden können. Meist wird dies in Installationsroutinen über einen Aufruf der RegSvr32.exe mit den entsprechenden Parametern gemacht. Die Steuerelemente exportieren aber auch die Funktionen DllRegisterServer und DllUnregisterServer, über die das einfach erledigt werden kann. Außerdem ist dadurch eine einfachere Handhabung von Registrierungsfehlern möglich. Die folgenden beiden Funktionen geben True zurück, wenn der Vorgang erfolgreich war, andernfalls False:

Private Declare Function RegComCtl32 Lib "comctl32.ocx" _
    Alias "DllRegisterServer" _
( _
) As Long

Private Declare Function UnRegComCtl32 Lib "comctl32.ocx" _
    Alias "DllUnregisterServer" _
( _
) As Long

Private Const ERROR_SUCCESS = 0&

Private Function RegisterCommonControls() As Boolean
    RegisterCommonControls = (RegComCtl32 = ERROR_SUCCESS)
End Function

Private Function UnregisterCommonControls() As Boolean
    UnregisterCommonControls = (UnRegComCtl32 = ERROR_SUCCESS)
End Function

Bei der Verwendung dieser Funktionen ist aber zu bedenken, daß jeder Aufruf bis zu 5 Sekunden in Anspruch nehmen kann. Bei anderen ActiveX-Komponenten ist der entsprechende Dateiname in der Deklaration einzutragen.

Ermitteln der Fehlertexte zu Visual-Basic-Fehlern

Die Beschreibungen den Fehler 1 bis 98 werden mit ihrer Nummer im Direktfenster der Entwicklungsumgebung ausgegeben:

Dim i As Integer
For i = 1 To 98   ' ...
    Debug.Print CStr(i) & ":  " & Error(i)
Next i

Entfernen der Anwendung aus der Prozeßliste

Unter Windows 9x ist es möglich, einen Prozeß nicht in der Liste der Tasks anzeigen zu lassen, indem man ihn als Dienst tarnt:

Private Declare Function GetCurrentProcessId Lib "kernel32.dll" ( _
) As Long

Private Declare Function RegisterServiceProcess Lib "kernel32.dll" ( _
    ByVal dwProcessId As Long, _
    ByVal dwType As Long _
) As Long

Private Const RSP_SIMPLE_SERVICE As Long = 1&

Private Sub RemoveProgramFromList()
    Call RegisterServiceProcess(GetCurrentProcessId, RSP_SIMPLE_SERVICE)
End Sub

Starten einer Anwendung unter beliebigem Datum

Manche Programme prüfen vor dem Start, ob ein bestimmtes Datum überschritten wurde, um dann eine Aktion durchzuführen. Dieser Quellcode startet die Anwendung unter einem Datum vor diesem Tag, wartet ein paar Sekunden und setzt dann das Datum wieder zurück. Es wird nicht berücksichtigt, daß während der Wartezeit eventuell ein Datumswechsel eintreten kann:

Private Sub Main()
    Dim OldDate As Date     ' Sicherung des alten Datums.
    OldDate = Date
    
    ' Aktuelles Datum manipulieren bzw. je nach Anwendung ein beliebiges festes
    ' Datum angeben.
    Date = CDate(Format$(OldDate, "dd.mm.") & "2001")
    
    ' Der Pfad auf das Programm muß hier eingestellt werden.
    Call Shell("C:\Program Files\MyApp\MyApp.exe", vbNormalFocus)
    
    ' Ein wenig warten, bis das Programm gestartet hat.
    Call Sleep(2)
    
    ' Jetzt kann das Datum wieder auf das Originaldatum zurückgesetzt werden.
    Date = OldDate
End Sub

'
' Wartet die angegebene Zahl von Sekunden und setzt danach die Abarbeitung
' fort.
'
Private Sub Sleep(ByVal Seconds As Single)
    Dim StartTime As Single
    StartTime = Timer
    Do While Timer < StartTime + Seconds
        DoEvents
    Loop
End Sub

Erhöhen der Priorität des Anwendungsthreads

Die Prozedur SetThreadToHighPriority aus dem nächsten Codeausschnitt setzt die Priorität des Threads, in dem die Anwendung ausgeführt wird, auf die höchstmögliche Stufe. Die Anwendung ist dann eine „Echtzeitanwendung“, deren Ausführung „zeitkritisch“ ist. Besonders bei aufwendigen Berechnungen kann diese Methode zu bedeutend schnelleren Resultaten führen:

Private Declare Function GetCurrentThread Lib "kernel32.dll" ( _
) As Long

Private Declare Function GetCurrentProcess Lib "kernel32.dll" ( _
) As Long

Private Declare Function SetThreadPriority Lib "kernel32.dll" ( _
    ByVal hThread As Long, _
    ByVal nPriority As Long _
) As Long

Private Declare Function SetPriorityClass Lib "kernel32.dll" ( _
    ByVal hProcess As Long, _
    ByVal dwPriorityClass As Long _
) As Long

Private Const THREAD_BASE_PRIORITY_IDLE As Long = -15&
Private Const THREAD_BASE_PRIORITY_LOWRT As Long = 15&
Private Const THREAD_BASE_PRIORITY_MIN As Long = -2&
Private Const THREAD_BASE_PRIORITY_MAX As Long = 2&

Private Const THREAD_PRIORITY_LOWEST As Long = THREAD_BASE_PRIORITY_MIN
Private Const THREAD_PRIORITY_HIGHEST As Long = THREAD_BASE_PRIORITY_MAX
Private Const THREAD_PRIORITY_ABOVE_NORMAL As Long = THREAD_PRIORITY_HIGHEST - 1&
Private Const THREAD_PRIORITY_BELOW_NORMAL As Long = THREAD_PRIORITY_LOWEST + 1&
Private Const THREAD_PRIORITY_IDLE As Long = THREAD_BASE_PRIORITY_IDLE
Private Const THREAD_PRIORITY_NORMAL As Long = 0&
Private Const THREAD_PRIORITY_TIME_CRITICAL As Long = THREAD_BASE_PRIORITY_LOWRT
Private Const THREAD_PRIORITY_ERROR_RETURN As Long = &H7FFFFFFF

Private Const IDLE_PRIORITY_CLASS As Long = &H40&
Private Const NORMAL_PRIORITY_CLASS As Long = &H20&
Private Const HIGH_PRIORITY_CLASS As Long = &H80&
Private Const REALTIME_PRIORITY_CLASS As Long = &H100&

Private Sub SetThreadToHighPriority()
    Call SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL)
    Call SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS)
End Sub

Ein selbstzerstörendes VBA-Makro

Das folgende VBA-Makro ist eine programmiererische Kuriosität: Es löscht sich selbst, wenn es ausgeführt wird. In VBA von Word, Excel etc. kann man nämlich direkt aus dem Quellcode heraus auf den Quellcode zugreifen und diesen manipulieren. Nach Ausführen des Makros sind nur mehr die Kommentare und dazwischen zwei leere Zeilen zu sehen. Mittels dieser Vorgehensweise lassen sich selbstmodifizierende Makros realisieren:

'*************************************
' Das steht davor.
'*************************************

Public Sub UselessMacro()
    With Application.VBE.ActiveCodePane.CodeModule
        Dim StartLine As Long, Line As Long
        For Line = 1 To .CountOfLines
            If .Lines(Line, 1) = "Public Sub UselessMacro()" Then
                StartLine = Line
            End If
            If StartLine > 0 Then
                If .Lines(Line, 1) = "End Sub" Then
                    Call .DeleteLines(StartLine, Line + 1 - StartLine)
                    Exit For
                End If
            End If
        Next Line
    End With
End Sub

'*************************************
' Das steht danach.
'*************************************