Windows Environment

You can try to set environmental values for a program. The program doesn't affect anything other than itself and its child processes.

DECLARE DYNAMIC LIBRARY "kernel32"
 FUNCTION SetEnvironmentVariableA& (BYVAL lpName AS _OFFSET, BYVAL lpValue AS _OFFSET)
 FUNCTION GetLastError~& ()
END DECLARE

DIM Nam AS STRING
DIM Value AS STRING

Nam = "CalkinsDeleteMe" + CHR$(0)
Value = "CalkinsDeleteMe1" + CHR$(0)

IF 0 = SetEnvironmentVariableA(_OFFSET(Nam), _OFFSET(Value)) THEN
 PRINT "SetEnvironmentVariableA failed. Error: 0x" + LCASE$(HEX$(GetLastError))
 END
END IF

PRINT "Type 'set|more' into the console then 'exit' to close it"
SLEEP 1
SHELL "cmd.exe"
CLS
PRINT "open another cmd.exe, and use 'set|more' to verify that the change was local."
END

Public domain, Feb 2012, Michael Calkins

Note: The current user's account and related processes will only be affected by the environmental changes until program ends!

To verify that the values are reset, Run... 'cmd.exe' and type command 'set|more' to see the values after the program is done.

This program sets environment variables in the registry, for both the system, and the current user, then removes them:

'public domain, feb 2012, michael calkins

CONST milliseconds = 5000

CONST HKEY_CURRENT_USER = &H80000001~&
CONST HKEY_LOCAL_MACHINE = &H80000002~&
CONST REG_SZ = 1
CONST KEY_ALL_ACCESS = &HF003F&

CONST ERROR_SUCCESS = 0
CONST ERROR_ACCESS_DENIED = 5
CONST ERROR_TIMEOUT = &H5B4

CONST WM_SETTINGCHANGE = &H1A
CONST HWND_BROADCAST = &HFFFF&

DECLARE DYNAMIC LIBRARY "advapi32"
 FUNCTION RegOpenKeyExA& (BYVAL hKey AS _OFFSET, BYVAL lpSubKey AS _OFFSET, BYVAL ulOptions AS _UNSIGNED LONG, BYVAL samDesired AS _UNSIGNED LONG, BYVAL phkResult AS _OFFSET)
 FUNCTION RegCloseKey& (BYVAL hKey AS _OFFSET)
 FUNCTION RegSetValueExA& (BYVAL hKey AS _OFFSET, BYVAL lpValueName AS _OFFSET, BYVAL Reserved AS _UNSIGNED LONG, BYVAL dwType AS _UNSIGNED LONG, BYVAL lpData AS _OFFSET, BYVAL cbData AS _UNSIGNED LONG)
 FUNCTION RegDeleteValueA& (BYVAL hKey AS _OFFSET, BYVAL lpValueName AS _OFFSET)
END DECLARE

DECLARE DYNAMIC LIBRARY "user32"
'lParem is actually a LONG_PTR, but qb64 complains if I make it a LONG.
 FUNCTION SendMessageTimeoutA& (BYVAL hWnd AS _OFFSET, BYVAL Msg AS _UNSIGNED LONG, BYVAL wParam AS _UNSIGNED LONG, BYVAL lParam AS _OFFSET, BYVAL fuFlags AS _UNSIGNED LONG, BYVAL uTimeout AS _UNSIGNED LONG, BYVAL lpdwResult AS _OFFSET)
END DECLARE

DECLARE DYNAMIC LIBRARY "kernel32"
 FUNCTION GetLastError~& ()
END DECLARE

DIM hKeySys AS _OFFSET
DIM hKeyUsr AS _OFFSET
DIM SubKey AS STRING
DIM Value AS STRING
DIM bData AS STRING
DIM l AS LONG

PRINT "Please open 'System Properties', click 'Advanced', and click 'Environment"
PRINT "Variables'."
PRINT
PRINT "Press any key to add them."
PRINT "Expect to get an error message if you aren't admin, but the user variable should"
PRINT "still change."
SLEEP: DO WHILE LEN(INKEY$): LOOP

SubKey = "System\CurrentControlSet\Control\Session Manager\Environment" + CHR$(0)
l = RegOpenKeyExA(HKEY_LOCAL_MACHINE, _OFFSET(SubKey), 0, KEY_ALL_ACCESS, _OFFSET(hKeySys))
IF l THEN
 PRINT "(hKeySys) RegOpenKeyExA failed. Error: 0x" + LCASE$(HEX$(l))
 hKeySys = 0
