PC Professionell 1999 October/PCpro_1999_10.ISO/Tools/autoww/AUTOSTRT.FRM

Visual Basic Form | 1997-09-30 | 12.4 KB | 372 lines

VERSION 5.00
Begin VB.Form Form1
   BorderStyle     =   3  'Fester Dialog
   Caption         =   "AutoRun Manager"
   ClientHeight    =   3615
   ClientLeft      =   2175
   ClientTop       =   3360
   ClientWidth     =   4935
   Icon            =   "autostrt.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'ZReihenfolge
   ScaleHeight     =   3615
   ScaleWidth      =   4935
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'Bildschirmmitte
   Begin VB.CommandButton Command1
      Caption         =   "&Abbrechen"
      Height          =   375
      Index           =   3
      Left            =   2520
      TabIndex        =   14
      Top             =   3180
      Width           =   1215
   End
   Begin VB.Frame Frame1
      Caption         =   "Sofortiger Start"
      Height          =   1332
      Index           =   2
      Left            =   60
      TabIndex        =   11
      Top             =   1740
      Width           =   2352
      Begin VB.CheckBox Check1
         Caption         =   "&Programm-CD"
         Height          =   372
         Index           =   7
         Left            =   900
         TabIndex        =   13
         Top             =   840
         Width           =   1332
      End
      Begin VB.CheckBox Check1
         Caption         =   "&Musik-CD"
         Height          =   372
         Index           =   0
         Left            =   900
         TabIndex        =   12
         Top             =   420
         Width           =   1092
      End
      Begin VB.Image Image1
         Height          =   480
         Index           =   7
         Left            =   240
         Picture         =   "autostrt.frx":0442
         Top             =   240
         Width           =   480
      End
      Begin VB.Image Image1
         Height          =   480
         Index           =   6
         Left            =   240
         Picture         =   "autostrt.frx":2BE4
         Top             =   720
         Width           =   480
      End
   End
   Begin VB.Frame Frame1
      Caption         =   "Signal f
r Medienwechsel"
      Height          =   1572
      Index           =   1
      Left            =   60
      TabIndex        =   9
      Top             =   60
      Width           =   2352
      Begin VB.CheckBox Check1
         Caption         =   "&aktiv"
         Height          =   372
         Index           =   1
         Left            =   900
         TabIndex        =   10
         Top             =   1080
         Width           =   1032
      End
      Begin VB.Label Label1
         BorderStyle     =   1  'Fest Einfach
         Caption         =   "(Kein Ger
t gefunden)"
         Height          =   615
         Left            =   180
         TabIndex        =   15
         Top             =   360
         Width           =   1995
      End
      Begin VB.Image Image1
         Height          =   480
         Index           =   5
         Left            =   240
         Picture         =   "autostrt.frx":3026
         Top             =   1020
         Width           =   480
      End
   End
   Begin VB.CommandButton Command1
      Caption         =   "&OK"
      Height          =   372
      Index           =   2
      Left            =   3780
      TabIndex        =   5
      Top             =   3180
      Width           =   1092
   End
   Begin VB.CommandButton Command1
      Caption         =   "&Standard"
      Height          =   372
      Index           =   1
      Left            =   1260
      TabIndex        =   6
      Top             =   3180
      Width           =   1152
   End
   Begin VB.CommandButton Command1
      Caption         =   "&Info"
      Height          =   372
      Index           =   0
      Left            =   60
      TabIndex        =   7
      Top             =   3180
      Width           =   1152
   End
   Begin VB.Frame Frame1
      Caption         =   "AutoRun erlauben"
      Height          =   3012
      Index           =   0
      Left            =   2520
      TabIndex        =   8
      Top             =   60
      Width           =   2352
      Begin VB.CheckBox Check1
         Caption         =   "&Ram-Disk"
         Height          =   372
         Index           =   6
         Left            =   900
         TabIndex        =   3
         Top             =   1980
         Width           =   1152
      End
      Begin VB.CheckBox Check1
         Caption         =   "&CD-ROM"
         Height          =   372
         Index           =   5
         Left            =   900
         TabIndex        =   0
         Top             =   360
         Width           =   1392
      End
      Begin VB.CheckBox Check1
         Caption         =   "&Netzwerk"
         Height          =   372
         Index           =   4
         Left            =   900
         TabIndex        =   4
         Top             =   2520
         Width           =   1392
      End
      Begin VB.CheckBox Check1
         Caption         =   "&Festplatte"
         Height          =   372
         Index           =   3
         Left            =   900
         TabIndex        =   2
         Top             =   1440
         Width           =   1152
      End
      Begin VB.CheckBox Check1
         Caption         =   "&Diskette"
         Height          =   372
         Index           =   2
         Left            =   900
         TabIndex        =   1
         Top             =   900
         Width           =   1332
      End
      Begin VB.Image Image1
         Height          =   480
         Index           =   2
         Left            =   240
         Picture         =   "autostrt.frx":57C8
         Top             =   1320
         Width           =   480
      End
      Begin VB.Image Image1
         Height          =   480
         Index           =   4
         Left            =   240
         Picture         =   "autostrt.frx":7F6A
         Top             =   2460
         Width           =   480
      End
      Begin VB.Image Image1
         Height          =   480
         Index           =   3
         Left            =   240
         Picture         =   "autostrt.frx":A70C
         Top             =   1860
         Width           =   480
      End
      Begin VB.Image Image1
         Height          =   480
         Index           =   1
         Left            =   240
         Picture         =   "autostrt.frx":AB4E
         Top             =   780
         Width           =   480
      End
      Begin VB.Image Image1
         Height          =   480
         Index           =   0
         Left            =   240
         Picture         =   "autostrt.frx":D2F0
         Top             =   240
         Width           =   480
      End
   End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const title = "AutoRun Manager"
