FreeBasic

Неплохой пример того, как можно записывать и считывать информацию из реестра.
Платформа: Windows
Автор: Vincent DeCampo создано: в 2010 году.

/'
   Basic Windows Registry Read/Write Functions
   Translated from VB6 source by
      -Vincent DeCampo, 2010

   
   Original author UNKOWN    
'/

#INCLUDE "windows.bi"

#INCLUDE "vbcompat.bi"


' Possible registry data types
Enum InTypes
   ValNull = 0

   ValString = 1

   ValXString = 2

   ValBinary = 3

   ValDWord = 4

   ValLink = 6

   ValMultiString = 7

   ValResList = 8

End Enum


' Registry section definitions
'Const HKEY_CLASSES_ROOT = &H80000000
'Const HKEY_CURRENT_USER = &H80000001
'Const HKEY_LOCAL_MACHINE = &H80000002
'Const HKEY_USERS = &H80000003
'Const HKEY_PERFORMANCE_DATA = &H80000004
'Const HKEY_CURRENT_CONFIG = &H80000005

Function ReadRegistry(Byval Group As HKEY, Byval Section As LPCSTR, Byval Key As LPCSTR) As String

Dim As DWORD lDataTypeValue, lValueLength
Dim sValue As String * 2048

Dim As String Tstr1, Tstr2  
Dim lKeyValue As HKEY
Dim lResult As Integer

Dim td As Double


   sValue = ""
   
   lResult      = RegOpenKey(Group, Section, @lKeyValue)
   lValueLength = Len(sValue)
   lResult      = RegQueryValueEx(lKeyValue, Key, 0&, @lDataTypeValue, Cast(Byte Ptr,@sValue), @lValueLength)
   
   If (lResult = 0) Then


      Select Case lDataTypeValue
         Case REG_DWORD 
            td = Asc(Mid(sValue, 1, 1)) + &H100& * Asc(Mid(sValue, 2, 1)) + &H10000 * Asc(Mid(sValue, 3, 1)) + &H1000000 * Cdbl(Asc(Mid(sValue, 4, 1)))
            sValue = Format(td, "000")
         Case REG_BINARY 
            ' Return a binary field as a hex string (2 chars per byte)
            Tstr2 = ""
            For I As Integer = 1 To lValueLength
               Tstr1 = Hex(Asc(Mid(sValue, I, 1)))
               If Len(Tstr1) = 1 Then Tstr1 = "0" & Tstr1
               Tstr2 += Tstr1
            Next

            sValue = Tstr2
         Case Else

            sValue = Left(sValue, lValueLength - 1)
      End Select

   
   End If


   lResult = RegCloseKey(lKeyValue)
   
   Return sValue

End Function


Sub WriteRegistry(Byval Group As HKEY, Byval Section As LPCSTR, Byval Key As LPCSTR, Byval ValType As InTypes, value As String)
Dim lResult As Integer

Dim lKeyValue As HKEY
Dim lNewVal As DWORD
Dim sNewVal As String * 2048


   lResult = RegCreateKey(Group, Section, @lKeyValue)

   If ValType = ValDWord Then

      lNewVal = Cuint(value)
      lResult = RegSetValueEx(lKeyValue, Key, 0&, ValType, Cast(Byte Ptr,@lNewVal), Sizeof(DWORD))
   Else

      If ValType = ValString Then

         sNewVal = value & Chr(0)
         lResult = RegSetValueEx(lKeyValue, Key, 0&, ValString, Cast(Byte Ptr,@sNewVal), Len(sNewVal))
      Endif
   End If


   lResult = RegFlushKey(lKeyValue)
   lResult = RegCloseKey(lKeyValue)

End Sub


Dim regpath As String 
Dim keyname As String 

/'
   Example To Read a key
'/

regpath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion"
keyname = "ProductName"
Print keyname & "=" & ReadRegistry(HKEY_LOCAL_MACHINE,regpath,keyname)

/'
   Example To Write a key
'/
regpath = "SOFTWARE\MySoftwareCompany"
keyname = "MyEntry"

WriteRegistry (HKEY_CURRENT_USER,regpath, keyname, ValDword, "25")

Print "Done! Press Any Key..."
Sleep