难免会遇到写注册表的情况，写了个实用点的RegWrite函数。为了减少代码量，用WScript.Shell取代了API来实现。
使用方式就在注释中了，就不再过多解释了。PS：注释比实现代码要丰富多了，m(-.-)m
代码：
Private Function RegWrite(ByVal name_ As String, Optional value_ As String, Optional type_ As String = "REG_SZ") As Integer
'@Author: lichmama
'@Whatfor: offer a simple way to write registry
'@Arguments:
' name_, String
' Registry Key/Value Path, eg. HKEY_CURRENT_USER\Environment(\?)
' value_, String, Optional
' Registry Value Name
' type_, String, Optional and default with "REG_SZ"
' Registry Data Type, eg. REG_SZ, REG_BINARY, ...
'@Usage:
' create new subitem:
' Call RegWrite("HKEY_CURRENT_USER\Enviroment\NewSubItem\")
' create new subitem and set the default value:
' Call RegWrite("HKEY_CURRENT_USER\Enviroment\NewSubItem\", "default-value-data")
' create new value:
' Call RegWrite("HKEY_CURRENT_USER\Enviroment\NewSubItem\NewValue", "new-value-data", "REG_EXPAND_SZ")
' overwrite value:
' Call RegWrite("HKEY_CURRENT_USER\Enviroment\NewSubItem\NewValue", "overwrite-value-data", "REG_SZ")
'@Return: Integer, zero means successful, and non-zero means failed
On Error GoTo ERROR_HANDLER:
Dim objshell As Object Set objshell = CreateObject("wscript.shell") If IsMissing(value_) Then
Call objshell.RegWrite(name_)
Else
Call objshell.RegWrite(name_, value_, type_)
End If ERROR_HANDLER:
RegWrite = Err.Number
Set objshell = Nothing
End Function
用以上方法写注册表来修改环境变量:
Call RegWrite("HKEY_CURRENT_USER\Enviroment\MyEnv", "hello,world;", "REG_EXPAND_SZ")
使其立即生效：
Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" _
(ByVal hwnd As Long, _
ByVal msg As Long, _
ByVal wParam As Long, _
ByRef lParam As Any, _
ByVal fuFlags As Long, _
ByVal uTimeout As Long, _
ByRef lpdwResult As Long) As Long Private Const HWND_BROADCAST = &HFFFF&
Private Const WM_WININICHANGE = &H1A
Private Const WM_SETTINGCHANGE = WM_WININICHANGE
Private Const SMTO_NORMAL = &H0 Private Sub UpdateSystemEnvironment()
'@http://www.bczlw.com/Article/FAQ/bianchengyuyan/VC-MFC/2007-3-5/2007030523033000.html
Call SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, &, ByVal "Environment", SMTO_NORMAL, &, &)
End Sub
打开cmd验证下：
