VERSION 5.00 Begin VB.Form frmAbout BorderStyle = 3 'Fester Dialog Caption = "Pruef2000" ClientHeight = 3555 ClientLeft = 2340 ClientTop = 1935 ClientWidth = 4410 LinkTopic = "Form2" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 237 ScaleMode = 3 'Pixel ScaleWidth = 294 ShowInTaskbar = 0 'False StartUpPosition = 1 'Fenstermitte Begin VB.CommandButton cmdOK Cancel = -1 'True Caption = "OK" Default = -1 'True Height = 345 Left = 1485 TabIndex = 0 Top = 2640 Width = 1260 End Begin VB.CommandButton cmdSysInfo Caption = "&Systeminfo..." Height = 345 Left = 1500 TabIndex = 1 Top = 3120 Width = 1245 End Begin VB.Line Line1 BorderColor = &H00808080& BorderStyle = 6 'Innen ausgefüllt Index = 1 X1 = 6 X2 = 289 Y1 = 163 Y2 = 163 End Begin VB.Label lblDescription Caption = "Beschreibung" ForeColor = &H00000000& Height = 1170 Left = 210 TabIndex = 2 Top = 1065 Width = 3885 End Begin VB.Label lblTitle Caption = "Name der Anwendung" ForeColor = &H00000000& Height = 480 Left = 210 TabIndex = 3 Top = 180 Width = 3885 End Begin VB.Line Line1 BorderColor = &H00FFFFFF& BorderWidth = 2 Index = 0 X1 = 7 X2 = 288 Y1 = 164 Y2 = 164 End Begin VB.Label lblVersion Caption = "Version" Height = 225 Left = 210 TabIndex = 4 Top = 720 Width = 3885 End End Attribute VB_Name = "frmAbout" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit ' Registrierungsschlüssel-Sicherheitsoptionen... Const READ_CONTROL = &H20000 Const KEY_QUERY_VALUE = &H1 Const KEY_SET_VALUE = &H2 Const KEY_CREATE_SUB_KEY = &H4 Const KEY_ENUMERATE_SUB_KEYS = &H8 Const KEY_NOTIFY = &H10 Const KEY_CREATE_LINK = &H20 Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _ KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _ KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL ' Registrierungsschlüssel-Stammtypen... Const HKEY_LOCAL_MACHINE = &H80000002 Const ERROR_SUCCESS = 0 Const REG_SZ = 1 ' Null-terminierte Unicode-Zeichenfolge Const REG_DWORD = 4 ' 32-Bit-Zahl Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location" Const gREGVALSYSINFOLOC = "MSINFO" Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO" Const gREGVALSYSINFO = "PATH" Private Declare Function RegOpenKeyEx Lib "advapi32" 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 RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long Private Sub cmdSysInfo_Click() Call StartSysInfo End Sub Private Sub cmdOK_Click() Unload Me End Sub Private Sub Form_Load() Me.Icon = frmRes.Icon lblVersion.Caption = "Version " & g_App.AppVersion lblTitle.Caption = g_App.AppName lblDescription.Caption = g_App.AppDescription End Sub Public Sub StartSysInfo() On Error GoTo SysInfoErr Dim rc As Long Dim SysInfoPath As String ' Versuchen, den Systeminfo-Programmpfad/-namen aus der Registrierung abzurufen... If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then ' Versuchen, nur den Systeminfo-Programmpfad aus der Registrierung abzurufen... ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then ' Überprüfen, ob bekannte 32-Dateiversion vorhanden ist If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then SysInfoPath = SysInfoPath & "\MSINFO32.EXE" ' Fehler - Datei wurde nicht gefunden... Else GoTo SysInfoErr End If ' Fehler - Registrierungseintrag wurde nicht gefunden... Else GoTo SysInfoErr End If MsgBox (SysInfoPath) Call Shell(SysInfoPath, vbNormalFocus) Exit Sub SysInfoErr: MsgBox "Systeminformationen sind momentan nicht verfügbar", vbOKOnly End Sub Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean Dim i As Long ' Schleifenzähler Dim rc As Long ' Rückgabe-Code Dim hKey As Long ' Zugriffsnummer für einen offenen Registrierungsschlüssel Dim hDepth As Long ' Dim KeyValType As Long ' Datentyp eines Registrierungsschlüssels Dim tmpVal As String ' Temporärer Speicher eines Registrierungsschlüsselwertes Dim KeyValSize As Long ' Größe der Registrierungsschlüsselvariablen '------------------------------------------------------------ ' Registrierungsschlüssel unter KeyRoot {HKEY_LOCAL_MACHINE...} öffnen '------------------------------------------------------------ rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Registrierungsschlüssel öffnen If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Fehler behandeln... tmpVal = String$(1024, 0) ' Platz für Variable reservieren KeyValSize = 1024 ' Größe der Variable markieren '------------------------------------------------------------ ' Registrierungsschlüsselwert abrufen... '------------------------------------------------------------ rc = RegQueryValueEx(hKey, SubKeyRef, 0, _ KeyValType, tmpVal, KeyValSize) ' Schlüsselwert abrufen/erstellen If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Fehler behandeln If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ' Win95 fügt null-terminierte Zeichenfolge hinzu... tmpVal = Left(tmpVal, KeyValSize - 1) ' Null gefunden, aus Zeichenfolge extrahieren Else ' Keine null-terminierte Zeichenfolge für WinNT... tmpVal = Left(tmpVal, KeyValSize) ' Null nicht gefunden, nur Zeichenfolge extrahieren End If '------------------------------------------------------------ ' Schlüsselwerttyp für Konvertierung bestimmen... '------------------------------------------------------------ Select Case KeyValType ' Datentypen durchsuchen... Case REG_SZ ' Zeichenfolge für Registrierungsschlüsseldatentyp KeyVal = tmpVal ' Zeichenfolgenwert kopieren Case REG_DWORD ' Registrierungsschlüsseldatentyp DWORD For i = Len(tmpVal) To 1 Step -1 ' Jedes Bit konvertieren KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' Wert Zeichen für Zeichen erstellen Next KeyVal = Format$("&h" + KeyVal) ' DWORD in Zeichenfolge konvertieren End Select GetKeyValue = True ' Erfolgreiche Ausführung zurückgeben rc = RegCloseKey(hKey) ' Registrierungsschlüssel schließen Exit Function ' Beenden GetKeyError: ' Bereinigen, nachdem ein Fehler aufgetreten ist... KeyVal = "" ' Rückgabewert auf leere Zeichenfolge setzen GetKeyValue = False ' Fehlgeschlagene Ausführung zurückgeben rc = RegCloseKey(hKey) ' Registrierungsschlüssel schließen End Function