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 |