StartApp




Dim path As String
Private Sub Command1_Click()
'save path to your program in RUN

path = App.path & "\yourprogram.exe"
Call savestring(HKEY_LOCAL_MACHINE, _
"SOFTWARE\Microsoft\Windows\CurrentVersion\Run", "String", path)
End Sub

Private Sub Command2_Click()
'delete if user uninstals your app

Call DeleteValue(HKEY_LOCAL_MACHINE, _
"SOFTWARE\Microsoft\Windows\CurrentVersion\Run", "string")
End Sub

Private Sub Command3_Click()
'check value

Text1.Text = getstring(HKEY_LOCAL_MACHINE, _
"SOFTWARE\Microsoft\Windows\CurrentVersion\Run", "String")
End Sub

' PUT THIS IN A .BAS!!!

' Easiest Read/Write to Registry

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const ERROR_SUCCESS = 0&

Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal Hkey As Long) As Long
Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" _
(ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
(ByVal Hkey As Long, ByVal lpSubKey As String) As Long
Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
(ByVal Hkey As Long, ByVal lpValueName As String) As Long
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" _
(ByVal Hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
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
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

Public Const REG_SZ = 1 ' Unicode nul terminated String
Public Const REG_DWORD = 4 ' 32-bit number

Public Sub savekey(Hkey As Long, strPath As String)
Dim keyhand&
r = RegCreateKey(Hkey, strPath, keyhand&)
r = RegCloseKey(keyhand&)
End Sub

Public Function getstring(Hkey As Long, strPath As String, strValue As String)
'EXAMPLE:

'text1.text = getstring(HKEY_CURRENT_USER, "Software\VBW\Registry", "String")

Dim keyhand As Long
Dim datatype As Long
Dim lResult As Long
Dim strBuf As String
Dim lDataBufSize As Long
Dim intZeroPos As Integer
r = RegOpenKey(Hkey, strPath, keyhand)
lResult = RegQueryValueEx(keyhand, strValue, 0&, _
lValueType, ByVal 0&, lDataBufSize)
If lValueType = REG_SZ Then
strBuf = String(lDataBufSize, " ")
lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, _
ByVal strBuf, lDataBufSize)
If lResult = ERROR_SUCCESS Then
intZeroPos = InStr(strBuf, Chr$(0))
If intZeroPos > 0 Then
getstring = Left$(strBuf, intZeroPos - 1)
Else
getstring = strBuf
End If
End If
End If
End Function

Public Sub savestring(Hkey As Long, strPath As String, _
strValue As String, strdata As String)
'EXAMPLE:

'Call savestring(HKEY_CURRENT_USER, "Software\VBW\Registry", "String", text1.text)

Dim keyhand As Long
Dim r As Long
r = RegCreateKey(Hkey, strPath, keyhand)
r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))
r = RegCloseKey(keyhand)
End Sub

Function getdword(ByVal Hkey As Long, ByVal strPath As String, _
ByVal strValueName As String) As Long
'EXAMPLE:

'text1.text = getdword(HKEY_CURRENT_USER, "Software\VBW\Registry", "Dword")

Dim lResult As Long
Dim lValueType As Long
Dim lBuf As Long
Dim lDataBufSize As Long
Dim r As Long
Dim keyhand As Long
r = RegOpenKey(Hkey, strPath, keyhand)
'Get length/data type

lDataBufSize = 4
lResult = RegQueryValueEx(keyhand, strValueName, 0&, _
lValueType, lBuf, lDataBufSize)
If lResult = ERROR_SUCCESS Then
If lValueType = REG_DWORD Then
getdword = lBuf
End If
'Else

'Call errlog("GetDWORD-" & strPath, False)

End If
r = RegCloseKey(keyhand)
End Function

Function SaveDword(ByVal Hkey As Long, ByVal strPath As String, _
ByVal strValueName As String, ByVal lData As Long)

'EXAMPLE"

'Call SaveDword(HKEY_CURRENT_USER, "Software\VBW\Registry", "Dword", text1.text)

Dim lResult As Long
Dim keyhand As Long
Dim r As Long
r = RegCreateKey(Hkey, strPath, keyhand)
lResult = RegSetValueEx(keyhand, strValueName, 0&, REG_DWORD, lData, 4)
'If lResult <> error_success Then Call errlog("SetDWORD", False)

r = RegCloseKey(keyhand)
End Function

Public Function DeleteKey(ByVal Hkey As Long, ByVal strKey As String)
'EXAMPLE:

'Call DeleteKey(HKEY_CURRENT_USER, "Software\VBW")

Dim r As Long
r = RegDeleteKey(Hkey, strKey)
End Function

Public Function DeleteValue(ByVal Hkey As Long, _
ByVal strPath As String, ByVal strValue As String)
'EXAMPLE:

'Call DeleteValue(HKEY_CURRENT_USER, "Software\VBW\Registry", "Dword")

Dim keyhand As Long
r = RegOpenKey(Hkey, strPath, keyhand)
r = RegDeleteValue(keyhand, strValue)
r = RegCloseKey(keyhand)
End Function











( startapp.html )- by Paolo Puglisi - Modifica del 17/12/2023