Tipp 0121 Seriennummer des IE auslesen
Autor/Einsender:
Datum:
  Christian Arth
18.08.2001
Entwicklungsumgebung:   VB 6
Mit diesem Tipp und unter Zuhilfenahme einiger API-Funktionen ist es möglich die Serien- bzw. Registriernummer des Internet-Explorers aus der Systemregistrierung auszulesen.
 
Option Explicit

Public Enum RegHauptschluessel
  RegClasses = 1
  RegCurrUser = 2
  RegLocalMachine = 3
  RegUsers = 4
  RegCurrConfig = 5
  RegDynData = 6
  RegPerfData = 7
End Enum

Public Enum RegDatentyp
  RegAuto = 0
  RegZeichenfolge = 1
  RegDWORD = 2
  RegBinaer = 3
End Enum

Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Const REG_SZ As Long = 1
Private Const REG_EXPAND_SZ As Long = 2
Private Const REG_BINARY As Long = 3
Private Const REG_DWORD As Long = 4
Private Const REG_DWORD_BIG_ENDIAN As Long = 5
Private Const REG_MULTI_SZ As Long = 7
Private Const KEY_ALL_ACCESS As Long = 63
Private Const REG_OPTION_NON_VOLATILE As Long = 0
Private Const ERROR_SUCCESS As Long = 0
Private Const ERROR_MORE_DATA As Long = 234

Private Declare Function RegApiOpenKey Lib "advapi32.dll" Alias _
      "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As _
      String, ByVal ulOptions As Long, ByVal samDesired As Long, _
      ByRef phkResult As Long) As Long

Private Declare Function RegApiCloseKey Lib "advapi32.dll" Alias _
      "RegCloseKey" (ByVal hKey As Long) As Long

Private Declare Function RegApiQueryValue Lib "advapi32.dll" _
      Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal _
      lpValueName As String, ByVal lpReserved As Long, ByRef _
      lpType As Long, ByRef szData As Any, ByRef lpcbData _
      As Long) As Long

Private Handle As Long
Private Rueckgabe As Long

Private Sub SchluesselOeffnen(ByVal SchlPfad As String)
  Dim hKey As Long

  If Left(SchlPfad, 1) = "\" Then _
        SchlPfad = Right(SchlPfad, Len(SchlPfad) - 1)
  If Right(SchlPfad, 1) = "\" Then _
        SchlPfad = Left(SchlPfad, Len(SchlPfad) - 1)

  hKey = HKEY_LOCAL_MACHINE
  Rueckgabe = _
        RegApiOpenKey(hKey, SchlPfad, 0, KEY_ALL_ACCESS, Handle)

  If Rueckgabe <> ERROR_SUCCESS Then
    SchluesselSchliessen
    MsgBox "Fehler beim Öffnen eines Registry-Schlüssels"
  End If
End Sub

Private Sub SchluesselSchliessen()
  Rueckgabe = RegApiCloseKey(Handle)
End Sub

Public Function RegLesen(ByVal Haupt As RegHauptschluessel, _
      ByVal SchlPfad As String, ByVal Wert As String, _
      Optional ByRef Datentyp As RegDatentyp = RegAuto, _
      Optional ByVal Standard As Variant = Empty) As Variant

  Dim PLaenge As Long
  Dim TmpDTyp As Long
  Dim Puffer As String

  SchluesselOeffnen SchlPfad

  If Datentyp = RegAuto Then
    Rueckgabe = RegApiQueryValue(Handle, Wert, 0, TmpDTyp, 0, 0)
    Select Case TmpDTyp
      Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ
        Datentyp = RegZeichenfolge
      Case REG_DWORD, REG_DWORD_BIG_ENDIAN
        Datentyp = RegDWORD
      Case REG_BINARY
        Datentyp = RegBinaer
    End Select
  End If

  Select Case Datentyp
    Case RegZeichenfolge
      Puffer = String(255, 0)
      PLaenge = 255
      Rueckgabe = RegApiQueryValue(Handle, Wert, 0, REG_SZ, _
            ByVal Puffer, PLaenge)
      If Rueckgabe = ERROR_SUCCESS Then
        RegLesen = CStr(Left(Puffer, PLaenge - 1))
      Else
        RegLesen = Standard
      End If
    Case Else
      MsgBox "Datentyp wird nicht unterstützt"
  End Select

  SchluesselSchliessen
End Function
 
Code im Codebereich der Form
 
Option Explicit

Private Sub Command1_Click(index As Integer)
  Select Case index
    Case 1
      Unload Me
      End
    Case Else
      Label1.Caption = RegLesen(RegLocalMachine, _
        "\Software\Microsoft\Internet Explorer\Registration\", _
        "ProductID")
  End Select
End Sub
 
Weitere Links zum Thema
Standard-Browser ermitteln

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (3,1 kB) Downloads bisher: [ 1460 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Dienstag, 9. August 2011