'
'  pb_reg.bas
'
'  Registry functions for Power Basic 32-bit
'
'  Created by Don Dickinson
'  ddickinson@usinternet.com
'  dickinson.basicguru.com
'  Oct, 1999
'
'  This code is provided for use by anyone who
'  deems it useful. Use of said code is implied
'  agreement that DO NOT hold the author, Don
'  Dickinson, liable for any effects or side-effects
'  of use or mis-use of this code.
'
'  Requires WIN32API.INC - not included here.
'
'  pbRegOpenSection
'  pbRegClose
'  pbRegSetString
'  pbRegGetString
'  pbRegGetSubkeys
'
#if not %def(%PB_REG_BAS)
%PB_REG_BAS = 1

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  pbRegOpenSection
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function pbRegOpenSection (ByVal Key As Long, Section As Asciiz) As Long

   Dim hKey As Long
   Dim Result As Long

   ' Create the section
   If RegCreateKeyEx(Key, Section, 0, "", %REG_OPTION_NON_VOLATILE, _
                     %KEY_ALL_ACCESS, ByVal %NULL, hKey, Result) <> %ERROR_SUCCESS Then
                        
      Function = 0
      Exit Function
   End If

   '- Return the registry key handle
   Function = hKey

End Function

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  pbRegClose
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function pbRegClose (ByVal hKey As Long) As Long

   RegCloseKey hKey

End Function

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  pbRegSetString
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function pbRegSetString (ByVal hKey As Long, Entry As Asciiz, Value As Asciiz) As Long

   '- Save the value for the entry
   If Len(Value) Then
      Function = RegSetValueEx(hKey, Entry, 0, %REG_SZ, Value, Len(Value) + 1)
   Else
      Function = RegSetValueEx(hKey, Entry, 0, %REG_SZ, ByVal %NULL, 0)
   End If

End Function

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  pbRegGetString
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function pbRegGetString (ByVal hKey As Long, zKey As Asciiz) As String

   Dim zBuffer As Asciiz * 1000


   If RegQueryValueEx(hKey, zKey, 0, %REG_SZ, zBuffer, SizeOf(zBuffer) - 1) = %ERROR_SUCCESS Then
      Function = Trim$(zBuffer)
   Else
      Function = ""
   End If

End Function

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  pbRegGetSubkeys
'
'  Fills subKeys() with an array of keys
'  Returns the number of keys in the array or -1 on error
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Function pbGetSubKeys (ByVal hKey as Long, zKey as Asciiz, _
      subKeys() as String) as Long

   Dim openKey as Long
   Dim iCount as Long
   Dim iLen as Long
   Dim Result as Long
   Dim ft as FILETIME
   Dim zBuf as Asciiz * 2000
   
   If RegOpenKeyEx(hKey, zKey, 0, _
                     %KEY_ALL_ACCESS, openKey) <> %ERROR_SUCCESS Then
                        
      Function = -1
      Exit Function
   End If
  
   Do
      iLen = 2000
      if RegEnumKeyEx(openKey, iCount, zBuf, iLen, 0, ByVal 0, ByVal 0, ft) <> %ERROR_SUCCESS then
         exit do         
      end if
      incr iCount
      Redim Preserve subKeys(0 to iCount) as String
      subKeys(iCount) = Trim$(zBuf)
   Loop
   
   pbRegClose hKey
   
   Function = iCount
   
End Function
#endif