VB6之写注册表

难免会遇到写注册表的情况，写了个实用点的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_USEREnvironment(?)
'   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_USEREnviromentNewSubItem")
'   create new subitem and set the default value:
'       Call RegWrite("HKEY_CURRENT_USEREnviromentNewSubItem", "default-value-data")
'   create new value:
'       Call RegWrite("HKEY_CURRENT_USEREnviromentNewSubItemNewValue", "new-value-data", "REG_EXPAND_SZ")
'   overwrite value:
'       Call RegWrite("HKEY_CURRENT_USEREnviromentNewSubItemNewValue", "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_USEREnviromentMyEnv", "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, 0&, ByVal "Environment", SMTO_NORMAL, 1000&, 0&)
End Sub

打开cmd验证下：