Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0737: Ermittelt ob das Programm im WOW64-Emulator läuft

VB 5/6-Tipp 0737: Ermittelt ob das Programm im WOW64-Emulator läuft

 von Oliver Meyer

Schwierigkeitsgrad:

Verwendete API-Aufrufe: GetCurrentProcess, GetModuleHandleA, GetProcAddress, IsWow64Process

Download: Download des Beispielprojektes [3,02 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  ---------
Option Explicit
Private Declare Function IsWow64Process Lib "kernel32" ( _
    ByVal hCurProc As Long, ByRef BolVal As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32.dll" ( _
    ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function GetModuleHandleA Lib "kernel32.dll" ( _
    ByVal lpModuleName As String) As Long
Private Declare Function GetCurrentProcess Lib "kernel32.dll" () As Long

Private Sub Form_Load()
    
    If IsWow64 Then
        Me.Caption = "Prozess läuft im WOW64-Emulator"
    Else
        Me.Caption = "Prozess läuft unter Win32"
    End If
    If APIFunctionExists("kernel32", "IsWow64Process") Then _
       MsgBox "OK IsWow64Process-function exists"

End Sub

Public Function IsWow64() As Boolean

    Dim lngIsWow64 As Long
    
    If APIFunctionExists("kernel32", "IsWow64Process") Then
        If (IsWow64Process(GetCurrentProcess, lngIsWow64) <> 0) Then
            IsWow64 = CBool(lngIsWow64)
        Else
            '// handle error
        End If
    End If

End Function

Public Function APIFunctionExists( _
                     ByVal DllName As String, _
                     ByVal FncName As String _
                                 ) As Boolean
    Dim ModuleHandle As Long
    ModuleHandle = GetModuleHandleA(DllName)
    If ModuleHandle <> 0 Then
        APIFunctionExists = _
            (GetProcAddress(ModuleHandle, FncName) <> 0)
    End If
    
   ' wenn für diese Funktion eine Fehlermeldung gewünscht ist:
   ' If Err.LastDllError <> 0 Then
   '     'siehe:
   '     'ActiveVB: Tipp0020 und
   '     'MSDN: http://msdn.microsoft.com/de-de/library/bb979451.aspx
   '     Dim msg As String
   '     msg = APIErrorDescription(Err.LastDllError) & vbCrLf
   '     Select Case Err.LastDllError
   '     Case 126: msg = msg & "Module: " & DllName
   '     Case 127: msg = msg & "Function: " & FncName
   '     End Select
   '     MsgBox msg, vbCritical
   ' End If
End Function
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------