Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0604: Prüfen, ob ein Objekt initialisiert ist

VB 5/6-Tipp 0604: Prüfen, ob ein Objekt initialisiert ist

 von Konrad Rudolph

Schwierigkeitsgrad:

Verwendete API-Aufrufe: QueryPerformanceCounter, QueryPerformanceFrequency

Download: Download des Beispielprojektes [3,51 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command1"



'Die erste Variante ist klar langsamer: Stringvergleich eben
'(auf meinem PC, kompiliert: "Is Nothing" ist 30 mal schneller als
'"TypeName", wenn das Objekt tatsächlich Nothing ist. Wenn das Objekt
'initialisiert ist, ist die "Is Nothing"-Methode sogar 55 mal schneller!)

'Die anderen beiden Varianten sind da schon wesentlich interessanter:
'aufgrund des Not ist (zumindest kompiliert!) die zweite Variante die
'schnellste. Wenn man jedoch das Gegenteil prüfen will, d.h. *ob* ein
'Objekt initialisiert wird, läßt man das Not weg und die dritte Variante
'ist die schnellste!

Option Explicit

'Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
  nDest As Any, _
  nSrc As Any, _
  ByVal nLen As Long _
)

Dim t As xTimer

Private Sub Command1_Click()
    Dim Results     As String
    'Dim StartTime   As INT64
    'Dim StopTime    As INT64
    'Dim Frequency   As INT64
    Dim Duration    As Double
    
    Dim LoopVar     As Long
    Const LOOPLEN   As Long = &HF00000
    
    Dim objDummy    As Collection
    Dim varDummy    As Long
    
    ' Timer initialisieren
    Set t = New xTimer
    
    '----------------------------------------------------
    ' Objekt ist nicht initialisiert
    Results = "Objekt ist nicht initialisiert" & vbNewLine & vbNewLine
    
    ' Methode 1: TypeName()
    t.Calibrieren
    t.Start
    
    For LoopVar = 1 To LOOPLEN
        If TypeName(objDummy) = "Nothing" Then _
            varDummy = varDummy
    Next LoopVar
    
    t.Halt
    Duration = t.RunTime
    
    Results = Results & _
        "Methode TypeName(): " & vbTab & _
        Format$(Duration, "0.###") & vbCrLf
    
    ' Methode 2: Is Nothing
    t.Calibrieren
    t.Start
    
    For LoopVar = 1 To LOOPLEN
        If objDummy Is Nothing Then _
            varDummy = varDummy
    Next LoopVar
    
    t.Halt
    Duration = t.RunTime
    
    Results = Results & _
        "Methode Is Nothing: " & vbTab & _
        Format$(Duration, "0.###") & vbCrLf
    
    ' Methode 3: CBool(ObjPtr())
    t.Calibrieren
    t.Start
    
    For LoopVar = 1 To LOOPLEN
        If Not CBool(ObjPtr(objDummy)) Then _
            varDummy = varDummy
    Next LoopVar
    
    t.Halt
    Duration = t.RunTime
    
    Results = Results & _
        "Methode CBool(ObjPtr()): " & vbTab & _
        Format$(Duration, "0.###") & vbCrLf
    
    '----------------------------------------------------
    ' Objekt ist initialisiert
    Set objDummy = New Collection
    
    Results = Results & vbCrLf & vbCrLf & _
        "Objekt ist initialisiert" & vbNewLine & vbNewLine
    
    ' Methode 1: TypeName()
    t.Calibrieren
    t.Start
    
    For LoopVar = 1 To LOOPLEN
        If TypeName(objDummy) = "Nothing" Then _
            varDummy = varDummy
    Next LoopVar
    
    t.Halt
    Duration = t.RunTime
    
    Results = Results & _
        "Methode TypeName(): " & vbTab & _
        Format$(Duration, "0.###") & vbCrLf
    
    ' Methode 2: Is Nothing
    t.Calibrieren
    t.Start
    
    For LoopVar = 1 To LOOPLEN
        If objDummy Is Nothing Then _
            varDummy = varDummy
    Next LoopVar
    
    t.Halt
    Duration = t.RunTime
    
    Results = Results & _
        "Methode Is Nothing: " & vbTab & _
        Format$(Duration, "0.###") & vbCrLf
    
    ' Methode 3: CBool(ObjPtr())
    t.Calibrieren
    t.Start
    
    For LoopVar = 1 To LOOPLEN
        If Not CBool(ObjPtr(objDummy)) Then _
            varDummy = varDummy
    Next LoopVar
    
    t.Halt
    Duration = t.RunTime
    
    Results = Results & _
        "Methode CBool(ObjPtr()): " & vbTab & _
        Format$(Duration, "0.###") & vbCrLf
    
    '----------------------------------------------------
    ' Resultate anzeigen
    Call MsgBox(Results, vbInformation, "Timingresultate")
    
    Set t = Nothing
End Sub

'---------- Ende Formular "Form1" alias Form1.frm  ----------
'--------- Anfang Klasse "xTimer" alias Class1.cls  ---------

Option Explicit

'Deklaration: Globale Klassen API-Typen
Private Type LARGE_INTEGER
    Lo As Long
    Hi As Long
End Type

'Deklaration: Globale Klassen API-Funktionen
Private Declare Function QueryPerformanceCounter Lib "kernel32" ( _
    lpPerformanceCount As LARGE_INTEGER) As Long

Private Declare Function QueryPerformanceFrequency Lib "kernel32" ( _
    lpFrequency As LARGE_INTEGER) As Long

'Deklaration: Globale Klassen-Variablen
Dim dblCalibrieren As Double

Dim udtStart As LARGE_INTEGER
Dim udtEnde As LARGE_INTEGER
Dim udtFreq As LARGE_INTEGER

Public Sub Calibrieren()
    Call QueryPerformanceCounter(udtStart)
    Call QueryPerformanceCounter(udtEnde)

    dblCalibrieren = (D(udtEnde) - D(udtStart)) / D(udtFreq) * 1000
End Sub

Private Sub Class_Initialize()
    Call QueryPerformanceFrequency(udtFreq)
End Sub

Public Sub Halt()
    Call QueryPerformanceCounter(udtEnde)
End Sub

Public Sub Start()
    Call QueryPerformanceCounter(udtStart)
End Sub

Public Property Get RunTime() As Double
    RunTime = (D(udtEnde) - D(udtStart)) / D(udtFreq) * 1000 - dblCalibrieren
End Property

Private Function D(udtX As LARGE_INTEGER) As Double
    'Deklaration: Lokale Prozedur-Variablen
    Dim dblHigh As Double
    Dim dblLow As Double

    dblLow = udtX.Lo
    dblHigh = udtX.Hi

    If dblLow < 0 Then
        dblLow = 4294967296# + dblLow + 1
    End If

    If dblHigh < 0 Then
        dblHigh = 4294967296# + dblHigh + 1
    End If

    D = dblLow + dblHigh * 4294967296#
End Function


'---------- Ende Klasse "xTimer" alias Class1.cls  ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 1 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.