 |
Windows 提供了API函数SetEnvironmentVariable，不过这个函数只能修改当前进程的环境变量，而不能修改其他进程和系统的变量。
要修改系统的环境变量，需要修改注册表SYSTEM\CurrentControlSet\Control\Session Manager\Environment下的项，然后发送WM_SETTINGCHANGE消息。
下面就是使用VB写成的例子(完整的版本请从http://www.vbrad.com/pf.asp?p=source/src_environment.htm下载)：
'Note: this piece of code has dependencies on cValuePair and cValuePairs classes
Option Explicit
Private mstrEnvironment As String
Private Const REGISTRY_PATH = "SYSTEM\CurrentControlSet\Control\Session Manager\Environment"
Private oRegistry As Registry
Private Declare Function SendMessageTimeout Lib "user32" _
Alias "SendMessageTimeoutA" (ByVal hwnd As Long, _
ByVal msg As Long, ByVal wParam As Long, _
ByVal lParam As String, ByVal fuFlags As Long, _
ByVal uTimeout As Long, lpdwResult As Long) As Long
Private Const HWND_BROADCAST As Long = &HFFFF&
Private Const SMTO_ABORTIFHUNG As Long = &H2
Private Const WM_SETTINGCHANGE As Long = &H1A
Private mValuePairs As cValuePairs
Private Sub EnumerateVariables()
Dim sKeys() As String
Dim iKeyCount As Long
Dim x As Long
Dim oValuePair As cValuePair
Set mValuePairs = New cValuePairs
oRegistry.EnumerateValues sKeys(), iKeyCount
For x = 1 To iKeyCount
oRegistry.ValueKey = sKeys(x)
Set oValuePair = New cValuePair
oValuePair.Variable = sKeys(x)
oValuePair.Value = oRegistry.Value
mValuePairs.Add oValuePair, oValuePair.Variable
Set oValuePair = Nothing
Next
End Sub
Public Property Get Environment(ByVal strName As String) As String
oRegistry.ValueKey = strName
Environment = oRegistry.Value
End Property
Public Property Let Environment(ByVal strName As String, ByVal strValue As String)
oRegistry.ValueKey = strName
oRegistry.ValueType = REG_SZ
oRegistry.Value = strValue
BroadcastEnvironmentChange
End Property
Private Sub BroadcastEnvironmentChange()
Dim lngReturnValue As Long
SendMessageTimeout HWND_BROADCAST, WM_SETTINGCHANGE, 0&, _
"Environment", SMTO_ABORTIFHUNG, 5000&, lngReturnValue
End Sub
Public Property Get List() As cValuePairs
If mValuePairs Is Nothing Then
EnumerateVariables
End If
Set List = mValuePairs
End Property
Private Sub Class_Initialize()
Set oRegistry = New Registry
oRegistry.ClassKey = HKEY_LOCAL_MACHINE
oRegistry.SectionKey = REGISTRY_PATH
End Sub
Private Sub Class_Terminate()
Set oRegistry = Nothing
Set mValuePairs = Nothing
End Sub
下面是Delphi版本的例子：
// Modified from
// http://www.delphiabc.com/TipNo.asp?ID=117
// The original article did not include the space in
// "Session Manager" which caused the procedure to fail.
procedure SetSystemEnvironmentVariable(const name, value: string);
var
rv: DWORD;
begin
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('SYSTEM\CurrentControlSet\Control\Session ' +
'Manager\Environment', False);
WriteString(name, value);
SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, 0, LParam
(PChar('Environment')), SMTO_ABORTIFHUNG, 5000, rv);
finally
Free
end
end;
此问题由李海回答。
附加关键字：编程, 源程序, programming, source code, Delphi, VCL, Borland, Visual Basic, VB, Windows API, win32, api, windows api, gdi32, kernel。
|
如何通过编程添加环境变量
