home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / runner1a / cregistr next >
Encoding:
Visual Basic class definition  |  1999-09-14  |  20.2 KB  |  580 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "cRegistry"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Option Explicit
  11. Private Const KEY_QUERY_VALUE = &H1
  12. Private Const KEY_SET_VALUE = &H2
  13. Private Const KEY_CREATE_SUB_KEY = &H4
  14. Private Const KEY_ENUMERATE_SUB_KEYS = &H8
  15. Private Const KEY_NOTIFY = &H10
  16. Private Const KEY_CREATE_LINK = &H20
  17. Private Const KEY_ALL_ACCESS = &H3F
  18. Private Const REG_OPTION_NON_VOLATILE = 0&
  19. Private Const REG_OPTION_VOLATILE = &H1
  20. Private Const REG_CREATED_NEW_KEY = &H1
  21. Private Const REG_OPENED_EXISTING_KEY = &H2
  22. Private Const STANDARD_RIGHTS_ALL = &H1F0000
  23. Private Const SPECIFIC_RIGHTS_ALL = &HFFFF
  24. Private Const ERROR_SUCCESS = 0&
  25. Private Const ERROR_ACCESS_DENIED = 5
  26. Private Const ERROR_INVALID_DATA = 13&
  27. Private Const ERROR_MORE_DATA = 234
  28. Private Const ERROR_NO_MORE_ITEMS = 259
  29. Private Type SECURITY_ATTRIBUTES
  30.   nLength As Long
  31.   lpSecurityDescriptor As Long
  32.   bInheritHandle As Boolean
  33. End Type
  34.  
  35. Private Type FILETIME
  36.   dwLowDateTime As Long
  37.   dwHighDateTime As Long
  38. End Type
  39.  
  40. Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" _
  41.   (ByVal hkey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
  42.   ByVal samDesired As Long, phkResult As Long) As Long
  43.  
  44. Private Declare Function RegSetValueExStr Lib "advapi32" Alias "RegSetValueExA" _
  45.   (ByVal hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
  46.    ByVal dwType As Long, ByVal szData As String, ByVal cbData As Long) As Long
  47. Private Declare Function RegSetValueExLong Lib "advapi32" Alias "RegSetValueExA" _
  48.   (ByVal hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
  49.    ByVal dwType As Long, szData As Long, ByVal cbData As Long) As Long
  50. Private Declare Function RegSetValueExByte Lib "advapi32" Alias "RegSetValueExA" _
  51.   (ByVal hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
  52.    ByVal dwType As Long, szData As Byte, ByVal cbData As Long) As Long
  53.  
  54. Private Declare Function RegCloseKey Lib "advapi32" (ByVal hkey As Long) As Long
  55.  
  56. Private Declare Function RegQueryValueExStr Lib "advapi32" Alias "RegQueryValueExA" _
  57.   (ByVal hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
  58.    ByRef lpType As Long, ByVal szData As String, ByRef lpcbData As Long) As Long
  59. Private Declare Function RegQueryValueExLong Lib "advapi32" Alias "RegQueryValueExA" _
  60.   (ByVal hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
  61.    ByRef lpType As Long, szData As Long, ByRef lpcbData As Long) As Long
  62. Private Declare Function RegQueryValueExByte Lib "advapi32" Alias "RegQueryValueExA" _
  63.   (ByVal hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
  64.    ByRef lpType As Long, szData As Byte, ByRef lpcbData As Long) As Long
  65.    
  66. Private Declare Function RegCreateKeyEx Lib "advapi32" Alias "RegCreateKeyExA" _
  67.   (ByVal hkey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, _
  68.    ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, _
  69.    lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, _
  70.    lpdwDisposition As Long) As Long
  71.  
  72. Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" _
  73.   (ByVal hkey As Long, ByVal dwIndex As Long, ByVal lpName As String, _
  74.    lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, _
  75.    lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
  76.  
  77. Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" ( _
  78.     ByVal hkey As Long, ByVal dwIndex As Long, ByVal lpName As String, _
  79.     ByVal cbName As Long) As Long
  80.  
  81. Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" _
  82.   (ByVal hkey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, _
  83.    lpcbValueName As Long, ByVal lpReserved As Long, ByVal lpType As Long, _
  84.    ByVal lpData As Long, ByVal lpcbData As Long) As Long
  85.    
  86. Private Declare Function RegEnumValueLong Lib "advapi32.dll" Alias "RegEnumValueA" _
  87.   (ByVal hkey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, _
  88.    lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, _
  89.    lpData As Long, lpcbData As Long) As Long
  90. Private Declare Function RegEnumValueStr Lib "advapi32.dll" Alias "RegEnumValueA" _
  91.   (ByVal hkey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, _
  92.    lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, _
  93.    ByVal lpData As String, lpcbData As Long) As Long
  94. Private Declare Function RegEnumValueByte Lib "advapi32.dll" Alias "RegEnumValueA" _
  95.   (ByVal hkey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, _
  96.    lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, _
  97.    lpData As Byte, lpcbData As Long) As Long
  98.  
  99. Private Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" _
  100.    (ByVal hkey As Long, ByVal lpClass As String, _
  101.    lpcbClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, _
  102.    lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, _
  103.    lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, _
  104.    lpftLastWriteTime As Any) As Long
  105.  
  106. Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
  107.   (ByVal hkey As Long, ByVal lpSubKey As String) As Long
  108.  
  109. Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
  110.   (ByVal hkey As Long, ByVal lpValueName As String) As Long
  111.  
  112. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
  113.     lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
  114. Private Declare Function ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize As Long) As Long
  115.  
  116.  
  117. Public Enum ERegistryClassConstants
  118.     HKEY_CLASSES_ROOT = &H80000000
  119.     HKEY_CURRENT_USER = &H80000001
  120.     HKEY_LOCAL_MACHINE = &H80000002
  121.     HKEY_USERS = &H80000003
  122. End Enum
  123.  
  124. Public Enum ERegistryValueTypes
  125.     REG_NONE = (0)
  126.     REG_SZ = (1)
  127.     REG_EXPAND_SZ = (2)
  128.     REG_BINARY = (3)
  129.     REG_DWORD = (4)
  130.     REG_DWORD_LITTLE_ENDIAN = (4)
  131.     REG_DWORD_BIG_ENDIAN = (5)
  132.     REG_LINK = (6)
  133.     REG_MULTI_SZ = (7)
  134.     REG_RESOURCE_LIST = (8)
  135.     REG_FULL_RESOURCE_DESCRIPTOR = (9)
  136.     REG_RESOURCE_REQUIREMENTS_LIST = (10)
  137. End Enum
  138.  
  139. Private m_hClassKey As Long
  140. Private m_sSectionKey As String
  141. Private m_sValueKey As String
  142. Private m_vValue As Variant
  143. Private m_sSetValue As String
  144. Private m_vDefault As Variant
  145. Private m_eValueType As ERegistryValueTypes
  146.  
  147. Public Property Get KeyExists() As Boolean
  148. Dim hkey As Long
  149.     If RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, 1, hkey) = ERROR_SUCCESS Then
  150.         KeyExists = True
  151.         RegCloseKey hkey
  152.     Else
  153.         KeyExists = False
  154.     End If
  155.     
  156. End Property
  157. Public Function CreateKey() As Boolean
  158. Dim tSA As SECURITY_ATTRIBUTES
  159. Dim hkey As Long
  160. Dim lCreate As Long
  161. Dim e As Long
  162.     e = RegCreateKeyEx(m_hClassKey, m_sSectionKey, 0, "", REG_OPTION_NON_VOLATILE, _
  163.                  KEY_ALL_ACCESS, tSA, hkey, lCreate)
  164.     If e Then
  165.         Err.Raise 26001, App.EXEName & ".cRegistry", "Failed to create registry Key: '" & m_sSectionKey
  166.     Else
  167.         CreateKey = (e = ERROR_SUCCESS)
  168.         RegCloseKey hkey
  169.     End If
  170. End Function
  171. Public Function DeleteKey() As Boolean
  172. Dim e As Long
  173.     e = RegDeleteKey(m_hClassKey, m_sSectionKey)
  174.     If e Then
  175.         Err.Raise 26001, App.EXEName & ".cRegistry", "Failed to delete registry Key: '" & m_hClassKey & "',Section: '" & m_sSectionKey
  176.     Else
  177.         DeleteKey = (e = ERROR_SUCCESS)
  178.     End If
  179.     
  180. End Function
  181. Public Function DeleteValue() As Boolean
  182. Dim e As Long
  183. Dim hkey As Long
  184.  
  185.     e = RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, KEY_ALL_ACCESS, hkey)
  186.     If e Then
  187.         Err.Raise 26001, App.EXEName & ".cRegistry", "Failed to open key '" & m_hClassKey & "',Section: '" & m_sSectionKey & "' for delete access"
  188.     Else
  189.         e = RegDeleteValue(hkey, m_sValueKey)
  190.         If e Then
  191.             Err.Raise 26001, App.EXEName & ".cRegistry", "Failed to delete registry Key: '" & m_hClassKey & "',Section: '" & m_sSectionKey & "',Key: '" & m_sValueKey
  192.         Else
  193.             DeleteValue = (e = ERROR_SUCCESS)
  194.         End If
  195.     End If
  196.  
  197. End Function
  198. Public Property Get Value() As Variant
  199. Dim vValue As Variant
  200. Dim cData As Long, sData As String, ordType As Long, e As Long
  201. Dim hkey As Long
  202.  
  203.     e = RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, KEY_QUERY_VALUE, hkey)
  204.  
  205.     e = RegQueryValueExLong(hkey, m_sValueKey, 0&, ordType, 0&, cData)
  206.     If e And e <> ERROR_MORE_DATA Then
  207.         Value = m_vDefault
  208.         Exit Property
  209.     End If
  210.     
  211.     m_eValueType = ordType
  212.     Select Case ordType
  213.     Case REG_DWORD, REG_DWORD_LITTLE_ENDIAN
  214.         Dim iData As Long
  215.         e = RegQueryValueExLong(hkey, m_sValueKey, 0&, _
  216.                                ordType, iData, cData)
  217.         vValue = CLng(iData)
  218.         
  219.     Case REG_DWORD_BIG_ENDIAN
  220.         Dim dwData As Long
  221.         e = RegQueryValueExLong(hkey, m_sValueKey, 0&, _
  222.                                ordType, dwData, cData)
  223.         vValue = SwapEndian(dwData)
  224.         
  225.     Case REG_SZ, REG_MULTI_SZ
  226.         sData = String$(cData - 1, 0)
  227.         e = RegQueryValueExStr(hkey, m_sValueKey, 0&, _
  228.                                ordType, sData, cData)
  229.         vValue = sData
  230.         
  231.     Case REG_EXPAND_SZ
  232.         sData = String$(cData - 1, 0)
  233.         e = RegQueryValueExStr(hkey, m_sValueKey, 0&, _
  234.                                ordType, sData, cData)
  235.         vValue = ExpandEnvStr(sData)
  236.         
  237.     Case Else
  238.         Dim abData() As Byte
  239.         ReDim abData(cData)
  240.         e = RegQueryValueExByte(hkey, m_sValueKey, 0&, _
  241.                                 ordType, abData(0), cData)
  242.         vValue = abData
  243.         
  244.     End Select
  245.     Value = vValue
  246.     
  247. End Property
  248. Public Property Let Value( _
  249.         ByVal vValue As Variant _
  250.     )
  251. Dim ordType As Long
  252. Dim c As Long
  253. Dim hkey As Long
  254. Dim e As Long
  255. Dim lCreate As Long
  256. Dim tSA As SECURITY_ATTRIBUTES
  257.  
  258.     e = RegCreateKeyEx(m_hClassKey, m_sSectionKey, 0, "", REG_OPTION_NON_VOLATILE, _
  259.                  KEY_ALL_ACCESS, tSA, hkey, lCreate)
  260.     
  261.     If e Then
  262.         Err.Raise 26001, App.EXEName & ".cRegistry", "Failed to set registry value Key: '" & m_hClassKey & "',Section: '" & m_sSectionKey & "',Key: '" & m_sValueKey & "' to value: '" & m_vValue & "'"
  263.     Else
  264.  
  265.         Select Case m_eValueType
  266.         Case REG_BINARY
  267.             If (VarType(vValue) = vbArray + vbByte) Then
  268.                 Dim ab() As Byte
  269.                 ab = vValue
  270.                 ordType = REG_BINARY
  271.                 c = UBound(ab) - LBound(ab) - 1
  272.                 e = RegSetValueExByte(hkey, m_sValueKey, 0&, ordType, ab(0), c)
  273.             Else
  274.                 Err.Raise 26001
  275.             End If
  276.         Case REG_DWORD, REG_DWORD_BIG_ENDIAN, REG_DWORD_LITTLE_ENDIAN
  277.             If (VarType(vValue) = vbInteger) Or (VarType(vValue) = vbLong) Then
  278.                 Dim i As Long
  279.                 i = vValue
  280.                 ordType = REG_DWORD
  281.                 e = RegSetValueExLong(hkey, m_sValueKey, 0&, ordType, i, 4)
  282.             End If
  283.         Case REG_SZ, REG_EXPAND_SZ
  284.             Dim s As String, iPos As Long
  285.             s = vValue
  286.             ordType = REG_SZ
  287.             iPos = InStr(s, "%")
  288.             If iPos Then
  289.                 If InStr(iPos + 2, s, "%") Then ordType = REG_EXPAND_SZ
  290.             End If
  291.             c = Len(s) + 1
  292.             e = RegSetValueExStr(hkey, m_sValueKey, 0&, ordType, s, c)
  293.             
  294.         Case Else
  295.             e = ERROR_INVALID_DATA
  296.             
  297.         End Select
  298.         
  299.         If Not e Then
  300.             m_vValue = vValue
  301.         Else
  302.             Err.Raise vbObjectError + 1048 + 26001, App.EXEName & ".cRegistry", "Failed to set registry value Key: '" & m_hClassKey & "',Section: '" & m_sSectionKey & "',Key: '" & m_sValueKey & "' to value: '" & m_vValue & "'"
  303.         End If
  304.         
  305.         RegCloseKey hkey
  306.     
  307.     End If
  308.     
  309. End Property
  310. Public Function EnumerateValues( _
  311.         ByRef sKeyNames() As String, _
  312.         ByRef iKeyCount As Long _
  313.     ) As Boolean
  314. Dim lResult As Long
  315. Dim hkey As Long
  316. Dim sName As String
  317. Dim lNameSize As Long
  318. Dim sData As String
  319. Dim lIndex As Long
  320. Dim cJunk As Long
  321. Dim cNameMax As Long
  322. Dim ft As Currency
  323.  
  324.    iKeyCount = 0
  325.    Erase sKeyNames()
  326.     
  327.    lIndex = 0
  328.    lResult = RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, KEY_QUERY_VALUE, hkey)
  329.    If (lResult = ERROR_SUCCESS) Then
  330.       lResult = RegQueryInfoKey(hkey, "", cJunk, 0, _
  331.                                cJunk, cJunk, cJunk, cJunk, _
  332.                                cNameMax, cJunk, cJunk, ft)
  333.        Do While lResult = ERROR_SUCCESS
  334.    
  335.            lNameSize = cNameMax + 1
  336.            sName = String$(lNameSize, 0)
  337.            If (lNameSize = 0) Then lNameSize = 1
  338.            
  339.            lResult = RegEnumValue(hkey, lIndex, sName, lNameSize, _
  340.                                   0&, 0&, 0&, 0&)
  341.            If (lResult = ERROR_SUCCESS) Then
  342.        
  343.                sName = Left$(sName, lNameSize)
  344.                  
  345.                iKeyCount = iKeyCount + 1
  346.                ReDim Preserve sKeyNames(1 To iKeyCount) As String
  347.                sKeyNames(iKeyCount) = sName
  348.            End If
  349.            lIndex = lIndex + 1
  350.        Loop
  351.    End If
  352.    If (hkey <> 0) Then
  353.       RegCloseKey hkey
  354.    End If
  355.  
  356.    EnumerateValues = True
  357.    Exit Function
  358.    
  359. EnumerateValuesError:
  360.    If (hkey <> 0) Then
  361.       RegCloseKey hkey
  362.    End If
  363.    Err.Raise vbObjectError + 1048 + 26003, App.EXEName & ".cRegistry", Err.Description
  364.    Exit Function
  365.  
  366. End Function
  367. Public Function EnumerateSections( _
  368.         ByRef sSect() As String, _
  369.         ByRef iSectCount As Long _
  370.     ) As Boolean
  371. Dim lResult As Long
  372. Dim hkey As Long
  373. Dim dwReserved As Long
  374. Dim szBuffer As String
  375. Dim lBuffSize As Long
  376. Dim lIndex As Long
  377. Dim lType As Long
  378. Dim sCompKey As String
  379. Dim iPos As Long
  380.  
  381. On Error GoTo EnumerateSectionsError
  382.  
  383.    iSectCount = 0
  384.    Erase sSect
  385. '
  386.    lIndex = 0
  387.  
  388.    lResult = RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, KEY_ENUMERATE_SUB_KEYS, hkey)
  389.    Do While lResult = ERROR_SUCCESS
  390.        szBuffer = String$(255, 0)
  391.        lBuffSize = Len(szBuffer)
  392.       
  393.        lResult = RegEnumKey(hkey, lIndex, szBuffer, lBuffSize)
  394.                              
  395.        If (lResult = ERROR_SUCCESS) Then
  396.            iSectCount = iSectCount + 1
  397.            ReDim Preserve sSect(1 To iSectCount) As String
  398.            iPos = InStr(szBuffer, Chr$(0))
  399.            If (iPos > 0) Then
  400.               sSect(iSectCount) = Left(szBuffer, iPos - 1)
  401.            Else
  402.               sSect(iSectCount) = Left(szBuffer, lBuffSize)
  403.            End If
  404.        End If
  405.        
  406.        lIndex = lIndex + 1
  407.    Loop
  408.    If (hkey <> 0) Then
  409.       RegCloseKey hkey
  410.    End If
  411.    EnumerateSections = True
  412.    Exit Function
  413.  
  414. EnumerateSectionsError:
  415.    If (hkey <> 0) Then
  416.       RegCloseKey hkey
  417.    End If
  418.    Err.Raise vbObjectError + 1048 + 26002, App.EXEName & ".cRegistry", Err.Description
  419.    Exit Function
  420. End Function
  421. Public Sub CreateEXEAssociation( _
  422.         ByVal sExePath As String, _
  423.         ByVal sClassName As String, _
  424.         ByVal sClassDescription As String, _
  425.         ByVal sAssociation As String, _
  426.         Optional ByVal sOpenMenuText As String = "&Open", _
  427.         Optional ByVal bSupportPrint As Boolean = False, _
  428.         Optional ByVal sPrintMenuText As String = "&Print", _
  429.         Optional ByVal bSupportNew As Boolean = False, _
  430.         Optional ByVal sNewMenuText As String = "&New", _
  431.         Optional ByVal bSupportInstall As Boolean = False, _
  432.         Optional ByVal sInstallMenuText As String = "", _
  433.         Optional ByVal lDefaultIconIndex As Long = -1 _
  434.     )
  435.    sExePath = Trim$(sExePath)
  436.    If (Left$(sExePath, 1) <> """") Then
  437.       sExePath = """" & sExePath
  438.    End If
  439.    If (Right$(sExePath, 1) <> """") Then
  440.       sExePath = sExePath & """"
  441.    End If
  442.    
  443.    ClassKey = HKEY_CLASSES_ROOT
  444.    SectionKey = "." & sAssociation
  445.    ValueType = REG_SZ
  446.    ValueKey = ""
  447.    Value = sClassName
  448.    
  449.    SectionKey = sClassName
  450.    Value = sClassDescription
  451.    
  452.    SectionKey = sClassName & "\shell\open"
  453.    If (sOpenMenuText = "") Then sOpenMenuText = "&Open"
  454.    ValueKey = ""
  455.    Value = sOpenMenuText
  456.    SectionKey = sClassName & "\shell\open\command"
  457.    ValueKey = ""
  458.    Value = sExePath & " ""%1"""
  459.    
  460.    If (bSupportPrint) Then
  461.       SectionKey = sClassName & "\shell\print"
  462.       If (sPrintMenuText = "") Then sPrintMenuText = "&Print"
  463.       ValueKey = ""
  464.       Value = sPrintMenuText
  465.       SectionKey = sClassName & "\shell\print\command"
  466.       ValueKey = ""
  467.       Value = sExePath & " /p ""%1"""
  468.    End If
  469.    
  470.    If (bSupportInstall) Then
  471.       If (sInstallMenuText = "") Then
  472.          sInstallMenuText = "&Install " & sAssociation
  473.       End If
  474.       SectionKey = sClassName & "\shell\add"
  475.       ValueKey = ""
  476.       Value = sInstallMenuText
  477.       SectionKey = sClassName & "\shell\add\command"
  478.       ValueKey = ""
  479.       Value = sExePath & " /a ""%1"""
  480.    End If
  481.    
  482.    If (bSupportNew) Then
  483.       SectionKey = sClassName & "\shell\new"
  484.       ValueKey = ""
  485.       If (sNewMenuText = "") Then sNewMenuText = "&New"
  486.       Value = sNewMenuText
  487.       SectionKey = sClassName & "\shell\new\command"
  488.       ValueKey = ""
  489.       Value = sExePath & " /n ""%1"""
  490.    End If
  491.    
  492.    If lDefaultIconIndex > -1 Then
  493.       SectionKey = sClassName & "\DefaultIcon"
  494.       ValueKey = ""
  495.       Value = sExePath & "," & CStr(lDefaultIconIndex)
  496.    End If
  497.     
  498. End Sub
  499. Public Sub CreateAdditionalEXEAssociations( _
  500.       ByVal sClassName As String, _
  501.       ParamArray vItems() As Variant _
  502.    )
  503. Dim iItems As Long
  504. Dim iItem As Long
  505.    
  506.    On Error Resume Next
  507.    iItems = UBound(vItems) + 1
  508.    If (iItems Mod 3) <> 0 Or (Err.Number <> 0) Then
  509.       Err.Raise vbObjectError + 1048 + 26004, App.EXEName & ".cRegistry", "Invalid parameter list passed to CreateAdditionalEXEAssociations - expected Name/Text/Command"
  510.    Else
  511.       SectionKey = sClassName
  512.       If Not (KeyExists) Then
  513.          Err.Raise vbObjectError + 1048 + 26005, App.EXEName & ".cRegistry", "Error - attempt to create additional associations before class defined."
  514.       Else
  515.          For iItem = 0 To iItems - 1 Step 3
  516.             ValueType = REG_SZ
  517.             SectionKey = sClassName & "\shell\" & vItems(iItem)
  518.             ValueKey = ""
  519.             Value = vItems(iItem + 1)
  520.             SectionKey = sClassName & "\shell\" & vItems(iItem) & "\command"
  521.             ValueKey = ""
  522.             Value = vItems(iItem + 2)
  523.          Next iItem
  524.       End If
  525.    End If
  526.    
  527. End Sub
  528. Public Property Get ValueType() As ERegistryValueTypes
  529.     ValueType = m_eValueType
  530. End Property
  531. Public Property Let ValueType(ByVal eValueType As ERegistryValueTypes)
  532.     m_eValueType = eValueType
  533. End Property
  534. Public Property Get ClassKey() As ERegistryClassConstants
  535.     ClassKey = m_hClassKey
  536. End Property
  537. Public Property Let ClassKey( _
  538.         ByVal eKey As ERegistryClassConstants _
  539.     )
  540.     m_hClassKey = eKey
  541. End Property
  542. Public Property Get SectionKey() As String
  543.     SectionKey = m_sSectionKey
  544. End Property
  545. Public Property Let SectionKey( _
  546.         ByVal sSectionKey As String _
  547.     )
  548.     m_sSectionKey = sSectionKey
  549. End Property
  550. Public Property Get ValueKey() As String
  551.     ValueKey = m_sValueKey
  552. End Property
  553. Public Property Let ValueKey( _
  554.         ByVal sValueKey As String _
  555.     )
  556.     m_sValueKey = sValueKey
  557. End Property
  558. Public Property Get Default() As Variant
  559.     Default = m_vDefault
  560. End Property
  561. Public Property Let Default( _
  562.         ByVal vDefault As Variant _
  563.     )
  564.     m_vDefault = vDefault
  565. End Property
  566. Private Function SwapEndian(ByVal dw As Long) As Long
  567.     CopyMemory ByVal VarPtr(SwapEndian) + 3, dw, 1
  568.     CopyMemory ByVal VarPtr(SwapEndian) + 2, ByVal VarPtr(dw) + 1, 1
  569.     CopyMemory ByVal VarPtr(SwapEndian) + 1, ByVal VarPtr(dw) + 2, 1
  570.     CopyMemory SwapEndian, ByVal VarPtr(dw) + 3, 1
  571. End Function
  572. Private Function ExpandEnvStr(sData As String) As String
  573.     Dim c As Long, s As String
  574.     s = ""
  575.     c = ExpandEnvironmentStrings(sData, s, c)
  576.     s = String$(c - 1, 0)
  577.     c = ExpandEnvironmentStrings(sData, s, c)
  578.     ExpandEnvStr = s
  579. End Function
  580.