ELSE
 Value = "CalkinsDeleteMeSys" + CHR$(0)
 bData = "DeleteMe2" + CHR$(0)
 l = RegSetValueExA(hKeySys, _OFFSET(Value), 0, REG_SZ, _OFFSET(bData), LEN(bData))
 IF l THEN
  PRINT "RegSetValueExA failed. Error: 0x" + LCASE$(HEX$(l))
  END
 END IF
END IF

SubKey = "Environment" + CHR$(0)
l = RegOpenKeyExA(HKEY_CURRENT_USER, _OFFSET(SubKey), 0, KEY_ALL_ACCESS, _OFFSET(hKeyUsr))
IF l THEN
 PRINT "(hKeyUsr) RegOpenKeyExA failed. Error: 0x" + LCASE$(HEX$(l))
 END
END IF

Value = "CalkinsDeleteMeUsr" + CHR$(0)
bData = "DeleteMe3" + CHR$(0)
l = RegSetValueExA(hKeyUsr, _OFFSET(Value), 0, REG_SZ, _OFFSET(bData), LEN(bData))
IF l THEN
 PRINT "RegSetValueExA failed. Error: 0x" + LCASE$(HEX$(l))
 END
END IF

PRINT
PRINT "Please wait while broadcasting the change."

'SubKey still contains "Environment"+chr$(0)
IF 0 = SendMessageTimeoutA(HWND_BROADCAST, WM_SETTINGCHANGE, 0, _OFFSET(SubKey), 0, milliseconds, _OFFSET(l)) THEN
 PRINT "SendMessageTimeoutA failed. Error: 0x" + LCASE$(HEX$(GetLastError))
END IF

PRINT
PRINT "You might need to exit and reopen the 'Environment Variables' window."
PRINT "Press any key to delete them."
SLEEP: DO WHILE LEN(INKEY$): LOOP

'Value still contains "CalkinsDeleteMeUsr"+chr$(0)
l = RegDeleteValueA(hKeyUsr, _OFFSET(Value))
IF l THEN
 PRINT "RegDeleteValueA failed. Error: 0x" + LCASE$(HEX$(l))
END IF

l = RegCloseKey(hKeyUsr)
IF l THEN
 PRINT "RegCloseKey failed. Error: 0x" + LCASE$(HEX$(l))
 END
END IF

IF hKeySys THEN
 Value = "CalkinsDeleteMeSys" + CHR$(0)
 l = RegDeleteValueA(hKeySys, _OFFSET(Value))
 IF l THEN
  PRINT "RegDeleteValueA failed. Error: 0x" + LCASE$(HEX$(l))
 END IF

 l = RegCloseKey(hKeySys)
 IF l THEN
  PRINT "RegCloseKey failed. Error: 0x" + LCASE$(HEX$(l))
  END
 END IF
END IF

PRINT
PRINT "Please wait while broadcasting the change."

'SubKey still contains "Environment"+chr$(0)
IF 0 = SendMessageTimeoutA(HWND_BROADCAST, WM_SETTINGCHANGE, 0, _OFFSET(SubKey), 0, milliseconds, _OFFSET(l)) THEN
 PRINT "SendMessageTimeoutA failed. Error: 0x" + LCASE$(HEX$(GetLastError))
END IF

PRINT
PRINT "You might need to exit and reopen the 'Environment Variables' window."
PRINT "Please verify that they are deleted."
END

Screenshot of Windows Environmental variables when program is run.

When prompted, open the "Environment Variables" window within System Properties(Control Panel - Performance and Maintenance - System - Advanced - Environment Variables) to see the changes or open a new cmd.exe console to see it.

Administrator privileges are required to change System-wide environmental values, but not current user account values.

QB64 Programming References

Wiki Pages Main Page with Articles and Tutorials QB64 specific keywords (alphabetical) Original QBasic keywords (alphabetical) QB64 OpenGL keywords (alphabetical) Keywords by Usage Got a question about something? Frequently Asked Questions about QB64 QB64 Phoenix Edition Community Forum Links to other QBasic Sites: Pete's QBasic Forum Pete's QBasic Downloads

See also

QB64 Programming References

Navigation menu

Windows Environment

See also

QB64 Programming References

Navigation menu

Search