Base de registre

[oguruma]

Code : Tout sélectionner

Option Explicit

Declare Function RegOpenKeyExA Lib "advapi32" Alias _
        "RegOpenKeyExA"(Byval HKEY As Long, _
                        Byval lpszSubKey As String, _
                        Byval dwreserved As Integer, _
                        Byval samDesired As Long, _
                        keyresult As Long) As Long

Declare Function RegQueryValueExA Lib "advapi32" Alias _
        "RegQueryValueExA" (Byval HKEY As Long, _
                            Byval lpszValueName As String, _
                            Byval dwreserved As Integer, _
                            lpdwtype As Long, _
                            ByVal lpData As String, _
                            readbytes As Long) As Long

Declare Function RegCloseKey Lib "advapi32" Alias  _
        "RegCloseKey" (Byval HKEY As Long) As Long

Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_CURRENT_USER = &H80000001

Public Class Registry
' Example:
' Dim reg As New Registry()
' Messagebox reg.getShellBinary("pdf")
' Messagebox reg.getShellBinary("wpd")
'

Public Sub New()
 
End Sub

Public Function getValue(key As String, _
                         valueName As String, _
                         rootKey As Long) As String
  ' Returns an empty string if the key is not found or if something goes wrong.
  ' key should be something like
  ' "SOFTWARE\Classes\AcroExch.Document\shell\open\command"
  ' keyName should be something like "" (for "(Default)")
  ' rootKey is HKEY_LOCAL_MACHINE or HKEY_CURRENT_USER
  '
  ' Example:
  ' Dim reg As New Registry()
  ' Dim key_extension As String
  ' key_extension  = "SOFTWARE\Classes\.pdf"
  ' Dim default_value As String
  ' default_value = ""
  ' Dim class_value As String
  ' class_value =  "SOFTWARE\Classes\" & _
  ' reg.getValue(key_extension, default_value, HKEY_LOCAL_MACHINE) & _
  ' "\shell\open\command"
  ' Messagebox reg.getValue(class_value, default_value, HKEY_LOCAL_MACHINE)
  '
  Dim happkey As Long
  Dim KEY_READ As Long
  Dim ValueType As Long
  Dim ReturnedKeyContents As String * 255
  Dim readbytes As Long
  ReturnedKeycontents$=String$(255,Chr$(32))
 
  Dim KEY_QUERY_VALUE As Long
  KEY_QUERY_VALUE=1
  Dim KEY_ENUMERATE_SUBKEYS As Long
  KEY_ENUMERATE_SUBKEYS=8
  Dim KEY_NOTIFY As Long
  KEY_NOTIFY=16
  KEY_READ=KEY_QUERY_VALUE Or KEY_ENUMERATE_SUBKEYS Or _
     KEY_NOTIFY
 
  Dim value_name As String
  Dim lstat As Long
  lstat = RegOpenKeyExA(rootKey, key, 0, KEY_READ, happkey)
  ReadBytes = 255
  lstat=RegQueryValueExA(happkey, valueName, 0, valueType, _
                         ReturnedKeyContents$, ReadBytes)
  regclosekey(happkey)
  Dim user_name As String
  user_name = Left$(ReturnedKeyContents$, ReadBytes-1)
  getValue = user_name
End Function

Public Function getShellCommand(extension As String) As String
  Dim reg As New Registry()
  Dim key_extension As String
  key_extension  = "SOFTWARE\Classes\." & extension
  Dim default_value As String
  default_value = ""
  Dim class_value As String
  class_value =  "SOFTWARE\Classes\" & _
       reg.getValue(key_extension, default_value, HKEY_LOCAL_MACHINE) & _
       "\shell\open\command"
  getShellCommand = reg.getValue(class_value, default_value, _
                                 HKEY_LOCAL_MACHINE)
End Function

Private Function stringLeftBack(src As String, substr As String) As String
  'TODO: Shape up this function.
  If Rightbp$(src, Len(substr)) = substr Then
    stringLeftBack = Leftbp$(src, Len(src) - Len(substr))
  Else
    stringLeftBack = src
  End If
End Function

Public Function getShellBinary(extension As String) As String
  ' Example:
  ' Dim reg As New Registry()
  ' Messagebox reg.getShellBinary("pdf")
  ' Messagebox reg.getShellBinary("wpd")
  '
  Dim shell_cmd As String
  shell_cmd = getShellCommand(extension)
  getShellBinary = stringLeftBack(shell_cmd, |"%1"|)
End Function

End Class

Sub Terminate
 
End Sub