Const ERROR_NO_MORE_ITEMS = 259&
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_DYN_DATA = &H80000006
Const KEY_QUERY_VALUE = &H1
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const REG_NONE = 0
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const AutoInsertNotificationName = "AutoInsertNotification"
Const ConfKey = "Config Manager\Enum"
Const AutoRunKey = "software\microsoft\windows\currentversion\policies\explorer"
Const AutoRunKeyName = "NoDriveTypeAutoRun"
Const AudioRunKey = "SOFTWARE\Classes\AudioCD\shell"
Const AudioRunActiveValue = "play"
Dim crlf As String
Dim NoDriveTypeAutoRunValue As String * 4
Dim AudioRunValue As String
Dim AutoInsertNotificationValue As String * 1
Dim HardWareKey As String
Private Sub Check1_Click(Index As Integer)
    Select Case Index
        Case 5
            Check1(7).Value = Check1(5).Value
        Case 7
            Check1(5).Value = Check1(7).Value
    End Select
End Sub
Private Sub Command1_Click(Index As Integer)
    Select Case Index
        Case 3 'abbr
            End
        Case 2 'ok
            SaveValues
            End
        Case 1 'standard
            SetDefaultValues
        Case 0 'info
            ww_info title, "Ein Tool zum Bearbeiten der AutoRun-Funktionen von Win95."
    End Select
End Sub
Private Sub Form_Load()
crlf = Chr$(13) + Chr$(10)
ReadValuesFromRegistry
End Sub
Public Sub SetDefaultValues()
Dim i As Integer
For i = 2 To 6
    Select Case i
        Case 2, 4
            Check1(i).Value = 0
        Case Else
            Check1(i).Value = 1
    End Select
Check1(0).Value = 1
End Sub
Public Sub SaveValues()
Dim b As Byte
Dim rc As Long
Dim hKey As Long
Dim i As Integer
    'NoDriveTypeAutoRun
    b = Asc(NoDriveTypeAutoRunValue)
    For i = 2 To 6
        b = b And Not (2 ^ i) Or (2 ^ i) * -(Check1(i).Value = 0) 'bei gel
