Public Const HKEY_CLASSES_ROOT As Long = &H80000000
Private Const REG_SZ As Long = &H1
Private Const KEY_READ As Long = ((&H20000 Or &H1 Or &H8 Or &H10) And (Not &H100000))
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, 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 szData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal szData As String, ByVal cbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Public Function RegGetValue(Root As Long, SubKey As String, Key As String) As String
Dim Buffer As String, hKey As Long, nType As Long, nSize As Long
If hKey And nSize > 0 And nType = REG_SZ Then
Buffer = Space(nSize + 1)
Call RegQueryValueEx(hKey, Key, 0, nType, Buffer, nSize)
RegGetValue = Left(Buffer, nSize - 1)
End If
Call RegCloseKey(hKey)
End Function
Public Function RegSetValue(ByVal hKey As Long, _
ByVal strSubKey As String, _
ByVal strKey As String, _
ByVal strValue As String) As Long
Call RegCreateKey(hKey, strSubKey, RegSetValue)
Call RegSetValueEx(RegSetValue, strKey, 0&, 1&, ByVal strValue & vbNullChar, Len(strValue) + 1&
Call RegCloseKey(RegSetValue)
End Function
Public Function RegDelKey(ByVal hKey As Long, ByVal strKey As String)
Call RegDeleteKey(hKey, strKey)
End Function
Public Function RegDelValue(ByVal hKey As Long, ByVal strPath As String, ByVal strValue As String)
Dim keyhand As Long
Call RegOpenKey(hKey, strPath, keyhand)
Call RegDeleteValue(keyhand, strValue)
Call RegCloseKey(keyhand)
End Function
' §§§§§§§§§§§§§§§§§§§§§§§§§§ Запись данных в файл §§§§§§§§§§§§§§§§§§§§§§§§§§
' §§§§§§§§§§§§§§§§§§§§§§§§§§ Асоциирование с файлом §§§§§§§§§§§§§§§§§§§§§§§§§§
'Ассоциация файлов с программой
Public Sub Associate(ByVal sType As String, ByVal sKey As String, ByVal sDescr As String, _
ByVal iIcon As Integer, ByVal sPrompt As String)
Call RegSetValue(HKEY_CLASSES_ROOT, sKey, vbNullString, sDescr)
If Len(sPrompt) Then Call RegSetValue(HKEY_CLASSES_ROOT, sKey & "\shell\open\command", vbNullString, sPrompt & " %1"
Call RegSetValue(HKEY_CLASSES_ROOT, sKey & "\DefaultIcon", vbNullString, App.Path & "\" & LCase(App.EXEName) & ".exe," & CStr(iIcon))
Call RegSetValue(HKEY_CLASSES_ROOT, sType, vbNullString, sKey)
End Sub
Public Function DeAssociate(sType As String) As String
 eAssociate = RegGetValue(HKEY_CLASSES_ROOT, sType, vbNullString)
Public Function IsAssociate(sType As String, sKey As String) As Boolean
IsAssociate = (RegGetValue(HKEY_CLASSES_ROOT, sType, "" = sKey)
End Function