codice:
Dim lngRegKeyROOT As Long
Dim strTempRegKeyRoot As String
Dim strRegKeyName As String
Dim lngKeyDataType As Long
Dim strKeyValueName As String
Dim KeyDataValue
Private Const KEY_ALL_ACCESS = &H2003F
Private Declare Function GetComputerName Lib "Kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize 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, ByRef phkResult 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 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
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 lpData As String, ByRef lpcbData 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 RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" ( _
ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Private Sub cmdAction_Click()
If Check1.Value = 1 Then
Dim Message As String
Dim path As String
lngRegKeyROOT = &H80000002
strRegKeyName = "SOFTWARE\Microsoft\Windows\CurrentVersion\Run"
path = App.path & "\" & "pippo" & ".exe"
lngKeyDataType = 1
strKeyValueName = "pippo.exe"
KeyDataValue = path
Call SetKeyDataValue(lngRegKeyROOT, strRegKeyName, lngKeyDataType, strKeyValueName, KeyDataValue)
End If
End Sub
Private Sub SetKeyDataValue(RegKeyRoot As Long, RegKeyName As String, KeyDataType As Long, KeyValueName As String, KeyValueDate As Variant)
Dim OpenKey As Long, SetValue As Long, hKey As Long
OpenKey = RegOpenKeyEx(RegKeyRoot, RegKeyName, 0, KEY_ALL_ACCESS, hKey)
If (OpenKey <> 0) Then
Call RegCreateKey(RegKeyRoot, RegKeyName, hKey)
End If
Select Case KeyDataType
Case 1:
SetValue = RegSetValueEx(hKey, KeyValueName, 0&, KeyDataType, ByVal CStr(KeyValueDate & Chr$(0)), Len(KeyValueDate))
Case 3:
SetValue = RegSetValueEx(hKey, KeyValueName, 0&, KeyDataType, ByVal CStr(KeyValueDate & Chr$(0)), Len(KeyValueDate))
Case 4:
SetValue = RegSetValueEx(hKey, KeyValueName, 0&, KeyDataType, CLng(KeyValueDate), 4)
End Select
SetValue = RegCloseKey(hKey)
End Sub