. eig. muss bit=1 sein und umgek.
    Next
    Mid$(NoDriveTypeAutoRunValue, 1, 1) = Chr$(b)
    rc = RegOpenKeyEx(HKEY_CURRENT_USER, AutoRunKey, 0, KEY_QUERY_VALUE, hKey)
    rc = RegSetValueEx(hKey, AutoRunKeyName, 0, REG_BINARY, ByVal NoDriveTypeAutoRunValue, Len(NoDriveTypeAutoRunValue))
    rc = RegCloseKey(hKey)
    '"AudioRunKey"
    If Check1(0).Value Then
        AudioRunValue = AudioRunActiveValue
    Else
        AudioRunValue = ""
    End If
    rc = RegOpenKeyEx(HKEY_LOCAL_MACHINE, AudioRunKey, 0, KEY_QUERY_VALUE, hKey)
    rc = RegSetValueEx(hKey, "", 0, REG_SZ, ByVal AudioRunValue, Len(AudioRunValue))
    rc = RegCloseKey(hKey)
    'hw notify
    AutoInsertNotificationValue = Chr$(Check1(1).Value)
    rc = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Enum\" + HardWareKey, 0, KEY_QUERY_VALUE, hKey)
    rc = RegSetValueEx(hKey, AutoInsertNotificationName, 0, REG_BINARY, ByVal AutoInsertNotificationValue, Len(AutoInsertNotificationValue))
    rc = RegCloseKey(hKey)
End Sub
Public Sub ReadValuesFromRegistry()
Dim i As Integer
Dim rc As Long
Dim hKey As Long
Dim rc1 As Long
Dim DeviceDesc As String
Dim CMEnumKey As String
Dim KeyNum As Long
Dim hKey1 As Long
    '"NoDriveTypeAutoRun" einlesen
    rc = RegOpenKeyEx(HKEY_CURRENT_USER, AutoRunKey, 0, KEY_QUERY_VALUE, hKey)
    rc = RegQueryValueEx(hKey, AutoRunKeyName, 0, REG_BINARY, ByVal NoDriveTypeAutoRunValue, Len(NoDriveTypeAutoRunValue))
    rc = RegCloseKey(hKey)
    For i = 2 To 6   'NoDriveTypeAutoRun bits auf die checkboxen verteilen
        Check1(i).Value = -((Asc(NoDriveTypeAutoRunValue) And (2 ^ i)) = 0)
    Next
    '"AudioRunKey" einlesen
    AudioRunValue = Space$(256)
    rc = RegOpenKeyEx(HKEY_LOCAL_MACHINE, AudioRunKey, 0, KEY_QUERY_VALUE, hKey)
    rc = RegQueryValueEx(hKey, "", 0, REG_SZ, ByVal AudioRunValue, Len(AudioRunValue))
    rc = RegCloseKey(hKey)
    Check1(0).Value = -(LCase(ztrim(AudioRunValue)) = AudioRunActiveValue)
    'AutoInsertNotification
    rc = RegOpenKeyEx(HKEY_DYN_DATA, ConfKey, 0, KEY_ENUMERATE_SUB_KEYS, hKey)
    Do
        CMEnumKey = Space$(256)
        If RegEnumKey(hKey, KeyNum, CMEnumKey, Len(CMEnumKey)) Then Exit Do
        CMEnumKey = ztrim(CMEnumKey)
        'hw pfad einlesen
        HardWareKey = Space$(256)
        rc = RegOpenKeyEx(HKEY_DYN_DATA, ConfKey + "\" + CMEnumKey, 0, KEY_QUERY_VALUE, hKey1)
        rc = RegQueryValueEx(hKey1, "HardWareKey", 0, REG_SZ, ByVal HardWareKey, Len(HardWareKey))
        rc = RegCloseKey(hKey1)
        'im hw pfad nach notify eintrag suchen
        rc = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Enum\" + HardWareKey, 0, KEY_QUERY_VALUE, hKey1)
        rc = RegQueryValueEx(hKey1, AutoInsertNotificationName, 0, REG_BINARY, ByVal AutoInsertNotificationValue, Len(AutoInsertNotificationValue))
        If rc = 0 Then
            DeviceDesc = Space$(256)
            rc = RegQueryValueEx(hKey1, "DeviceDesc", 0, REG_SZ, ByVal DeviceDesc, Len(DeviceDesc))
            Label1.Caption = ztrim(DeviceDesc)
            rc = RegCloseKey(hKey1)
            Check1(1).Value = Sgn(Asc(AutoInsertNotificationValue))
            Exit Do
        End If
        rc = RegCloseKey(hKey1)
        KeyNum = KeyNum + 1
    Loop
    rc = RegCloseKey(hKey)
End Sub