Эти функции взяты из приложения к статье статьи Пола Атрайда "Использование реестра", которая была опубликована в ClarionOnline ( http://www.clariononline.com ) в томе 2 выпуск 6.
Загрузить исходные тексты библиотеки RegLib, включающей эти функции можно отсюда.
Эти функции предназначены для чтения и записи строк в реестр Windows, и работают аналогично GetIni и PutIni.
Они обе принимают такое же количество
параметров, как их эквиваленты для INI файлов.
GetRegistry принимает 4 параметра - две
строки, опциональную строку, и long, и возвращает
строку, содержащую требуемые значения:
Prm:Key - имя ключа Prm:Value - имя искомого значения Prm:Default - значение для возврата по умолчанию, если искомое значение не найдено Prm:BaseKey - базовый ключ
PutRegistry также принимает 4 параметра - строку, две опциональные строки, и long:
Prm:Key - имя ключа
Prm:Value - имя значения
Prm:Data - данные для помещения в значение
Prm:BaseKey - базовый ключ
Если 3-й параметр (данные) опущен или пустая строка, то значение удаляется из ключа.
Если 2-й параметр (значение) опущен или пустая строка, то удаляется весь ключ (с пониманием, что все подключи должны быть сначала удалены, если мы работаем под Windows NT).
Include('registry.equ')
Map
GetRegistry(String,String,<String>,Long),String
PutRegistry(String,<String>,<String>,Long)
RCharPos(String,String),Long
Module('Windows API')
RegOpenKey(Long,Long,Long),Long,Pascal,Raw,Name('RegOpenKeyA')
RegOpenKeyEx(Long,Long,Long,Long,Long),Long,Pascal,Raw,Name('RegOpenKeyExA')
RegCloseKey(Long),Long,Pascal,Raw
RegEnumKey(Long,Long,Long,Long),Long,Pascal,Raw,Name('RegEnumKeyA')
RegEnumValue(Long,Long,Ulong,Ulong,Ulong,Ulong,Ulong,Ulong),Long,Pascal,Raw,Name('RegEnumValueA')
RegCreateKey(Long,Long,Long),Long,Pascal,Raw,Name('RegCreateKeyExA')
RegCreateKeyEx(Long,Long,Long,Long,Long,Long,Long,Long,Long),Long,Pascal,Raw,Name('RegCreateKeyExA')
RegSetValueEx(Long,Long,Long,Long,Long,Long),Long,Raw,Pascal,Name('RegSetValueExA')
RegDeleteValue(Long,Long),Long,Raw,Pascal,Name('RegDeleteValueA')
RegDeleteKey(Long,Long),Long,Raw,Pascal,Name('RegDeleteKeyA')
GetLastError,Long,Raw,Pascal
End
End
Error_SUCCESS
Equate(0)
Error_No_More_Items Equate(259)
NULL
Equate(0)
Code
!
**********************************************************************************************
!
! GetRegistry - a registry-aware version of GetIni.
! Takes 4 parameters:
!
! Prm:Key String The
name of the key the value is in.
! Prm:Value String The name of the
value we are looking for.
! Prm:Default String The default value to return
if the required value is not found.
! Prm:BaseKey Long The base key to
use
!
!
**********************************************************************************************
GetRegistry Function(Prm:Key,Prm:Value,Prm:Default,Prm:BaseKey)
LocalVars Group,Pre(Loc)
ReturnValue
String(255)
! Return value
from this function
KeyName
CString(255)
! Name of key to open
KeyHandle
Long
!
Handle to key
ValueLoop
Long
ValueNameStr
CString(255)
! Name of the value
ValueNameStrSize Ulong
!
Length of the name
ValueDataType Ulong
!
Data type of the value
ValueDataStr
CString(4096)
! Value
ValueDataStrSize ULong
!
Length of the value
End
Code
! If there is no default value then clear the string, otherwise assign
the default
! return value.
If Omitted(3)
Loc:ReturnValue = ''
Else
Loc:ReturnValue = Prm:Default
End
! Open the registry key. If we are unable to open the key then we will
return with
! the return value we just set, otherwise we enumerate all values in
the key.
Loc:KeyName = Clip(Prm:Key)
Case RegOpenKeyEx(Prm:BaseKey,|
Address(Loc:KeyName),|
0,|
Key_Query_Value,|
Address(Loc:KeyHandle))
Of ERROR_SUCCESS
! We were able to open the key successfully.
Enumerate the values in the key.
! The values are returned in an un-sorted
order, so we must loop through all values
! in the key until we find the one we want.
Loc:ValueLoop = 0
Loop
Loc:ValueNameStr = ''
Loc:ValueNameStrSize =
255 ! Max length of value name
Loc:ValueDataStr = ''
Loc:ValueDataStrSize =
4096 ! Max length of data
Case RegEnumValue(
Loc:KeyHandle,|
Loc:ValueLoop,|
Address(Loc:ValueNameStr),|
Address(Loc:ValueNameStrSize),|
NULL,|
NULL,|
Address(Loc:ValueDataStr),|
Address(Loc:ValueDataStrSize))
Of ERROR_SUCCESS
!
We successfully enumerated the key. Compare the name of the value we are
!
looking for to the name that we just enumerated. If they are the same then
!
assign the return value and break the loop, otherwise increment the loop
!
counter and continue.
If
Upper(Clip(Left(Loc:ValueNameStr))) = Upper(Clip(Left(Prm:Value)))
Loc:ReturnValue
= Clip(Loc:ValueDataStr)
Break
Else
Loc:ValueLoop
+= 1
End
Of Error_No_More_Items
!
There are no more values in this key - we have obviously enumerated them
!
all without finding the value we were looking for.
Break
ELSE
!
We received an error whilst enumerating the key.
Message('Unable
to enumerate key ' & Prm:Key & '|Error = ' & GetLastError())
Break
END
End
Else
Message('Unable to open key ' & Prm:Key
& '|Error = ' & GetLastError())
End
Return(Loc:ReturnValue)
!
**********************************************************************************************
!
! PutRegistry - a registry-aware version of PutIni.
! Takes 4 parameters:
!
! Prm:Key String The
name of the key the value is in.
! Prm:Value String The name of the
value we are looking for.
! Prm:Data String The data to
put into the value
! Prm:BaseKey Long The base key to
use
!
! If the 3rd parameter (Prm:Data) is omitted or is an empty string, the value will be
! deleted from the key.
!
! If the 2nd parameter (Prm:Value) is omitted or is an empty string, the entire key will
be
! deleted (with the understanding that all sub-keys must have been deleted first when
running
! under Windows NT).
!
!
**********************************************************************************************
PutRegistry Function(Prm:Key,Prm:Value,Prm:Data,Prm:BaseKey)
LocalVars Group,Pre(Loc)
KeyName
CString(255)
! Name of key to open
KeyHandle
Long
!
Handle to key
Disposition Ulong
!
Was the key created, or did it already exist?
ValueNameStr CString(50)
! Name of the
value
ValueNameStrSize Ulong
!
Length of the name
ValueDataStr
CString(500)
! Value
ValueDataStrSize ULong
!
Length of the value
End
Code
Loc:KeyName = Clip(Prm:Key)
If Omitted(3) Or Clip(Prm:Data) = '' Then
If Omitted(2) Or Clip(Prm:Value) = '' Then
! Delete the key
! Before we can delete
the key, we need to split into 2 parts
! If we want to delete
the key "Software\ClarionOnline\Test", we need to split
! it into
"Software\ClarionOnline" and "Test". The first part is the base key,
! and the second is the
name of the key we want to actually delete
Pos# =
RCharPos('\',Prm:Key)
Loc:KeyName = Prm:Key[
1 : Pos#-1 ]
Case
RegOpenKeyEx(Prm:BaseKey,|
Address(Loc:KeyName),|
0,|
Key_Set_Value,|
Address(Loc:KeyHandle))
Of ERROR_SUCCESS
Loc:KeyName
= Prm:Key[ Pos#+1 : Len(Clip(Prm:Key))]
If
RegDeleteKey(Loc:KeyHandle,Address(Loc:KeyName)) <> ERROR_SUCCESS
!
Message('Unable
to delete key ' & Prm:Key & '|Error = ' & GetLastError())
End
Else
Message('Unable
to open key ' & Prm:Key & '|Error = ' & GetLastError())
End
Else
! Delete a value inside
the key
Loc:KeyName =
Clip(Prm:Key)
Case
RegOpenKeyEx(Prm:BaseKey,|
Address(Loc:KeyName),|
0,|
Key_SET_Value,|
Address(Loc:KeyHandle))
Of ERROR_SUCCESS
Loc:ValueNameStr
= Clip(Prm:Value)
If
RegDeleteValue(Loc:KeyHandle,Address(Loc:ValueNameStr)) <> ERROR_SUCCESS
!
Message('Unable
to delete value ' & Prm:Value & '|Error = ' & GetLastError())
End
Else
Message('Unable
to open key ' & Prm:Key & '|Error = ' & GetLastError())
End
End
Else
! Set the value in the key, creating the key if
needed
Case RegCreateKeyEx( Prm:BaseKey,|
Address(Loc:KeyName),|
0,|
0,|
REG_OPTION_NON_VOLATILE,|
KEY_ALL_ACCESS,|
NULL,|
Address(Loc:KeyHandle),|
Address(Loc:Disposition)
)
Of ERROR_SUCCESS
Loc:ValueNameStr =
Clip(Prm:Value)
Loc:ValueDataStr =
Clip(Prm:Data)
Loc:ValueDataStrSize =
Len(Clip(Loc:ValueDataStr))
If RegSetValueEx(
Loc:KeyHandle,|
Address(Loc:ValueNameStr),|
NULL,|
REG_SZ,|
ADDRESS(Loc:ValueDataStr),|
Loc:ValueDataStrSize)
<> ERROR_SUCCESS
Message('Unable
to set value ' & Prm:Value & '|Error = ' & GetLastError())
END
ELSE
Message('Unable to open
key ' & Prm:Key & '|Error = ' & GetLastError())
END
End
Эти функции используют функцию RCharPos для поиска позиции
позиции последнего вхождения символа '\' в строке.
Константы описаны в файле Registry.equ