AW: Explorer Ordneroption Ansicht per VBA einstellen
07.07.2003 17:10:46
L.Vira
''Achtung! Unbedingt vor der Manipulation der Registry eine
''Sicherungskopie erstellen!
''Der Code ist unter Windows XP gestestet, dennoch kann der Autor
''keinerlei Garantie übernehmen. Die Ausführung des Codes geschieht
''also auf eigenes Risiko!
Option Explicit
Public Const HKEY_CURRENT_USER = &H80000001
Public Const ERROR_SUCCESS = 0&
Declare
Function RegCloseKey Lib "advapi32.dll" (ByVal Hkey As Long) As Long
Declare
Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare
Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare
Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Declare
Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal Hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Public Const REG_DWORD = 4
Function SaveDword(ByVal Hkey As Long, ByVal strPath As String, ByVal strValueName As String, ByVal lData As Long)
Dim lResult As Long
Dim keyhand As Long
Dim r As Long
r = RegCreateKey(Hkey, strPath, keyhand)
lResult = RegSetValueEx(keyhand, strValueName, 0&, REG_DWORD, lData, 4)
r = RegCloseKey(keyhand)
End Function
Function GetDword(ByVal Hkey As Long, ByVal strPath As String, ByVal strValueName As String) As Long
Dim lResult As Long
Dim lValueType As Long
Dim lBuf As Long
Dim lDataBufSize As Long
Dim r As Long
Dim keyhand As Long
r = RegOpenKey(Hkey, strPath, keyhand)
lDataBufSize = 4
lResult = RegQueryValueEx(keyhand, strValueName, 0&, lValueType, lBuf, lDataBufSize)
If lResult = ERROR_SUCCESS Then
If lValueType = REG_DWORD Then
GetDword = lBuf
End If
Else
MsgBox "Registry- Eintrag nicht gefunden! " & Chr(10) & _
"Überprüfen Sie die Schreibweise.", 64, "weise hin..."
End If
r = RegCloseKey(keyhand)
End Function
Sub MSG_GetDWord()
Dim lngDword As String
'DWord lesen
lngDword = GetDword(HKEY_CURRENT_USER, "Software\Microsoft\Windows\currentversion\Explorer\Advanced", "HideFileExt")
If lngDword = 0 Then
MsgBox "Bekannte Dateierweiterungen werden angezeigt. ", 64, "gebe bekannt..."
ElseIf lngDword = 1 Then
MsgBox "Bekannte Dateierweiterungen sind ausgeblendet. ", 64, "gebe bekannt..."
End If
End Sub
Sub MSG_SaveDword()
Dim lngDword As Long
''DWord schreiben
''0 zum Anzeigen 1 zum Ausblenden
lngDword = 0
Call SaveDword(HKEY_CURRENT_USER, "Software\Microsoft\Windows\currentversion\Explorer\Advanced", "HideFileExt", lngDword)
End Sub
