MSVS 2005 Запсь в системный реестр

Private Sub Command1_Click() 'Запись в реестр
Set Reg = CreateObject("WScript.Shell")
Reg.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\Имя Вашей программы", "Путь к Вашей программы"
End Sub

Private Sub Command2_Click() 'Удаление из реестра
Set Reg = CreateObject("WScript.Shell")
Reg.RegDelete "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\Имя Вашей программы"
End Sub

Private Sub Form_Load()
Command1.Caption = "Записать"
Command2.Caption = "Стереть"
End Sub

Создание ключа в реестре, чтение и удаление его.


Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_BINARY = 3 ' Free form binary
Const HKEY_CURRENT_USER = &H80000001

Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) 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 RegDeleteValue Lib "advapi32.dll" _
Alias "RegDeleteValueA" _
(ByVal hKey As Long, _
ByVal lpValueName As String) 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 RegQueryValueEx Lib "advapi32.dll" _
Alias "RegQueryValueExA" _
(ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal lpReserved As Long, _
lpType As Long, _
lpData As Any, _
lpcbData As Long) As Long

Private Declare Function RegSetValueEx Lib "advapi32.dll" _
Alias "RegSetValueExA" _
(ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal Reserved As Long, _
ByVal dwType As Long, _
lpData As Any, _
ByVal cbData As Long) As Long

Function RegQueryStringValue(ByVal hKey As Long, _
ByVal strValueName As String) As String
Dim lResult As Long
Dim lValueType As Long
Dim strBuf As String
Dim lDataBufSize As Long
'retrieve nformation about the key
lResult = RegQueryValueEx(hKey, _
strValueName, 0, lValueType, _
ByVal 0, lDataBufSize)
If lResult = 0 Then
If lValueType = REG_SZ Then
'Create a buffer
strBuf = String(lDataBufSize, Chr$(0))
'retrieve the key's content
lResult = RegQueryValueEx(hKey, strValueName, _
0, 0, ByVal strBuf, lDataBufSize)
If lResult = 0 Then
'Remove the unnecessary chr$(0)'s
RegQueryStringValue = Left$(strBuf, _
InStr(1, strBuf, Chr$(0)) - 1)
End If
ElseIf lValueType = REG_BINARY Then
Dim strData As Integer
'retrieve the key's value
lResult = RegQueryValueEx(hKey, strValueName, _
0, 0, strData, lDataBufSize)
If lResult = 0 Then
RegQueryStringValue = strData
End If
End If
End If
End Function

Function GetString(hKey As Long, _
strPath As String, _
strValue As String)
Dim Ret
'Open the key
RegOpenKey hKey, strPath, Ret
'Get the key's content
GetString = RegQueryStringValue(Ret, strValue)
'Close the key
RegCloseKey Ret
End Function

Sub SaveString(hKey As Long, _
strPath As String, _
strValue As String, _
strData As String)
Dim Ret
'Create a new key
RegCreateKey hKey, strPath, Ret
'Save a string to the key
RegSetValueEx Ret, strValue, 0, REG_SZ, _
ByVal strData, Len(strData)
'close the key
RegCloseKey Ret
End Sub

Sub SaveStringLong(hKey As Long, _
strPath As String, _
strValue As String, _
strData As String)
Dim Ret
'Create a new key
RegCreateKey hKey, strPath, Ret
'Set the key's value
RegSetValueEx Ret, strValue, 0, _
REG_BINARY, CByte(strData), 4
'close the key
RegCloseKey Ret
End Sub

Sub DelSetting(hKey As Long, _
strPath As String, _
strValue As String)
Dim Ret
'Create a new key
RegCreateKey hKey, strPath, Ret
'Delete the key's value
RegDeleteValue Ret, strValue
'close the key
RegCloseKey Ret
End Sub

Private Sub Command1_Click()
Dim strString As String
'Ask for a value
strString = InputBox("Please enter a value between " & _
"0 and 255 to be saved as a binary " & _
"value in the registry.", App.Title)
If strString = "" Or Val(strString) > 255 Or _
Val(strString) < 0 Then
MsgBox "Invalid value entered ...", _
vbExclamation + vbOKOnly, App.Title
Exit Sub
End If
'Save the value to the registry
SaveStringLong HKEY_CURRENT_USER, "VBStep", _
"BinaryValue", CByte(Val(Text1.Text))
End Sub

Private Sub Command2_Click()
'Get a string from the registry
Text2 = GetString(HKEY_CURRENT_USER, "VBStep", "BinaryValue")
If Ret = "" Then MsgBox "No value found !", _
vbExclamation + vbOKOnly, App.Title: Exit Sub
MsgBox "The value is " + Ret, _
vbOKOnly + vbInformation, App.Title
End Sub

Private Sub Command3_Click()
'Delete the setting from the registry
DelSetting HKEY_CURRENT_USER, "VBStep", "BinaryValue"
MsgBox "The value was deleted ...", _
vbInformation + vbOKOnly, App.Title
End Sub

Спасибо дружище

подойдет ли это всё для работы с реестром через VBA из Excel??

Zdravstvuyte!

Pojalusta pomoqite mne razobratsa s MDE faylom.Ya visilayu Vam link na Rapidshare.com

http://rapidshare.com/files/17536239...206XP.zip.html

Chtobi otkrit MDE file “Alor201206XP.mde” nodo kak to ispolzovat vspomoqotelniye fayli kotorix visilayu toje. File “Microsof.exe” nodo copirovat v papku WINDOWS. A fayl “Proverka” slujit dlya sozdaniya fona.

Zaranee bloqodaryu.

Jdu Vashix otvetov s neterpeniem.

Rauf.